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 2";
  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                         my $age = time - $timestamp;
3721                         return ($age, age_string($age));
3722                 }
3723         }
3724         defined($fd = git_cmd_pipe 'for-each-ref',
3725              '--format=%(committer)',
3726              '--sort=-committerdate',
3727              '--count=1',
3728              map { "refs/$_" } get_branch_refs ()) or return;
3729         my $most_recent = <$fd>;
3730         close $fd or return;
3731         if (defined $most_recent &&
3732             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
3733                 my $timestamp = $1;
3734                 my $age = time - $timestamp;
3735                 return ($age, age_string($age));
3736         }
3737         return (undef, undef);
3738 }
3739
3740 # Implementation note: when a single remote is wanted, we cannot use 'git
3741 # remote show -n' because that command always work (assuming it's a remote URL
3742 # if it's not defined), and we cannot use 'git remote show' because that would
3743 # try to make a network roundtrip. So the only way to find if that particular
3744 # remote is defined is to walk the list provided by 'git remote -v' and stop if
3745 # and when we find what we want.
3746 sub git_get_remotes_list {
3747         my $wanted = shift;
3748         my %remotes = ();
3749
3750         my $fd = git_cmd_pipe 'remote', '-v';
3751         return unless $fd;
3752         while (my $remote = to_utf8(scalar <$fd>)) {
3753                 chomp $remote;
3754                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
3755                 next if $wanted and not $remote eq $wanted;
3756                 my ($url, $key) = ($1, $2);
3757
3758                 $remotes{$remote} ||= { 'heads' => [] };
3759                 $remotes{$remote}{$key} = $url;
3760         }
3761         close $fd or return;
3762         return wantarray ? %remotes : \%remotes;
3763 }
3764
3765 # Takes a hash of remotes as first parameter and fills it by adding the
3766 # available remote heads for each of the indicated remotes.
3767 sub fill_remote_heads {
3768         my $remotes = shift;
3769         my @heads = map { "remotes/$_" } keys %$remotes;
3770         my @remoteheads = git_get_heads_list(undef, @heads);
3771         foreach my $remote (keys %$remotes) {
3772                 $remotes->{$remote}{'heads'} = [ grep {
3773                         $_->{'name'} =~ s!^$remote/!!
3774                         } @remoteheads ];
3775         }
3776 }
3777
3778 sub git_get_references {
3779         my $type = shift || "";
3780         my %refs;
3781         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
3782         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
3783         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
3784                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
3785                 or return;
3786
3787         while (my $line = to_utf8(scalar <$fd>)) {
3788                 chomp $line;
3789                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
3790                         if (defined $refs{$1}) {
3791                                 push @{$refs{$1}}, $2;
3792                         } else {
3793                                 $refs{$1} = [ $2 ];
3794                         }
3795                 }
3796         }
3797         close $fd or return;
3798         return \%refs;
3799 }
3800
3801 sub git_get_rev_name_tags {
3802         my $hash = shift || return undef;
3803
3804         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
3805                 or return;
3806         my $name_rev = to_utf8(scalar <$fd>);
3807         close $fd;
3808
3809         if ($name_rev =~ m|^$hash tags/(.*)$|) {
3810                 return $1;
3811         } else {
3812                 # catches also '$hash undefined' output
3813                 return undef;
3814         }
3815 }
3816
3817 ## ----------------------------------------------------------------------
3818 ## parse to hash functions
3819
3820 sub parse_date {
3821         my $epoch = shift;
3822         my $tz = shift || "-0000";
3823
3824         my %date;
3825         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
3826         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
3827         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
3828         $date{'hour'} = $hour;
3829         $date{'minute'} = $min;
3830         $date{'mday'} = $mday;
3831         $date{'day'} = $days[$wday];
3832         $date{'month'} = $months[$mon];
3833         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
3834                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
3835         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
3836                              $mday, $months[$mon], $hour ,$min;
3837         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
3838                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
3839
3840         my ($tz_sign, $tz_hour, $tz_min) =
3841                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
3842         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
3843         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
3844         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
3845         $date{'hour_local'} = $hour;
3846         $date{'minute_local'} = $min;
3847         $date{'tz_local'} = $tz;
3848         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
3849                                   1900+$year, $mon+1, $mday,
3850                                   $hour, $min, $sec, $tz);
3851         return %date;
3852 }
3853
3854 sub parse_tag {
3855         my $tag_id = shift;
3856         my %tag;
3857         my @comment;
3858
3859         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
3860         $tag{'id'} = $tag_id;
3861         while (my $line = to_utf8(scalar <$fd>)) {
3862                 chomp $line;
3863                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
3864                         $tag{'object'} = $1;
3865                 } elsif ($line =~ m/^type (.+)$/) {
3866                         $tag{'type'} = $1;
3867                 } elsif ($line =~ m/^tag (.+)$/) {
3868                         $tag{'name'} = $1;
3869                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
3870                         $tag{'author'} = $1;
3871                         $tag{'author_epoch'} = $2;
3872                         $tag{'author_tz'} = $3;
3873                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3874                                 $tag{'author_name'}  = $1;
3875                                 $tag{'author_email'} = $2;
3876                         } else {
3877                                 $tag{'author_name'} = $tag{'author'};
3878                         }
3879                 } elsif ($line =~ m/--BEGIN/) {
3880                         push @comment, $line;
3881                         last;
3882                 } elsif ($line eq "") {
3883                         last;
3884                 }
3885         }
3886         push @comment, map(to_utf8($_), <$fd>);
3887         $tag{'comment'} = \@comment;
3888         close $fd or return;
3889         if (!defined $tag{'name'}) {
3890                 return
3891         };
3892         return %tag
3893 }
3894
3895 sub parse_commit_text {
3896         my ($commit_text, $withparents) = @_;
3897         my @commit_lines = split '\n', $commit_text;
3898         my %co;
3899
3900         pop @commit_lines; # Remove '\0'
3901
3902         if (! @commit_lines) {
3903                 return;
3904         }
3905
3906         my $header = shift @commit_lines;
3907         if ($header !~ m/^[0-9a-fA-F]{40}/) {
3908                 return;
3909         }
3910         ($co{'id'}, my @parents) = split ' ', $header;
3911         while (my $line = shift @commit_lines) {
3912                 last if $line eq "\n";
3913                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
3914                         $co{'tree'} = $1;
3915                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
3916                         push @parents, $1;
3917                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
3918                         $co{'author'} = to_utf8($1);
3919                         $co{'author_epoch'} = $2;
3920                         $co{'author_tz'} = $3;
3921                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3922                                 $co{'author_name'}  = $1;
3923                                 $co{'author_email'} = $2;
3924                         } else {
3925                                 $co{'author_name'} = $co{'author'};
3926                         }
3927                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
3928                         $co{'committer'} = to_utf8($1);
3929                         $co{'committer_epoch'} = $2;
3930                         $co{'committer_tz'} = $3;
3931                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
3932                                 $co{'committer_name'}  = $1;
3933                                 $co{'committer_email'} = $2;
3934                         } else {
3935                                 $co{'committer_name'} = $co{'committer'};
3936                         }
3937                 }
3938         }
3939         if (!defined $co{'tree'}) {
3940                 return;
3941         };
3942         $co{'parents'} = \@parents;
3943         $co{'parent'} = $parents[0];
3944
3945         @commit_lines = map to_utf8($_), @commit_lines;
3946         foreach my $title (@commit_lines) {
3947                 $title =~ s/^    //;
3948                 if ($title ne "") {
3949                         $co{'title'} = chop_str($title, 80, 5);
3950                         # remove leading stuff of merges to make the interesting part visible
3951                         if (length($title) > 50) {
3952                                 $title =~ s/^Automatic //;
3953                                 $title =~ s/^merge (of|with) /Merge ... /i;
3954                                 if (length($title) > 50) {
3955                                         $title =~ s/(http|rsync):\/\///;
3956                                 }
3957                                 if (length($title) > 50) {
3958                                         $title =~ s/(master|www|rsync)\.//;
3959                                 }
3960                                 if (length($title) > 50) {
3961                                         $title =~ s/kernel.org:?//;
3962                                 }
3963                                 if (length($title) > 50) {
3964                                         $title =~ s/\/pub\/scm//;
3965                                 }
3966                         }
3967                         $co{'title_short'} = chop_str($title, 50, 5);
3968                         last;
3969                 }
3970         }
3971         if (! defined $co{'title'} || $co{'title'} eq "") {
3972                 $co{'title'} = $co{'title_short'} = '(no commit message)';
3973         }
3974         # remove added spaces
3975         foreach my $line (@commit_lines) {
3976                 $line =~ s/^    //;
3977         }
3978         $co{'comment'} = \@commit_lines;
3979
3980         my $age = time - $co{'committer_epoch'};
3981         $co{'age'} = $age;
3982         $co{'age_string'} = age_string($age);
3983         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($co{'committer_epoch'});
3984         if ($age > 60*60*24*7*2) {
3985                 $co{'age_string_date'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
3986                 $co{'age_string_age'} = $co{'age_string'};
3987         } else {
3988                 $co{'age_string_date'} = $co{'age_string'};
3989                 $co{'age_string_age'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
3990         }
3991         return %co;
3992 }
3993
3994 sub parse_commit {
3995         my ($commit_id) = @_;
3996         my %co;
3997
3998         local $/ = "\0";
3999
4000         defined(my $fd = git_cmd_pipe "rev-list",
4001                 "--parents",
4002                 "--header",
4003                 "--max-count=1",
4004                 $commit_id,
4005                 "--")
4006                 or die_error(500, "Open git-rev-list failed");
4007         %co = parse_commit_text(<$fd>, 1);
4008         close $fd;
4009
4010         return %co;
4011 }
4012
4013 sub parse_commits {
4014         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4015         my @cos;
4016
4017         $maxcount ||= 1;
4018         $skip ||= 0;
4019
4020         local $/ = "\0";
4021
4022         defined(my $fd = git_cmd_pipe "rev-list",
4023                 "--header",
4024                 @args,
4025                 ("--max-count=" . $maxcount),
4026                 ("--skip=" . $skip),
4027                 @extra_options,
4028                 $commit_id,
4029                 "--",
4030                 ($filename ? ($filename) : ()))
4031                 or die_error(500, "Open git-rev-list failed");
4032         while (my $line = <$fd>) {
4033                 my %co = parse_commit_text($line);
4034                 push @cos, \%co;
4035         }
4036         close $fd;
4037
4038         return wantarray ? @cos : \@cos;
4039 }
4040
4041 # parse line of git-diff-tree "raw" output
4042 sub parse_difftree_raw_line {
4043         my $line = shift;
4044         my %res;
4045
4046         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4047         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4048         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4049                 $res{'from_mode'} = $1;
4050                 $res{'to_mode'} = $2;
4051                 $res{'from_id'} = $3;
4052                 $res{'to_id'} = $4;
4053                 $res{'status'} = $5;
4054                 $res{'similarity'} = $6;
4055                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4056                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4057                 } else {
4058                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4059                 }
4060         }
4061         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4062         # combined diff (for merge commit)
4063         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4064                 $res{'nparents'}  = length($1);
4065                 $res{'from_mode'} = [ split(' ', $2) ];
4066                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4067                 $res{'from_id'} = [ split(' ', $3) ];
4068                 $res{'to_id'} = pop @{$res{'from_id'}};
4069                 $res{'status'} = [ split('', $4) ];
4070                 $res{'to_file'} = unquote($5);
4071         }
4072         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4073         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4074                 $res{'commit'} = $1;
4075         }
4076
4077         return wantarray ? %res : \%res;
4078 }
4079
4080 # wrapper: return parsed line of git-diff-tree "raw" output
4081 # (the argument might be raw line, or parsed info)
4082 sub parsed_difftree_line {
4083         my $line_or_ref = shift;
4084
4085         if (ref($line_or_ref) eq "HASH") {
4086                 # pre-parsed (or generated by hand)
4087                 return $line_or_ref;
4088         } else {
4089                 return parse_difftree_raw_line($line_or_ref);
4090         }
4091 }
4092
4093 # parse line of git-ls-tree output
4094 sub parse_ls_tree_line {
4095         my $line = shift;
4096         my %opts = @_;
4097         my %res;
4098
4099         if ($opts{'-l'}) {
4100                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4101                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4102
4103                 $res{'mode'} = $1;
4104                 $res{'type'} = $2;
4105                 $res{'hash'} = $3;
4106                 $res{'size'} = $4;
4107                 if ($opts{'-z'}) {
4108                         $res{'name'} = $5;
4109                 } else {
4110                         $res{'name'} = unquote($5);
4111                 }
4112         } else {
4113                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4114                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4115
4116                 $res{'mode'} = $1;
4117                 $res{'type'} = $2;
4118                 $res{'hash'} = $3;
4119                 if ($opts{'-z'}) {
4120                         $res{'name'} = $4;
4121                 } else {
4122                         $res{'name'} = unquote($4);
4123                 }
4124         }
4125
4126         return wantarray ? %res : \%res;
4127 }
4128
4129 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4130 sub parse_from_to_diffinfo {
4131         my ($diffinfo, $from, $to, @parents) = @_;
4132
4133         if ($diffinfo->{'nparents'}) {
4134                 # combined diff
4135                 $from->{'file'} = [];
4136                 $from->{'href'} = [];
4137                 fill_from_file_info($diffinfo, @parents)
4138                         unless exists $diffinfo->{'from_file'};
4139                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4140                         $from->{'file'}[$i] =
4141                                 defined $diffinfo->{'from_file'}[$i] ?
4142                                         $diffinfo->{'from_file'}[$i] :
4143                                         $diffinfo->{'to_file'};
4144                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4145                                 $from->{'href'}[$i] = href(action=>"blob",
4146                                                            hash_base=>$parents[$i],
4147                                                            hash=>$diffinfo->{'from_id'}[$i],
4148                                                            file_name=>$from->{'file'}[$i]);
4149                         } else {
4150                                 $from->{'href'}[$i] = undef;
4151                         }
4152                 }
4153         } else {
4154                 # ordinary (not combined) diff
4155                 $from->{'file'} = $diffinfo->{'from_file'};
4156                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4157                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4158                                                hash=>$diffinfo->{'from_id'},
4159                                                file_name=>$from->{'file'});
4160                 } else {
4161                         delete $from->{'href'};
4162                 }
4163         }
4164
4165         $to->{'file'} = $diffinfo->{'to_file'};
4166         if (!is_deleted($diffinfo)) { # file exists in result
4167                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4168                                      hash=>$diffinfo->{'to_id'},
4169                                      file_name=>$to->{'file'});
4170         } else {
4171                 delete $to->{'href'};
4172         }
4173 }
4174
4175 ## ......................................................................
4176 ## parse to array of hashes functions
4177
4178 sub git_get_heads_list {
4179         my ($limit, @classes) = @_;
4180         @classes = get_branch_refs() unless @classes;
4181         my @patterns = map { "refs/$_" } @classes;
4182         my @headslist;
4183
4184         defined(my $fd = git_cmd_pipe 'for-each-ref',
4185                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4186                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4187                 @patterns)
4188                 or return;
4189         while (my $line = to_utf8(scalar <$fd>)) {
4190                 my %ref_item;
4191
4192                 chomp $line;
4193                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4194                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4195                 my ($committer, $epoch, $tz) =
4196                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4197                 $ref_item{'fullname'}  = $name;
4198                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4199                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4200                 $ref_item{'name'} = $name;
4201                 # for refs neither in 'heads' nor 'remotes' we want to
4202                 # show their ref dir
4203                 my $ref_dir = (defined $1) ? $1 : '';
4204                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4205                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4206                 }
4207
4208                 $ref_item{'id'}    = $hash;
4209                 $ref_item{'title'} = $title || '(no commit message)';
4210                 $ref_item{'epoch'} = $epoch;
4211                 if ($epoch) {
4212                         $ref_item{'age'} = age_string(time - $ref_item{'epoch'});
4213                 } else {
4214                         $ref_item{'age'} = "unknown";
4215                 }
4216
4217                 push @headslist, \%ref_item;
4218         }
4219         close $fd;
4220
4221         return wantarray ? @headslist : \@headslist;
4222 }
4223
4224 sub git_get_tags_list {
4225         my $limit = shift;
4226         my @tagslist;
4227         my $all = shift || 0;
4228         my $order = shift || $default_refs_order;
4229         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4230
4231         defined(my $fd = git_cmd_pipe 'for-each-ref',
4232                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4233                 '--format=%(objectname) %(objecttype) %(refname) '.
4234                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4235                 ($all ? 'refs' : 'refs/tags'))
4236                 or return;
4237         while (my $line = to_utf8(scalar <$fd>)) {
4238                 my %ref_item;
4239
4240                 chomp $line;
4241                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4242                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4243                 my ($creator, $epoch, $tz) =
4244                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4245                 $ref_item{'fullname'} = $name;
4246                 $name =~ s!^refs/!! if $all;
4247                 $name =~ s!^refs/tags/!! unless $all;
4248
4249                 $ref_item{'type'} = $type;
4250                 $ref_item{'id'} = $id;
4251                 $ref_item{'name'} = $name;
4252                 if ($type eq "tag") {
4253                         $ref_item{'subject'} = $title;
4254                         $ref_item{'reftype'} = $reftype;
4255                         $ref_item{'refid'}   = $refid;
4256                 } else {
4257                         $ref_item{'reftype'} = $type;
4258                         $ref_item{'refid'}   = $id;
4259                 }
4260
4261                 if ($type eq "tag" || $type eq "commit") {
4262                         $ref_item{'epoch'} = $epoch;
4263                         if ($epoch) {
4264                                 $ref_item{'age'} = age_string(time - $ref_item{'epoch'});
4265                         } else {
4266                                 $ref_item{'age'} = "unknown";
4267                         }
4268                 }
4269
4270                 push @tagslist, \%ref_item;
4271         }
4272         close $fd;
4273
4274         return wantarray ? @tagslist : \@tagslist;
4275 }
4276
4277 ## ----------------------------------------------------------------------
4278 ## filesystem-related functions
4279
4280 sub get_file_owner {
4281         my $path = shift;
4282
4283         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4284         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4285         if (!defined $gcos) {
4286                 return undef;
4287         }
4288         my $owner = $gcos;
4289         $owner =~ s/[,;].*$//;
4290         return to_utf8($owner);
4291 }
4292
4293 # assume that file exists
4294 sub insert_file {
4295         my $filename = shift;
4296
4297         open my $fd, '<', $filename;
4298         while (<$fd>) {
4299                 print to_utf8($_);
4300         }
4301         close $fd;
4302 }
4303
4304 ## ......................................................................
4305 ## mimetype related functions
4306
4307 sub mimetype_guess_file {
4308         my $filename = shift;
4309         my $mimemap = shift;
4310         my $rawmode = shift;
4311         -r $mimemap or return undef;
4312
4313         my %mimemap;
4314         open(my $mh, '<', $mimemap) or return undef;
4315         while (<$mh>) {
4316                 next if m/^#/; # skip comments
4317                 my ($mimetype, @exts) = split(/\s+/);
4318                 foreach my $ext (@exts) {
4319                         $mimemap{$ext} = $mimetype;
4320                 }
4321         }
4322         close($mh);
4323
4324         my ($ext, $ans);
4325         $ext = $1 if $filename =~ /\.([^.]*)$/;
4326         $ans = $mimemap{$ext} if $ext;
4327         if (defined $ans) {
4328                 my $l = lc($ans);
4329                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4330                 if (!$rawmode) {
4331                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4332                                              $l eq 'image/svg+xml' ||
4333                                              $l eq 'application/xml-dtd' ||
4334                                              $l eq 'application/xml-external-parsed-entity';
4335                 }
4336         }
4337         return $ans;
4338 }
4339
4340 sub mimetype_guess {
4341         my $filename = shift;
4342         my $rawmode = shift;
4343         my $mime;
4344         $filename =~ /\./ or return undef;
4345
4346         if ($mimetypes_file) {
4347                 my $file = $mimetypes_file;
4348                 if ($file !~ m!^/!) { # if it is relative path
4349                         # it is relative to project
4350                         $file = "$projectroot/$project/$file";
4351                 }
4352                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4353         }
4354         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4355         return $mime;
4356 }
4357
4358 sub blob_mimetype {
4359         my $fd = shift;
4360         my $filename = shift;
4361         my $rawmode = shift;
4362         my $mime;
4363
4364         # The -T/-B file operators produce the wrong result unless a perlio
4365         # layer is present when the file handle is a pipe that delivers less
4366         # than 512 bytes of data before reaching EOF.
4367         #
4368         # If we are running in a Perl that uses the stdio layer rather than the
4369         # unix+perlio layers we will end up adding a perlio layer on top of the
4370         # stdio layer and get a second level of buffering.  This is harmless
4371         # and it makes the -T/-B file operators work properly in all cases.
4372
4373         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4374                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4375
4376         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4377
4378         if (!$mime && $filename) {
4379                 if ($filename =~ m/\.html?$/i) {
4380                         $mime = 'text/html';
4381                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4382                         $mime = 'text/html';
4383                 } elsif ($filename =~ m/\.te?xt?$/i) {
4384                         $mime = 'text/plain';
4385                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4386                         $mime = 'text/plain';
4387                 } elsif ($filename =~ m/\.png$/i) {
4388                         $mime = 'image/png';
4389                 } elsif ($filename =~ m/\.gif$/i) {
4390                         $mime = 'image/gif';
4391                 } elsif ($filename =~ m/\.jpe?g$/i) {
4392                         $mime = 'image/jpeg';
4393                 } elsif ($filename =~ m/\.svgz?$/i) {
4394                         $mime = 'image/svg+xml';
4395                 }
4396         }
4397
4398         # just in case
4399         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4400
4401         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4402
4403         return $mime;
4404 }
4405
4406 sub is_ascii {
4407         use bytes;
4408         my $data = shift;
4409         return scalar($data =~ /^[\x00-\x7f]*$/);
4410 }
4411
4412 sub is_valid_utf8 {
4413         my $data = shift;
4414         return utf8::decode($data);
4415 }
4416
4417 sub extract_html_charset {
4418         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4419         my $head = $1;
4420         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4421         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) {
4422                 my %kv = (lc($1) => $3, lc($4) => $6);
4423                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4424                 return $1 if $he && $c && $he eq 'content-type' &&
4425                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4426         }
4427         return undef;
4428 }
4429
4430 sub blob_contenttype {
4431         my ($fd, $file_name, $type) = @_;
4432
4433         $type ||= blob_mimetype($fd, $file_name, 1);
4434         return $type unless $type =~ m!^text/.+!i;
4435         my ($leader, $charset, $htmlcharset);
4436         if ($fd && read($fd, $leader, 32768)) {{
4437                 $charset='US-ASCII' if is_ascii($leader);
4438                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4439                 $charset='ISO-8859-1' unless $charset;
4440                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4441                 if ($htmlcharset && $charset ne 'US-ASCII') {
4442                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4443                 }
4444         }}
4445         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4446         my $defcharset = $default_text_plain_charset || '';
4447         $defcharset =~ s/^\s+//;
4448         $defcharset =~ s/\s+$//;
4449         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4450         return ("$type: charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4451 }
4452
4453 # peek the first upto 128 bytes off a file handle
4454 sub peek128bytes {
4455         my $fd = shift;
4456
4457         use IO::Handle;
4458         use bytes;
4459
4460         my $prefix128;
4461         return '' unless $fd && read($fd, $prefix128, 128);
4462
4463         # In the general case, we're guaranteed only to be able to ungetc one
4464         # character (provided, of course, we actually got a character first).
4465         #
4466         # However, we know:
4467         #
4468         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4469         #    already been called at least once on the file handle before us
4470         #
4471         # 2) we have an $fd positioned at the start of the input stream and
4472         #    therefore know we were positioned at a buffer boundary before
4473         #    reading the initial upto 128 bytes
4474         #
4475         # 3) the buffer size is at least 512 bytes
4476         #
4477         # 4) we are careful to only unget raw bytes
4478         #
4479         # 5) we are attempting to unget exactly the same number of bytes we got
4480         #
4481         # Given the above conditions we will ALWAYS be able to safely unget
4482         # the $prefix128 value we just got.
4483         #
4484         # In fact, we could read up to 511 bytes and still be sure.
4485         # (Reading 512 might pop us into the next internal buffer, but probably
4486         # not since that could break the always able to unget at least the one
4487         # you just got guarantee.)
4488
4489         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4490
4491         return $prefix128;
4492 }
4493
4494 # guess file syntax for syntax highlighting; return undef if no highlighting
4495 # the name of syntax can (in the future) depend on syntax highlighter used
4496 sub guess_file_syntax {
4497         my ($fd, $mimetype, $file_name) = @_;
4498         return undef unless $fd && defined $file_name &&
4499                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4500         my $basename = basename($file_name, '.in');
4501         return $highlight_basename{$basename}
4502                 if exists $highlight_basename{$basename};
4503
4504         # Peek to see if there's a shebang or xml line.
4505         # We always operate on bytes when testing this.
4506         {
4507                 use bytes;
4508                 my $shebang = peek128bytes($fd);
4509                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4510                         foreach my $key (keys %highlight_shebang) {
4511                                 my $ar = ref($highlight_shebang{$key}) ?
4512                                         $highlight_shebang{$key} :
4513                                         [$highlight_shebang{key}];
4514                                 map {return $key if $shebang =~ /$_/} @$ar;
4515                         }
4516                 }
4517                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4518         }
4519
4520         $basename =~ /\.([^.]*)$/;
4521         my $ext = $1 or return undef;
4522         return $highlight_ext{$ext}
4523                 if exists $highlight_ext{$ext};
4524
4525         return undef;
4526 }
4527
4528 # run highlighter and return FD of its output,
4529 # or return original FD if no highlighting
4530 sub run_highlighter {
4531         my ($fd, $syntax) = @_;
4532         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4533
4534         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4535                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4536                 quote_command($highlight_bin).
4537                 " --replace-tabs=8 --fragment --syntax $syntax")
4538                 or die_error(500, "Couldn't open file or run syntax highlighter");
4539         if (eof $hifd) {
4540                 # just in case, should not happen as we tested !eof($fd) above
4541                 return $fd if close($hifd);
4542
4543                 # should not happen
4544                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4545
4546                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4547                 # instead of dying horribly on this, just skip the highlighting
4548                 # but do output a message about it to STDERR that will end up in the log
4549                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4550                         sprintf("child exit status 0x%x\n", $?);
4551                 return $fd
4552         }
4553         close $fd;
4554         return ($hifd, 1);
4555 }
4556
4557 ## ======================================================================
4558 ## functions printing HTML: header, footer, error page
4559
4560 sub get_page_title {
4561         my $title = to_utf8($site_name);
4562
4563         unless (defined $project) {
4564                 if (defined $project_filter) {
4565                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4566                 }
4567                 return $title;
4568         }
4569         $title .= " - " . to_utf8($project);
4570
4571         return $title unless (defined $action);
4572         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4573         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4574
4575         return $title unless (defined $file_name);
4576         $title .= " - " . esc_path($file_name);
4577         if ($action eq "tree" && $file_name !~ m|/$|) {
4578                 $title .= "/";
4579         }
4580
4581         return $title;
4582 }
4583
4584 sub get_content_type_html {
4585         # We do not ever emit application/xhtml+xml since that gives us
4586         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4587         # strict, which is troublesome for example when showing user-supplied
4588         # README.html files.
4589         return 'text/html';
4590 }
4591
4592 sub print_feed_meta {
4593         if (defined $project) {
4594                 my %href_params = get_feed_info();
4595                 if (!exists $href_params{'-title'}) {
4596                         $href_params{'-title'} = 'log';
4597                 }
4598
4599                 foreach my $format (qw(RSS Atom)) {
4600                         my $type = lc($format);
4601                         my %link_attr = (
4602                                 '-rel' => 'alternate',
4603                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4604                                 '-type' => "application/$type+xml"
4605                         );
4606
4607                         $href_params{'extra_options'} = undef;
4608                         $href_params{'action'} = $type;
4609                         $link_attr{'-href'} = href(%href_params);
4610                         print "<link ".
4611                               "rel=\"$link_attr{'-rel'}\" ".
4612                               "title=\"$link_attr{'-title'}\" ".
4613                               "href=\"$link_attr{'-href'}\" ".
4614                               "type=\"$link_attr{'-type'}\" ".
4615                               "/>\n";
4616
4617                         $href_params{'extra_options'} = '--no-merges';
4618                         $link_attr{'-href'} = href(%href_params);
4619                         $link_attr{'-title'} .= ' (no merges)';
4620                         print "<link ".
4621                               "rel=\"$link_attr{'-rel'}\" ".
4622                               "title=\"$link_attr{'-title'}\" ".
4623                               "href=\"$link_attr{'-href'}\" ".
4624                               "type=\"$link_attr{'-type'}\" ".
4625                               "/>\n";
4626                 }
4627
4628         } else {
4629                 printf('<link rel="alternate" title="%s projects list" '.
4630                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4631                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4632                 printf('<link rel="alternate" title="%s projects feeds" '.
4633                        'href="%s" type="text/x-opml" />'."\n",
4634                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4635         }
4636 }
4637
4638 sub print_header_links {
4639         my $status = shift;
4640
4641         # print out each stylesheet that exist, providing backwards capability
4642         # for those people who defined $stylesheet in a config file
4643         if (defined $stylesheet) {
4644                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4645         } else {
4646                 foreach my $stylesheet (@stylesheets) {
4647                         next unless $stylesheet;
4648                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4649                 }
4650         }
4651         print_feed_meta()
4652                 if ($status eq '200 OK');
4653         if (defined $favicon) {
4654                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4655         }
4656 }
4657
4658 sub print_nav_breadcrumbs_path {
4659         my $dirprefix = undef;
4660         while (my $part = shift) {
4661                 $dirprefix .= "/" if defined $dirprefix;
4662                 $dirprefix .= $part;
4663                 print $cgi->a({-href => href(project => undef,
4664                                              project_filter => $dirprefix,
4665                                              action => "project_list")},
4666                               esc_html($part)) . " / ";
4667         }
4668 }
4669
4670 sub print_nav_breadcrumbs {
4671         my %opts = @_;
4672
4673         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4674                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4675         }
4676         if (defined $project) {
4677                 my @dirname = split '/', $project;
4678                 my $projectbasename = pop @dirname;
4679                 print_nav_breadcrumbs_path(@dirname);
4680                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4681                 if (defined $action) {
4682                         my $action_print = $action ;
4683                         $action_print = 'blame' if $action_print eq 'blame_incremental';
4684                         if (defined $opts{-action_extra}) {
4685                                 $action_print = $cgi->a({-href => href(action=>$action)},
4686                                         $action);
4687                         }
4688                         print " / $action_print";
4689                 }
4690                 if (defined $opts{-action_extra}) {
4691                         print " / $opts{-action_extra}";
4692                 }
4693                 print "\n";
4694         } elsif (defined $project_filter) {
4695                 print_nav_breadcrumbs_path(split '/', $project_filter);
4696         }
4697 }
4698
4699 sub print_search_form {
4700         if (!defined $searchtext) {
4701                 $searchtext = "";
4702         }
4703         my $search_hash;
4704         if (defined $hash_base) {
4705                 $search_hash = $hash_base;
4706         } elsif (defined $hash) {
4707                 $search_hash = $hash;
4708         } else {
4709                 $search_hash = "HEAD";
4710         }
4711         # We can't use href() here because we need to encode the
4712         # URL parameters into the form, not into the action link.
4713         my $action = $my_uri;
4714         my $use_pathinfo = gitweb_check_feature('pathinfo');
4715         if ($use_pathinfo) {
4716                 # See notes about doubled / in href()
4717                 $action =~ s,/$,,;
4718                 $action .= "/".esc_path_info($project);
4719         }
4720         print $cgi->start_form(-method => "get", -action => $action) .
4721               "<div class=\"search\">\n" .
4722               (!$use_pathinfo &&
4723               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
4724               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
4725               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
4726               $cgi->popup_menu(-name => 'st', -default => 'commit',
4727                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
4728               " " . $cgi->a({-href => href(action=>"search_help"),
4729                              -title => "search help" }, "?") . " search:\n",
4730               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
4731               "<span title=\"Extended regular expression\">" .
4732               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
4733                              -checked => $search_use_regexp) .
4734               "</span>" .
4735               "</div>" .
4736               $cgi->end_form() . "\n";
4737 }
4738
4739 sub git_header_html {
4740         my $status = shift || "200 OK";
4741         my $expires = shift;
4742         my %opts = @_;
4743
4744         my $title = get_page_title();
4745         my $content_type = get_content_type_html();
4746         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
4747                            -status=> $status, -expires => $expires)
4748                 unless ($opts{'-no_http_header'});
4749         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
4750         print <<EOF;
4751 <?xml version="1.0" encoding="utf-8"?>
4752 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
4753 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
4754 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
4755 <!-- git core binaries version $git_version -->
4756 <head>
4757 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
4758 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
4759 <meta name="robots" content="index, nofollow"/>
4760 <title>$title</title>
4761 <script type="text/javascript">/* <![CDATA[ */
4762 function fixBlameLinks() {
4763         var allLinks = document.getElementsByTagName("a");
4764         for (var i = 0; i < allLinks.length; i++) {
4765                 var link = allLinks.item(i);
4766                 if (link.className == 'blamelink')
4767                         link.href = link.href.replace("/blame/", "/blame_incremental/");
4768         }
4769 }
4770 /* ]]> */</script>
4771 EOF
4772         # the stylesheet, favicon etc urls won't work correctly with path_info
4773         # unless we set the appropriate base URL
4774         if ($ENV{'PATH_INFO'}) {
4775                 print "<base href=\"".esc_url($base_url)."\" />\n";
4776         }
4777         print_header_links($status);
4778
4779         if (defined $site_html_head_string) {
4780                 print to_utf8($site_html_head_string);
4781         }
4782
4783         print "</head>\n" .
4784               "<body>\n";
4785
4786         if (defined $site_header && -f $site_header) {
4787                 insert_file($site_header);
4788         }
4789
4790         print "<div class=\"page_header\">\n";
4791         if (defined $logo) {
4792                 print $cgi->a({-href => esc_url($logo_url),
4793                                -title => $logo_label},
4794                               $cgi->img({-src => esc_url($logo),
4795                                          -width => 72, -height => 27,
4796                                          -alt => "git",
4797                                          -class => "logo"}));
4798         }
4799         print_nav_breadcrumbs(%opts);
4800         print "</div>\n";
4801
4802         my $have_search = gitweb_check_feature('search');
4803         if (defined $project && $have_search) {
4804                 print_search_form();
4805         }
4806 }
4807
4808 sub git_footer_html {
4809         my $feed_class = 'rss_logo';
4810
4811         print "<div class=\"page_footer\">\n";
4812         if (defined $project) {
4813                 my $descr = git_get_project_description($project);
4814                 if (defined $descr) {
4815                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
4816                 }
4817
4818                 my %href_params = get_feed_info();
4819                 if (!%href_params) {
4820                         $feed_class .= ' generic';
4821                 }
4822                 $href_params{'-title'} ||= 'log';
4823
4824                 foreach my $format (qw(RSS Atom)) {
4825                         $href_params{'action'} = lc($format);
4826                         print $cgi->a({-href => href(%href_params),
4827                                       -title => "$href_params{'-title'} $format feed",
4828                                       -class => $feed_class}, $format)."\n";
4829                 }
4830
4831         } else {
4832                 print $cgi->a({-href => href(project=>undef, action=>"opml",
4833                                              project_filter => $project_filter),
4834                               -class => $feed_class}, "OPML") . " ";
4835                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
4836                                              project_filter => $project_filter),
4837                               -class => $feed_class}, "TXT") . "\n";
4838         }
4839         print "</div>\n"; # class="page_footer"
4840
4841         if (defined $t0 && gitweb_check_feature('timed')) {
4842                 print "<div id=\"generating_info\">\n";
4843                 print 'This page took '.
4844                       '<span id="generating_time" class="time_span">'.
4845                       tv_interval($t0, [ gettimeofday() ]).
4846                       ' seconds </span>'.
4847                       ' and '.
4848                       '<span id="generating_cmd">'.
4849                       $number_of_git_cmds.
4850                       '</span> git commands '.
4851                       " to generate.\n";
4852                 print "</div>\n"; # class="page_footer"
4853         }
4854
4855         if (defined $site_footer && -f $site_footer) {
4856                 insert_file($site_footer);
4857         }
4858
4859         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
4860         if (defined $action &&
4861             $action eq 'blame_incremental') {
4862                 print qq!<script type="text/javascript">\n!.
4863                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
4864                       qq!           "!. href() .qq!");\n!.
4865                       qq!</script>\n!;
4866         } else {
4867                 my ($jstimezone, $tz_cookie, $datetime_class) =
4868                         gitweb_get_feature('javascript-timezone');
4869
4870                 print qq!<script type="text/javascript">\n!.
4871                       qq!window.onload = function () {\n!;
4872                 if (gitweb_check_feature('blame_incremental')) {
4873                         print qq!       fixBlameLinks();\n!;
4874                 }
4875                 if (gitweb_check_feature('javascript-actions')) {
4876                         print qq!       fixLinks();\n!;
4877                 }
4878                 if ($jstimezone && $tz_cookie && $datetime_class) {
4879                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
4880                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
4881                 }
4882                 print qq!};\n!.
4883                       qq!</script>\n!;
4884         }
4885
4886         print "</body>\n" .
4887               "</html>";
4888 }
4889
4890 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
4891 # Example: die_error(404, 'Hash not found')
4892 # By convention, use the following status codes (as defined in RFC 2616):
4893 # 400: Invalid or missing CGI parameters, or
4894 #      requested object exists but has wrong type.
4895 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
4896 #      this server or project.
4897 # 404: Requested object/revision/project doesn't exist.
4898 # 500: The server isn't configured properly, or
4899 #      an internal error occurred (e.g. failed assertions caused by bugs), or
4900 #      an unknown error occurred (e.g. the git binary died unexpectedly).
4901 # 503: The server is currently unavailable (because it is overloaded,
4902 #      or down for maintenance).  Generally, this is a temporary state.
4903 sub die_error {
4904         my $status = shift || 500;
4905         my $error = esc_html(shift) || "Internal Server Error";
4906         my $extra = shift;
4907         my %opts = @_;
4908
4909         my %http_responses = (
4910                 400 => '400 Bad Request',
4911                 403 => '403 Forbidden',
4912                 404 => '404 Not Found',
4913                 500 => '500 Internal Server Error',
4914                 503 => '503 Service Unavailable',
4915         );
4916         git_header_html($http_responses{$status}, undef, %opts);
4917         print <<EOF;
4918 <div class="page_body">
4919 <br /><br />
4920 $status - $error
4921 <br />
4922 EOF
4923         if (defined $extra) {
4924                 print "<hr />\n" .
4925                       "$extra\n";
4926         }
4927         print "</div>\n";
4928
4929         git_footer_html();
4930         goto DONE_GITWEB
4931                 unless ($opts{'-error_handler'});
4932 }
4933
4934 ## ----------------------------------------------------------------------
4935 ## functions printing or outputting HTML: navigation
4936
4937 sub git_print_page_nav {
4938         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
4939         $extra = '' if !defined $extra; # pager or formats
4940
4941         my @navs = qw(summary log commit commitdiff tree refs);
4942         if ($suppress) {
4943                 @navs = grep { $_ ne $suppress } @navs;
4944         }
4945
4946         my %arg = map { $_ => {action=>$_} } @navs;
4947         if (defined $head) {
4948                 for (qw(commit commitdiff)) {
4949                         $arg{$_}{'hash'} = $head;
4950                 }
4951                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
4952                         $arg{'log'}{'hash'} = $head;
4953                 }
4954         }
4955
4956         $arg{'log'}{'action'} = 'shortlog';
4957         if ($current eq 'log') {
4958                 $current = 'shortlog';
4959         } elsif ($current eq 'shortlog') {
4960                 $current = 'log';
4961         }
4962         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
4963         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
4964
4965         my @actions = gitweb_get_feature('actions');
4966         my $escname = $project;
4967         $escname =~ s/[+]/%2B/g;
4968         my %repl = (
4969                 '%' => '%',
4970                 'n' => $project,         # project name
4971                 'f' => $git_dir,         # project path within filesystem
4972                 'h' => $treehead || '',  # current hash ('h' parameter)
4973                 'b' => $treebase || '',  # hash base ('hb' parameter)
4974                 'e' => $escname,         # project name with '+' escaped
4975         );
4976         while (@actions) {
4977                 my ($label, $link, $pos) = splice(@actions,0,3);
4978                 # insert
4979                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
4980                 # munch munch
4981                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
4982                 $arg{$label}{'_href'} = $link;
4983         }
4984
4985         print "<div class=\"page_nav\">\n" .
4986                 (join " | ",
4987                  map { $_ eq $current ?
4988                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
4989                  } @navs);
4990         print "<br/>\n$extra<br/>\n" .
4991               "</div>\n";
4992 }
4993
4994 # returns a submenu for the nagivation of the refs views (tags, heads,
4995 # remotes) with the current view disabled and the remotes view only
4996 # available if the feature is enabled
4997 sub format_ref_views {
4998         my ($current) = @_;
4999         my @ref_views = qw{tags heads};
5000         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5001         return join " | ", map {
5002                 $_ eq $current ? $_ :
5003                 $cgi->a({-href => href(action=>$_)}, $_)
5004         } @ref_views
5005 }
5006
5007 sub format_paging_nav {
5008         my ($action, $page, $has_next_link) = @_;
5009         my $paging_nav;
5010
5011
5012         if ($page > 0) {
5013                 $paging_nav .=
5014                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
5015                         " &#183; " .
5016                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5017                                  -accesskey => "p", -title => "Alt-p"}, "prev");
5018         } else {
5019                 $paging_nav .= "first &#183; prev";
5020         }
5021
5022         if ($has_next_link) {
5023                 $paging_nav .= " &#183; " .
5024                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5025                                  -accesskey => "n", -title => "Alt-n"}, "next");
5026         } else {
5027                 $paging_nav .= " &#183; next";
5028         }
5029
5030         return $paging_nav;
5031 }
5032
5033 sub format_log_nav {
5034         my ($action, $page, $has_next_link) = @_;
5035         my $paging_nav;
5036
5037         if ($action eq 'shortlog') {
5038                 $paging_nav .= 'shortlog';
5039         } else {
5040                 $paging_nav .= $cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog');
5041         }
5042         $paging_nav .= ' | ';
5043         if ($action eq 'log') {
5044                 $paging_nav .= 'fulllog';
5045         } else {
5046                 $paging_nav .= $cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog');
5047         }
5048
5049         $paging_nav .= " | " . format_paging_nav($action, $page, $has_next_link);
5050         return $paging_nav;
5051 }
5052
5053 ## ......................................................................
5054 ## functions printing or outputting HTML: div
5055
5056 sub git_print_header_div {
5057         my ($action, $title, $hash, $hash_base, $extra) = @_;
5058         my %args = ();
5059         defined $extra or $extra = '';
5060
5061         $args{'action'} = $action;
5062         $args{'hash'} = $hash if $hash;
5063         $args{'hash_base'} = $hash_base if $hash_base;
5064
5065         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5066                             $title ? $title : $action);
5067         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5068         print "<div class=\"header\">\n" . '<span class="title">' .
5069               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5070 }
5071
5072 sub format_repo_url {
5073         my ($name, $url) = @_;
5074         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5075 }
5076
5077 # Group output by placing it in a DIV element and adding a header.
5078 # Options for start_div() can be provided by passing a hash reference as the
5079 # first parameter to the function.
5080 # Options to git_print_header_div() can be provided by passing an array
5081 # reference. This must follow the options to start_div if they are present.
5082 # The content can be a scalar, which is output as-is, a scalar reference, which
5083 # is output after html escaping, an IO handle passed either as *handle or
5084 # *handle{IO}, or a function reference. In the latter case all following
5085 # parameters will be taken as argument to the content function call.
5086 sub git_print_section {
5087         my ($div_args, $header_args, $content);
5088         my $arg = shift;
5089         if (ref($arg) eq 'HASH') {
5090                 $div_args = $arg;
5091                 $arg = shift;
5092         }
5093         if (ref($arg) eq 'ARRAY') {
5094                 $header_args = $arg;
5095                 $arg = shift;
5096         }
5097         $content = $arg;
5098
5099         print $cgi->start_div($div_args);
5100         git_print_header_div(@$header_args);
5101
5102         if (ref($content) eq 'CODE') {
5103                 $content->(@_);
5104         } elsif (ref($content) eq 'SCALAR') {
5105                 print esc_html($$content);
5106         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5107                 while (<$content>) {
5108                         print to_utf8($_);
5109                 }
5110         } elsif (!ref($content) && defined($content)) {
5111                 print $content;
5112         }
5113
5114         print $cgi->end_div;
5115 }
5116
5117 sub format_timestamp_html {
5118         my $date = shift;
5119         my $strtime = $date->{'rfc2822'};
5120
5121         my (undef, undef, $datetime_class) =
5122                 gitweb_get_feature('javascript-timezone');
5123         if ($datetime_class) {
5124                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5125         }
5126
5127         my $localtime_format = '(%02d:%02d %s)';
5128         if ($date->{'hour_local'} < 6) {
5129                 $localtime_format = '(<span class="atnight">%02d:%02d</span> %s)';
5130         }
5131         $strtime .= ' ' .
5132                     sprintf($localtime_format,
5133                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5134
5135         return $strtime;
5136 }
5137
5138 # Outputs the author name and date in long form
5139 sub git_print_authorship {
5140         my $co = shift;
5141         my %opts = @_;
5142         my $tag = $opts{-tag} || 'div';
5143         my $author = $co->{'author_name'};
5144
5145         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5146         print "<$tag class=\"author_date\">" .
5147               format_search_author($author, "author", esc_html($author)) .
5148               " [".format_timestamp_html(\%ad)."]".
5149               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5150               "</$tag>\n";
5151 }
5152
5153 # Outputs table rows containing the full author or committer information,
5154 # in the format expected for 'commit' view (& similar).
5155 # Parameters are a commit hash reference, followed by the list of people
5156 # to output information for. If the list is empty it defaults to both
5157 # author and committer.
5158 sub git_print_authorship_rows {
5159         my $co = shift;
5160         # too bad we can't use @people = @_ || ('author', 'committer')
5161         my @people = @_;
5162         @people = ('author', 'committer') unless @people;
5163         foreach my $who (@people) {
5164                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5165                 print "<tr><td>$who</td><td>" .
5166                       format_search_author($co->{"${who}_name"}, $who,
5167                                            esc_html($co->{"${who}_name"})) . " " .
5168                       format_search_author($co->{"${who}_email"}, $who,
5169                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5170                       "</td><td rowspan=\"2\">" .
5171                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5172                       "</td></tr>\n" .
5173                       "<tr>" .
5174                       "<td></td><td>" .
5175                       format_timestamp_html(\%wd) .
5176                       "</td>" .
5177                       "</tr>\n";
5178         }
5179 }
5180
5181 sub git_print_page_path {
5182         my $name = shift;
5183         my $type = shift;
5184         my $hb = shift;
5185
5186
5187         print "<div class=\"page_path\">";
5188         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5189                       -title => 'tree root'}, to_utf8("[$project]"));
5190         print " / ";
5191         if (defined $name) {
5192                 my @dirname = split '/', $name;
5193                 my $basename = pop @dirname;
5194                 my $fullname = '';
5195
5196                 foreach my $dir (@dirname) {
5197                         $fullname .= ($fullname ? '/' : '') . $dir;
5198                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5199                                                      hash_base=>$hb),
5200                                       -title => $fullname}, esc_path($dir));
5201                         print " / ";
5202                 }
5203                 if (defined $type && $type eq 'blob') {
5204                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5205                                                      hash_base=>$hb),
5206                                       -title => $name}, esc_path($basename));
5207                 } elsif (defined $type && $type eq 'tree') {
5208                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5209                                                      hash_base=>$hb),
5210                                       -title => $name}, esc_path($basename));
5211                         print " / ";
5212                 } else {
5213                         print esc_path($basename);
5214                 }
5215         }
5216         print "<br/></div>\n";
5217 }
5218
5219 sub git_print_log {
5220         my $log = shift;
5221         my %opts = @_;
5222
5223         if ($opts{'-remove_title'}) {
5224                 # remove title, i.e. first line of log
5225                 shift @$log;
5226         }
5227         # remove leading empty lines
5228         while (defined $log->[0] && $log->[0] eq "") {
5229                 shift @$log;
5230         }
5231
5232         # print log
5233         my $skip_blank_line = 0;
5234         foreach my $line (@$log) {
5235                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5236                         if (! $opts{'-remove_signoff'}) {
5237                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5238                                 $skip_blank_line = 1;
5239                         }
5240                         next;
5241                 }
5242
5243                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5244                         if (! $opts{'-remove_signoff'}) {
5245                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5246                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5247                                         "</span><br/>\n";
5248                                 $skip_blank_line = 1;
5249                         }
5250                         next;
5251                 }
5252
5253                 # print only one empty line
5254                 # do not print empty line after signoff
5255                 if ($line eq "") {
5256                         next if ($skip_blank_line);
5257                         $skip_blank_line = 1;
5258                 } else {
5259                         $skip_blank_line = 0;
5260                 }
5261
5262                 print format_log_line_html($line) . "<br/>\n";
5263         }
5264
5265         if ($opts{'-final_empty_line'}) {
5266                 # end with single empty line
5267                 print "<br/>\n" unless $skip_blank_line;
5268         }
5269 }
5270
5271 # return link target (what link points to)
5272 sub git_get_link_target {
5273         my $hash = shift;
5274         my $link_target;
5275
5276         # read link
5277         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5278                 or return;
5279         {
5280                 local $/ = undef;
5281                 $link_target = to_utf8(scalar <$fd>);
5282         }
5283         close $fd
5284                 or return;
5285
5286         return $link_target;
5287 }
5288
5289 # given link target, and the directory (basedir) the link is in,
5290 # return target of link relative to top directory (top tree);
5291 # return undef if it is not possible (including absolute links).
5292 sub normalize_link_target {
5293         my ($link_target, $basedir) = @_;
5294
5295         # absolute symlinks (beginning with '/') cannot be normalized
5296         return if (substr($link_target, 0, 1) eq '/');
5297
5298         # normalize link target to path from top (root) tree (dir)
5299         my $path;
5300         if ($basedir) {
5301                 $path = $basedir . '/' . $link_target;
5302         } else {
5303                 # we are in top (root) tree (dir)
5304                 $path = $link_target;
5305         }
5306
5307         # remove //, /./, and /../
5308         my @path_parts;
5309         foreach my $part (split('/', $path)) {
5310                 # discard '.' and ''
5311                 next if (!$part || $part eq '.');
5312                 # handle '..'
5313                 if ($part eq '..') {
5314                         if (@path_parts) {
5315                                 pop @path_parts;
5316                         } else {
5317                                 # link leads outside repository (outside top dir)
5318                                 return;
5319                         }
5320                 } else {
5321                         push @path_parts, $part;
5322                 }
5323         }
5324         $path = join('/', @path_parts);
5325
5326         return $path;
5327 }
5328
5329 # print tree entry (row of git_tree), but without encompassing <tr> element
5330 sub git_print_tree_entry {
5331         my ($t, $basedir, $hash_base, $have_blame) = @_;
5332
5333         my %base_key = ();
5334         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5335
5336         # The format of a table row is: mode list link.  Where mode is
5337         # the mode of the entry, list is the name of the entry, an href,
5338         # and link is the action links of the entry.
5339
5340         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5341         if (exists $t->{'size'}) {
5342                 print "<td class=\"size\">$t->{'size'}</td>\n";
5343         }
5344         if ($t->{'type'} eq "blob") {
5345                 print "<td class=\"list\">" .
5346                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5347                                                file_name=>"$basedir$t->{'name'}", %base_key),
5348                                 -class => "list"}, esc_path($t->{'name'}));
5349                 if (S_ISLNK(oct $t->{'mode'})) {
5350                         my $link_target = git_get_link_target($t->{'hash'});
5351                         if ($link_target) {
5352                                 my $norm_target = normalize_link_target($link_target, $basedir);
5353                                 if (defined $norm_target) {
5354                                         print " -> " .
5355                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5356                                                                      file_name=>$norm_target),
5357                                                        -title => $norm_target}, esc_path($link_target));
5358                                 } else {
5359                                         print " -> " . esc_path($link_target);
5360                                 }
5361                         }
5362                 }
5363                 print "</td>\n";
5364                 print "<td class=\"link\">";
5365                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5366                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5367                               "blob");
5368                 if ($have_blame) {
5369                         print " | " .
5370                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5371                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5372                                       -class => "blamelink"},
5373                                       "blame");
5374                 }
5375                 if (defined $hash_base) {
5376                         print " | " .
5377                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5378                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5379                                       "history");
5380                 }
5381                 print " | " .
5382                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5383                                                file_name=>"$basedir$t->{'name'}")},
5384                                 "raw");
5385                 print "</td>\n";
5386
5387         } elsif ($t->{'type'} eq "tree") {
5388                 print "<td class=\"list\">";
5389                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5390                                              file_name=>"$basedir$t->{'name'}",
5391                                              %base_key)},
5392                               esc_path($t->{'name'}));
5393                 print "</td>\n";
5394                 print "<td class=\"link\">";
5395                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5396                                              file_name=>"$basedir$t->{'name'}",
5397                                              %base_key)},
5398                               "tree");
5399                 if (defined $hash_base) {
5400                         print " | " .
5401                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5402                                                      file_name=>"$basedir$t->{'name'}")},
5403                                       "history");
5404                 }
5405                 print "</td>\n";
5406         } else {
5407                 # unknown object: we can only present history for it
5408                 # (this includes 'commit' object, i.e. submodule support)
5409                 print "<td class=\"list\">" .
5410                       esc_path($t->{'name'}) .
5411                       "</td>\n";
5412                 print "<td class=\"link\">";
5413                 if (defined $hash_base) {
5414                         print $cgi->a({-href => href(action=>"history",
5415                                                      hash_base=>$hash_base,
5416                                                      file_name=>"$basedir$t->{'name'}")},
5417                                       "history");
5418                 }
5419                 print "</td>\n";
5420         }
5421 }
5422
5423 ## ......................................................................
5424 ## functions printing large fragments of HTML
5425
5426 # get pre-image filenames for merge (combined) diff
5427 sub fill_from_file_info {
5428         my ($diff, @parents) = @_;
5429
5430         $diff->{'from_file'} = [ ];
5431         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5432         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5433                 if ($diff->{'status'}[$i] eq 'R' ||
5434                     $diff->{'status'}[$i] eq 'C') {
5435                         $diff->{'from_file'}[$i] =
5436                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5437                 }
5438         }
5439
5440         return $diff;
5441 }
5442
5443 # is current raw difftree line of file deletion
5444 sub is_deleted {
5445         my $diffinfo = shift;
5446
5447         return $diffinfo->{'to_id'} eq ('0' x 40);
5448 }
5449
5450 # does patch correspond to [previous] difftree raw line
5451 # $diffinfo  - hashref of parsed raw diff format
5452 # $patchinfo - hashref of parsed patch diff format
5453 #              (the same keys as in $diffinfo)
5454 sub is_patch_split {
5455         my ($diffinfo, $patchinfo) = @_;
5456
5457         return defined $diffinfo && defined $patchinfo
5458                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5459 }
5460
5461
5462 sub git_difftree_body {
5463         my ($difftree, $hash, @parents) = @_;
5464         my ($parent) = $parents[0];
5465         my $have_blame = gitweb_check_feature('blame');
5466         print "<div class=\"list_head\">\n";
5467         if ($#{$difftree} > 10) {
5468                 print(($#{$difftree} + 1) . " files changed:\n");
5469         }
5470         print "</div>\n";
5471
5472         print "<table class=\"" .
5473               (@parents > 1 ? "combined " : "") .
5474               "diff_tree\">\n";
5475
5476         # header only for combined diff in 'commitdiff' view
5477         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5478         if ($has_header) {
5479                 # table header
5480                 print "<thead><tr>\n" .
5481                        "<th></th><th></th>\n"; # filename, patchN link
5482                 for (my $i = 0; $i < @parents; $i++) {
5483                         my $par = $parents[$i];
5484                         print "<th>" .
5485                               $cgi->a({-href => href(action=>"commitdiff",
5486                                                      hash=>$hash, hash_parent=>$par),
5487                                        -title => 'commitdiff to parent number ' .
5488                                                   ($i+1) . ': ' . substr($par,0,7)},
5489                                       $i+1) .
5490                               "&#160;</th>\n";
5491                 }
5492                 print "</tr></thead>\n<tbody>\n";
5493         }
5494
5495         my $alternate = 1;
5496         my $patchno = 0;
5497         foreach my $line (@{$difftree}) {
5498                 my $diff = parsed_difftree_line($line);
5499
5500                 if ($alternate) {
5501                         print "<tr class=\"dark\">\n";
5502                 } else {
5503                         print "<tr class=\"light\">\n";
5504                 }
5505                 $alternate ^= 1;
5506
5507                 if (exists $diff->{'nparents'}) { # combined diff
5508
5509                         fill_from_file_info($diff, @parents)
5510                                 unless exists $diff->{'from_file'};
5511
5512                         if (!is_deleted($diff)) {
5513                                 # file exists in the result (child) commit
5514                                 print "<td>" .
5515                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5516                                                              file_name=>$diff->{'to_file'},
5517                                                              hash_base=>$hash),
5518                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5519                                       "</td>\n";
5520                         } else {
5521                                 print "<td>" .
5522                                       esc_path($diff->{'to_file'}) .
5523                                       "</td>\n";
5524                         }
5525
5526                         if ($action eq 'commitdiff') {
5527                                 # link to patch
5528                                 $patchno++;
5529                                 print "<td class=\"link\">" .
5530                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5531                                               "patch") .
5532                                       " | " .
5533                                       "</td>\n";
5534                         }
5535
5536                         my $has_history = 0;
5537                         my $not_deleted = 0;
5538                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5539                                 my $hash_parent = $parents[$i];
5540                                 my $from_hash = $diff->{'from_id'}[$i];
5541                                 my $from_path = $diff->{'from_file'}[$i];
5542                                 my $status = $diff->{'status'}[$i];
5543
5544                                 $has_history ||= ($status ne 'A');
5545                                 $not_deleted ||= ($status ne 'D');
5546
5547                                 if ($status eq 'A') {
5548                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
5549                                 } elsif ($status eq 'D') {
5550                                         print "<td class=\"link\">" .
5551                                               $cgi->a({-href => href(action=>"blob",
5552                                                                      hash_base=>$hash,
5553                                                                      hash=>$from_hash,
5554                                                                      file_name=>$from_path)},
5555                                                       "blob" . ($i+1)) .
5556                                               " | </td>\n";
5557                                 } else {
5558                                         if ($diff->{'to_id'} eq $from_hash) {
5559                                                 print "<td class=\"link nochange\">";
5560                                         } else {
5561                                                 print "<td class=\"link\">";
5562                                         }
5563                                         print $cgi->a({-href => href(action=>"blobdiff",
5564                                                                      hash=>$diff->{'to_id'},
5565                                                                      hash_parent=>$from_hash,
5566                                                                      hash_base=>$hash,
5567                                                                      hash_parent_base=>$hash_parent,
5568                                                                      file_name=>$diff->{'to_file'},
5569                                                                      file_parent=>$from_path)},
5570                                                       "diff" . ($i+1)) .
5571                                               " | </td>\n";
5572                                 }
5573                         }
5574
5575                         print "<td class=\"link\">";
5576                         if ($not_deleted) {
5577                                 print $cgi->a({-href => href(action=>"blob",
5578                                                              hash=>$diff->{'to_id'},
5579                                                              file_name=>$diff->{'to_file'},
5580                                                              hash_base=>$hash)},
5581                                               "blob");
5582                                 print " | " if ($has_history);
5583                         }
5584                         if ($has_history) {
5585                                 print $cgi->a({-href => href(action=>"history",
5586                                                              file_name=>$diff->{'to_file'},
5587                                                              hash_base=>$hash)},
5588                                               "history");
5589                         }
5590                         print "</td>\n";
5591
5592                         print "</tr>\n";
5593                         next; # instead of 'else' clause, to avoid extra indent
5594                 }
5595                 # else ordinary diff
5596
5597                 my ($to_mode_oct, $to_mode_str, $to_file_type);
5598                 my ($from_mode_oct, $from_mode_str, $from_file_type);
5599                 if ($diff->{'to_mode'} ne ('0' x 6)) {
5600                         $to_mode_oct = oct $diff->{'to_mode'};
5601                         if (S_ISREG($to_mode_oct)) { # only for regular file
5602                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
5603                         }
5604                         $to_file_type = file_type($diff->{'to_mode'});
5605                 }
5606                 if ($diff->{'from_mode'} ne ('0' x 6)) {
5607                         $from_mode_oct = oct $diff->{'from_mode'};
5608                         if (S_ISREG($from_mode_oct)) { # only for regular file
5609                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
5610                         }
5611                         $from_file_type = file_type($diff->{'from_mode'});
5612                 }
5613
5614                 if ($diff->{'status'} eq "A") { # created
5615                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
5616                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
5617                         $mode_chng   .= "]</span>";
5618                         print "<td>";
5619                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5620                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5621                                       -class => "list"}, esc_path($diff->{'file'}));
5622                         print "</td>\n";
5623                         print "<td>$mode_chng</td>\n";
5624                         print "<td class=\"link\">";
5625                         if ($action eq 'commitdiff') {
5626                                 # link to patch
5627                                 $patchno++;
5628                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5629                                               "patch") .
5630                                       " | ";
5631                         }
5632                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5633                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5634                                       "blob");
5635                         print "</td>\n";
5636
5637                 } elsif ($diff->{'status'} eq "D") { # deleted
5638                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5639                         print "<td>";
5640                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5641                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
5642                                        -class => "list"}, esc_path($diff->{'file'}));
5643                         print "</td>\n";
5644                         print "<td>$mode_chng</td>\n";
5645                         print "<td class=\"link\">";
5646                         if ($action eq 'commitdiff') {
5647                                 # link to patch
5648                                 $patchno++;
5649                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5650                                               "patch") .
5651                                       " | ";
5652                         }
5653                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5654                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
5655                                       "blob") . " | ";
5656                         if ($have_blame) {
5657                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5658                                                              file_name=>$diff->{'file'}),
5659                                               -class => "blamelink"},
5660                                               "blame") . " | ";
5661                         }
5662                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5663                                                      file_name=>$diff->{'file'})},
5664                                       "history");
5665                         print "</td>\n";
5666
5667                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5668                         my $mode_chnge = "";
5669                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5670                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5671                                 if ($from_file_type ne $to_file_type) {
5672                                         $mode_chnge .= " from $from_file_type to $to_file_type";
5673                                 }
5674                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
5675                                         if ($from_mode_str && $to_mode_str) {
5676                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
5677                                         } elsif ($to_mode_str) {
5678                                                 $mode_chnge .= " mode: $to_mode_str";
5679                                         }
5680                                 }
5681                                 $mode_chnge .= "]</span>\n";
5682                         }
5683                         print "<td>";
5684                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5685                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5686                                       -class => "list"}, esc_path($diff->{'file'}));
5687                         print "</td>\n";
5688                         print "<td>$mode_chnge</td>\n";
5689                         print "<td class=\"link\">";
5690                         if ($action eq 'commitdiff') {
5691                                 # link to patch
5692                                 $patchno++;
5693                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5694                                               "patch") .
5695                                       " | ";
5696                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5697                                 # "commit" view and modified file (not onlu mode changed)
5698                                 print $cgi->a({-href => href(action=>"blobdiff",
5699                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5700                                                              hash_base=>$hash, hash_parent_base=>$parent,
5701                                                              file_name=>$diff->{'file'})},
5702                                               "diff") .
5703                                       " | ";
5704                         }
5705                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5706                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5707                                        "blob") . " | ";
5708                         if ($have_blame) {
5709                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5710                                                              file_name=>$diff->{'file'}),
5711                                               -class => "blamelink"},
5712                                               "blame") . " | ";
5713                         }
5714                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5715                                                      file_name=>$diff->{'file'})},
5716                                       "history");
5717                         print "</td>\n";
5718
5719                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
5720                         my %status_name = ('R' => 'moved', 'C' => 'copied');
5721                         my $nstatus = $status_name{$diff->{'status'}};
5722                         my $mode_chng = "";
5723                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5724                                 # mode also for directories, so we cannot use $to_mode_str
5725                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
5726                         }
5727                         print "<td>" .
5728                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
5729                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
5730                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
5731                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
5732                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
5733                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
5734                                       -class => "list"}, esc_path($diff->{'from_file'})) .
5735                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
5736                               "<td class=\"link\">";
5737                         if ($action eq 'commitdiff') {
5738                                 # link to patch
5739                                 $patchno++;
5740                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5741                                               "patch") .
5742                                       " | ";
5743                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5744                                 # "commit" view and modified file (not only pure rename or copy)
5745                                 print $cgi->a({-href => href(action=>"blobdiff",
5746                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5747                                                              hash_base=>$hash, hash_parent_base=>$parent,
5748                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
5749                                               "diff") .
5750                                       " | ";
5751                         }
5752                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5753                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
5754                                       "blob") . " | ";
5755                         if ($have_blame) {
5756                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5757                                                              file_name=>$diff->{'to_file'}),
5758                                               -class => "blamelink"},
5759                                               "blame") . " | ";
5760                         }
5761                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5762                                                     file_name=>$diff->{'to_file'})},
5763                                       "history");
5764                         print "</td>\n";
5765
5766                 } # we should not encounter Unmerged (U) or Unknown (X) status
5767                 print "</tr>\n";
5768         }
5769         print "</tbody>" if $has_header;
5770         print "</table>\n";
5771 }
5772
5773 # Print context lines and then rem/add lines in a side-by-side manner.
5774 sub print_sidebyside_diff_lines {
5775         my ($ctx, $rem, $add) = @_;
5776
5777         # print context block before add/rem block
5778         if (@$ctx) {
5779                 print join '',
5780                         '<div class="chunk_block ctx">',
5781                                 '<div class="old">',
5782                                 @$ctx,
5783                                 '</div>',
5784                                 '<div class="new">',
5785                                 @$ctx,
5786                                 '</div>',
5787                         '</div>';
5788         }
5789
5790         if (!@$add) {
5791                 # pure removal
5792                 print join '',
5793                         '<div class="chunk_block rem">',
5794                                 '<div class="old">',
5795                                 @$rem,
5796                                 '</div>',
5797                         '</div>';
5798         } elsif (!@$rem) {
5799                 # pure addition
5800                 print join '',
5801                         '<div class="chunk_block add">',
5802                                 '<div class="new">',
5803                                 @$add,
5804                                 '</div>',
5805                         '</div>';
5806         } else {
5807                 print join '',
5808                         '<div class="chunk_block chg">',
5809                                 '<div class="old">',
5810                                 @$rem,
5811                                 '</div>',
5812                                 '<div class="new">',
5813                                 @$add,
5814                                 '</div>',
5815                         '</div>';
5816         }
5817 }
5818
5819 # Print context lines and then rem/add lines in inline manner.
5820 sub print_inline_diff_lines {
5821         my ($ctx, $rem, $add) = @_;
5822
5823         print @$ctx, @$rem, @$add;
5824 }
5825
5826 # Format removed and added line, mark changed part and HTML-format them.
5827 # Implementation is based on contrib/diff-highlight
5828 sub format_rem_add_lines_pair {
5829         my ($rem, $add, $num_parents) = @_;
5830
5831         # We need to untabify lines before split()'ing them;
5832         # otherwise offsets would be invalid.
5833         chomp $rem;
5834         chomp $add;
5835         $rem = untabify($rem);
5836         $add = untabify($add);
5837
5838         my @rem = split(//, $rem);
5839         my @add = split(//, $add);
5840         my ($esc_rem, $esc_add);
5841         # Ignore leading +/- characters for each parent.
5842         my ($prefix_len, $suffix_len) = ($num_parents, 0);
5843         my ($prefix_has_nonspace, $suffix_has_nonspace);
5844
5845         my $shorter = (@rem < @add) ? @rem : @add;
5846         while ($prefix_len < $shorter) {
5847                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
5848
5849                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
5850                 $prefix_len++;
5851         }
5852
5853         while ($prefix_len + $suffix_len < $shorter) {
5854                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
5855
5856                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
5857                 $suffix_len++;
5858         }
5859
5860         # Mark lines that are different from each other, but have some common
5861         # part that isn't whitespace.  If lines are completely different, don't
5862         # mark them because that would make output unreadable, especially if
5863         # diff consists of multiple lines.
5864         if ($prefix_has_nonspace || $suffix_has_nonspace) {
5865                 $esc_rem = esc_html_hl_regions($rem, 'marked',
5866                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
5867                 $esc_add = esc_html_hl_regions($add, 'marked',
5868                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
5869         } else {
5870                 $esc_rem = esc_html($rem, -nbsp=>1);
5871                 $esc_add = esc_html($add, -nbsp=>1);
5872         }
5873
5874         return format_diff_line(\$esc_rem, 'rem'),
5875                format_diff_line(\$esc_add, 'add');
5876 }
5877
5878 # HTML-format diff context, removed and added lines.
5879 sub format_ctx_rem_add_lines {
5880         my ($ctx, $rem, $add, $num_parents) = @_;
5881         my (@new_ctx, @new_rem, @new_add);
5882         my $can_highlight = 0;
5883         my $is_combined = ($num_parents > 1);
5884
5885         # Highlight if every removed line has a corresponding added line.
5886         if (@$add > 0 && @$add == @$rem) {
5887                 $can_highlight = 1;
5888
5889                 # Highlight lines in combined diff only if the chunk contains
5890                 # diff between the same version, e.g.
5891                 #
5892                 #    - a
5893                 #   -  b
5894                 #    + c
5895                 #   +  d
5896                 #
5897                 # Otherwise the highlightling would be confusing.
5898                 if ($is_combined) {
5899                         for (my $i = 0; $i < @$add; $i++) {
5900                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
5901                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
5902
5903                                 $prefix_rem =~ s/-/+/g;
5904
5905                                 if ($prefix_rem ne $prefix_add) {
5906                                         $can_highlight = 0;
5907                                         last;
5908                                 }
5909                         }
5910                 }
5911         }
5912
5913         if ($can_highlight) {
5914                 for (my $i = 0; $i < @$add; $i++) {
5915                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
5916                                 $rem->[$i], $add->[$i], $num_parents);
5917                         push @new_rem, $line_rem;
5918                         push @new_add, $line_add;
5919                 }
5920         } else {
5921                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
5922                 @new_add = map { format_diff_line($_, 'add') } @$add;
5923         }
5924
5925         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
5926
5927         return (\@new_ctx, \@new_rem, \@new_add);
5928 }
5929
5930 # Print context lines and then rem/add lines.
5931 sub print_diff_lines {
5932         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
5933         my $is_combined = $num_parents > 1;
5934
5935         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
5936                 $num_parents);
5937
5938         if ($diff_style eq 'sidebyside' && !$is_combined) {
5939                 print_sidebyside_diff_lines($ctx, $rem, $add);
5940         } else {
5941                 # default 'inline' style and unknown styles
5942                 print_inline_diff_lines($ctx, $rem, $add);
5943         }
5944 }
5945
5946 sub print_diff_chunk {
5947         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
5948         my (@ctx, @rem, @add);
5949
5950         # The class of the previous line.
5951         my $prev_class = '';
5952
5953         return unless @chunk;
5954
5955         # incomplete last line might be among removed or added lines,
5956         # or both, or among context lines: find which
5957         for (my $i = 1; $i < @chunk; $i++) {
5958                 if ($chunk[$i][0] eq 'incomplete') {
5959                         $chunk[$i][0] = $chunk[$i-1][0];
5960                 }
5961         }
5962
5963         # guardian
5964         push @chunk, ["", ""];
5965
5966         foreach my $line_info (@chunk) {
5967                 my ($class, $line) = @$line_info;
5968
5969                 # print chunk headers
5970                 if ($class && $class eq 'chunk_header') {
5971                         print format_diff_line($line, $class, $from, $to);
5972                         next;
5973                 }
5974
5975                 ## print from accumulator when have some add/rem lines or end
5976                 # of chunk (flush context lines), or when have add and rem
5977                 # lines and new block is reached (otherwise add/rem lines could
5978                 # be reordered)
5979                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
5980                     (@rem && @add && $class ne $prev_class)) {
5981                         print_diff_lines(\@ctx, \@rem, \@add,
5982                                          $diff_style, $num_parents);
5983                         @ctx = @rem = @add = ();
5984                 }
5985
5986                 ## adding lines to accumulator
5987                 # guardian value
5988                 last unless $line;
5989                 # rem, add or change
5990                 if ($class eq 'rem') {
5991                         push @rem, $line;
5992                 } elsif ($class eq 'add') {
5993                         push @add, $line;
5994                 }
5995                 # context line
5996                 if ($class eq 'ctx') {
5997                         push @ctx, $line;
5998                 }
5999
6000                 $prev_class = $class;
6001         }
6002 }
6003
6004 sub git_patchset_body {
6005         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6006         my ($hash_parent) = $hash_parents[0];
6007
6008         my $is_combined = (@hash_parents > 1);
6009         my $patch_idx = 0;
6010         my $patch_number = 0;
6011         my $patch_line;
6012         my $diffinfo;
6013         my $to_name;
6014         my (%from, %to);
6015         my @chunk; # for side-by-side diff
6016
6017         print "<div class=\"patchset\">\n";
6018
6019         # skip to first patch
6020         while ($patch_line = to_utf8(scalar <$fd>)) {
6021                 chomp $patch_line;
6022
6023                 last if ($patch_line =~ m/^diff /);
6024         }
6025
6026  PATCH:
6027         while ($patch_line) {
6028
6029                 # parse "git diff" header line
6030                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6031                         # $1 is from_name, which we do not use
6032                         $to_name = unquote($2);
6033                         $to_name =~ s!^b/!!;
6034                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6035                         # $1 is 'cc' or 'combined', which we do not use
6036                         $to_name = unquote($2);
6037                 } else {
6038                         $to_name = undef;
6039                 }
6040
6041                 # check if current patch belong to current raw line
6042                 # and parse raw git-diff line if needed
6043                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6044                         # this is continuation of a split patch
6045                         print "<div class=\"patch cont\">\n";
6046                 } else {
6047                         # advance raw git-diff output if needed
6048                         $patch_idx++ if defined $diffinfo;
6049
6050                         # read and prepare patch information
6051                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6052
6053                         # compact combined diff output can have some patches skipped
6054                         # find which patch (using pathname of result) we are at now;
6055                         if ($is_combined) {
6056                                 while ($to_name ne $diffinfo->{'to_file'}) {
6057                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6058                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6059                                               "</div>\n";  # class="patch"
6060
6061                                         $patch_idx++;
6062                                         $patch_number++;
6063
6064                                         last if $patch_idx > $#$difftree;
6065                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6066                                 }
6067                         }
6068
6069                         # modifies %from, %to hashes
6070                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6071
6072                         # this is first patch for raw difftree line with $patch_idx index
6073                         # we index @$difftree array from 0, but number patches from 1
6074                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6075                 }
6076
6077                 # git diff header
6078                 #assert($patch_line =~ m/^diff /) if DEBUG;
6079                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6080                 $patch_number++;
6081                 # print "git diff" header
6082                 print format_git_diff_header_line($patch_line, $diffinfo,
6083                                                   \%from, \%to);
6084
6085                 # print extended diff header
6086                 print "<div class=\"diff extended_header\">\n";
6087         EXTENDED_HEADER:
6088                 while ($patch_line = to_utf8(scalar<$fd>)) {
6089                         chomp $patch_line;
6090
6091                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6092
6093                         print format_extended_diff_header_line($patch_line, $diffinfo,
6094                                                                \%from, \%to);
6095                 }
6096                 print "</div>\n"; # class="diff extended_header"
6097
6098                 # from-file/to-file diff header
6099                 if (! $patch_line) {
6100                         print "</div>\n"; # class="patch"
6101                         last PATCH;
6102                 }
6103                 next PATCH if ($patch_line =~ m/^diff /);
6104                 #assert($patch_line =~ m/^---/) if DEBUG;
6105
6106                 my $last_patch_line = $patch_line;
6107                 $patch_line = to_utf8(scalar <$fd>);
6108                 chomp $patch_line;
6109                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6110
6111                 print format_diff_from_to_header($last_patch_line, $patch_line,
6112                                                  $diffinfo, \%from, \%to,
6113                                                  @hash_parents);
6114
6115                 # the patch itself
6116         LINE:
6117                 while ($patch_line = to_utf8(scalar <$fd>)) {
6118                         chomp $patch_line;
6119
6120                         next PATCH if ($patch_line =~ m/^diff /);
6121
6122                         my $class = diff_line_class($patch_line, \%from, \%to);
6123
6124                         if ($class eq 'chunk_header') {
6125                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6126                                 @chunk = ();
6127                         }
6128
6129                         push @chunk, [ $class, $patch_line ];
6130                 }
6131
6132         } continue {
6133                 if (@chunk) {
6134                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6135                         @chunk = ();
6136                 }
6137                 print "</div>\n"; # class="patch"
6138         }
6139
6140         # for compact combined (--cc) format, with chunk and patch simplification
6141         # the patchset might be empty, but there might be unprocessed raw lines
6142         for (++$patch_idx if $patch_number > 0;
6143              $patch_idx < @$difftree;
6144              ++$patch_idx) {
6145                 # read and prepare patch information
6146                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6147
6148                 # generate anchor for "patch" links in difftree / whatchanged part
6149                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6150                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6151                       "</div>\n";  # class="patch"
6152
6153                 $patch_number++;
6154         }
6155
6156         if ($patch_number == 0) {
6157                 if (@hash_parents > 1) {
6158                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6159                 } else {
6160                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6161                 }
6162         }
6163
6164         print "</div>\n"; # class="patchset"
6165 }
6166
6167 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6168
6169 sub git_project_search_form {
6170         my ($searchtext, $search_use_regexp) = @_;
6171
6172         my $limit = '';
6173         if ($project_filter) {
6174                 $limit = " in '$project_filter'";
6175         }
6176
6177         print "<div class=\"projsearch\">\n";
6178         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6179               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6180         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6181                 if (defined $project_filter);
6182         print $cgi->textfield(-name => 's', -value => $searchtext,
6183                               -title => "Search project by name and description$limit",
6184                               -size => 60) . "\n" .
6185               "<span title=\"Extended regular expression\">" .
6186               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6187                              -checked => $search_use_regexp) .
6188               "</span>\n" .
6189               $cgi->submit(-name => 'btnS', -value => 'Search') .
6190               $cgi->end_form() . "\n" .
6191               "<span class=\"projectlist_link\">" .
6192               $cgi->a({-href => href(project => undef, searchtext => undef,
6193                                      action => 'project_list',
6194                                      project_filter => $project_filter)},
6195                       esc_html("List all projects$limit")) . "</span><br />\n";
6196         print "<span class=\"projectlist_link\">" .
6197               $cgi->a({-href => href(project => undef, searchtext => undef,
6198                                      action => 'project_list',
6199                                      project_filter => undef)},
6200                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6201         print "</div>\n";
6202 }
6203
6204 # entry for given @keys needs filling if at least one of keys in list
6205 # is not present in %$project_info
6206 sub project_info_needs_filling {
6207         my ($project_info, @keys) = @_;
6208
6209         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6210         foreach my $key (@keys) {
6211                 if (!exists $project_info->{$key}) {
6212                         return 1;
6213                 }
6214         }
6215         return;
6216 }
6217
6218 sub git_cache_file_format {
6219         return GITWEB_CACHE_FORMAT .
6220                 (gitweb_check_feature('forks') ? " (forks)" : "");
6221 }
6222
6223 sub git_retrieve_cache_file {
6224         my $cache_file = shift;
6225
6226         use Storable qw(retrieve);
6227
6228         if ((my $dump = eval { retrieve($cache_file) })) {
6229                 return $$dump[1] if
6230                         ref($dump) eq 'ARRAY' &&
6231                         @$dump == 2 &&
6232                         ref($$dump[1]) eq 'ARRAY' &&
6233                         @{$$dump[1]} == 2 &&
6234                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6235                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6236                         $$dump[0] eq git_cache_file_format();
6237         }
6238
6239         return undef;
6240 }
6241
6242 sub git_store_cache_file {
6243         my ($cache_file, $cachedata) = @_;
6244
6245         use File::Basename qw(dirname);
6246         use File::stat;
6247         use POSIX qw(:fcntl_h);
6248         use Storable qw(store_fd);
6249
6250         my $result = undef;
6251         my $cache_d = dirname($cache_file);
6252         my $mask = umask();
6253         umask($mask & ~0070) if $cache_grpshared;
6254         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6255             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6256                 store_fd([git_cache_file_format(), $cachedata], $fd);
6257                 close $fd;
6258                 rename "$cache_file.lock", $cache_file;
6259                 $result = stat($cache_file)->mtime;
6260         }
6261         umask($mask) if $cache_grpshared;
6262         return $result;
6263 }
6264
6265 sub git_filter_cached_projects {
6266         my ($cache, $projlist) = @_;
6267         return map {
6268                 my $c = ${$$cache[1]}{$_->{'path'}};
6269                 defined $c ? ($_ = $c) : ()
6270         } @$projlist;
6271 }
6272
6273 # fills project list info (age, description, owner, category, forks, etc.)
6274 # for each project in the list, removing invalid projects from
6275 # returned list, or fill only specified info.
6276 #
6277 # Invalid projects are removed from the returned list if and only if you
6278 # ask 'age' or 'age_string' to be filled, because they are the only fields
6279 # that run unconditionally git command that requires repository, and
6280 # therefore do always check if project repository is invalid.
6281 #
6282 # USAGE:
6283 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6284 #   ensures that 'descr_long' and 'ctags' fields are filled
6285 # * @project_list = fill_project_list_info(\@project_list)
6286 #   ensures that all fields are filled (and invalid projects removed)
6287 #
6288 # NOTE: modifies $projlist, but does not remove entries from it
6289 sub fill_project_list_info {
6290         my ($projlist, @wanted_keys) = @_;
6291
6292         use File::stat;
6293
6294         my $cache_file = "$cache_dir/$projlist_cache_name";
6295         my $cache_lifetime = $projlist_cache_lifetime;
6296         $cache_lifetime = -1
6297                 if $cache_lifetime && @wanted_keys && $wanted_keys[0] eq 'rebuild-cache';
6298
6299         my @projects;
6300         my $stale = 0;
6301         my $now = time();
6302         my $cache_mtime;
6303         if ($cache_lifetime && -f $cache_file) {
6304                 $cache_mtime = stat($cache_file)->mtime;
6305                 $cache_dump = undef if $cache_mtime &&
6306                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6307         }
6308         if (defined $cache_mtime && # caching is on and $cache_file exists
6309             $cache_mtime + $cache_lifetime*60 > $now &&
6310             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6311                 # Cache hit.
6312                 $cache_dump_mtime = $cache_mtime;
6313                 $stale = $now - $cache_mtime;
6314                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6315
6316         } else { # Cache miss.
6317                 if (defined $cache_mtime) {
6318                         # Postpone timeout by two minutes so that we get
6319                         # enough time to do our job, or to be more exact
6320                         # make cache expire after two minutes from now.
6321                         my $time = $now - $cache_lifetime*60 + 120;
6322                         utime $time, $time, $cache_file;
6323                 }
6324                 if ($cache_lifetime) {
6325                         my @all_projects = git_get_projects_list();
6326                         my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6327                                 fill_project_list_info_uncached(\@all_projects);
6328                         map { $all_projects_filled{$_->{'path'}} = $_ }
6329                                 filter_forks_from_projects_list([values(%all_projects_filled)])
6330                                 if gitweb_check_feature('forks');
6331                         $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6332                                        \%all_projects_filled];
6333                         $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6334                         @projects = git_filter_cached_projects($cache_dump, $projlist);
6335                 } else {
6336                         @projects = fill_project_list_info_uncached($projlist, @wanted_keys);
6337                 }
6338         }
6339
6340         if ($cache_lifetime && $stale > 0) {
6341                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6342                         unless $shown_stale_message;
6343                 $shown_stale_message = 1;
6344         }
6345
6346         return @projects;
6347 }
6348
6349 sub fill_project_list_info_uncached {
6350         my ($projlist, @wanted_keys) = @_;
6351         my @projects;
6352         my $filter_set = sub { return @_; };
6353         if (@wanted_keys) {
6354                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6355                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6356         }
6357
6358         my $show_ctags = gitweb_check_feature('ctags');
6359  PROJECT:
6360         foreach my $pr (@$projlist) {
6361                 if (project_info_needs_filling($pr, $filter_set->('age', 'age_string'))) {
6362                         my (@activity) = git_get_last_activity($pr->{'path'});
6363                         unless (@activity) {
6364                                 next PROJECT;
6365                         }
6366                         ($pr->{'age'}, $pr->{'age_string'}) = @activity;
6367                 }
6368                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6369                         my $descr = git_get_project_description($pr->{'path'}) || "";
6370                         $descr = to_utf8($descr);
6371                         $pr->{'descr_long'} = $descr;
6372                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6373                 }
6374                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6375                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6376                 }
6377                 if ($show_ctags &&
6378                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6379                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6380                 }
6381                 if ($projects_list_group_categories &&
6382                     project_info_needs_filling($pr, $filter_set->('category'))) {
6383                         my $cat = git_get_project_category($pr->{'path'}) ||
6384                                                            $project_list_default_category;
6385                         $pr->{'category'} = to_utf8($cat);
6386                 }
6387
6388                 push @projects, $pr;
6389         }
6390
6391         return @projects;
6392 }
6393
6394 sub sort_projects_list {
6395         my ($projlist, $order) = @_;
6396
6397         sub order_str {
6398                 my $key = shift;
6399                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6400         }
6401
6402         sub order_num_then_undef {
6403                 my $key = shift;
6404                 return sub {
6405                         defined $a->{$key} ?
6406                                 (defined $b->{$key} ? $a->{$key} <=> $b->{$key} : -1) :
6407                                 (defined $b->{$key} ? 1 : 0)
6408                 };
6409         }
6410
6411         my %orderings = (
6412                 project => order_str('path'),
6413                 descr => order_str('descr_long'),
6414                 owner => order_str('owner'),
6415                 age => order_num_then_undef('age'),
6416         );
6417
6418         my $ordering = $orderings{$order};
6419         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6420 }
6421
6422 # returns a hash of categories, containing the list of project
6423 # belonging to each category
6424 sub build_projlist_by_category {
6425         my ($projlist, $from, $to) = @_;
6426         my %categories;
6427
6428         $from = 0 unless defined $from;
6429         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6430
6431         for (my $i = $from; $i <= $to; $i++) {
6432                 my $pr = $projlist->[$i];
6433                 push @{$categories{ $pr->{'category'} }}, $pr;
6434         }
6435
6436         return wantarray ? %categories : \%categories;
6437 }
6438
6439 # print 'sort by' <th> element, generating 'sort by $name' replay link
6440 # if that order is not selected
6441 sub print_sort_th {
6442         print format_sort_th(@_);
6443 }
6444
6445 sub format_sort_th {
6446         my ($name, $order, $header) = @_;
6447         my $sort_th = "";
6448         $header ||= ucfirst($name);
6449
6450         if ($order eq $name) {
6451                 $sort_th .= "<th>$header</th>\n";
6452         } else {
6453                 $sort_th .= "<th>" .
6454                             $cgi->a({-href => href(-replay=>1, order=>$name),
6455                                      -class => "header"}, $header) .
6456                             "</th>\n";
6457         }
6458
6459         return $sort_th;
6460 }
6461
6462 sub git_project_list_rows {
6463         my ($projlist, $from, $to, $check_forks) = @_;
6464
6465         $from = 0 unless defined $from;
6466         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6467
6468         my $alternate = 1;
6469         for (my $i = $from; $i <= $to; $i++) {
6470                 my $pr = $projlist->[$i];
6471
6472                 if ($alternate) {
6473                         print "<tr class=\"dark\">\n";
6474                 } else {
6475                         print "<tr class=\"light\">\n";
6476                 }
6477                 $alternate ^= 1;
6478
6479                 if ($check_forks) {
6480                         print "<td>";
6481                         if ($pr->{'forks'}) {
6482                                 my $nforks = scalar @{$pr->{'forks'}};
6483                                 my $s = $nforks == 1 ? '' : 's';
6484                                 if ($nforks > 0) {
6485                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6486                                                        -title => "$nforks fork$s"}, "+");
6487                                 } else {
6488                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6489                                 }
6490                         }
6491                         print "</td>\n";
6492                 }
6493                 my $path = $pr->{'path'};
6494                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6495                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6496                                         -class => "list"},
6497                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6498                       "</td>\n" .
6499                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6500                                         -class => "list",
6501                                         -title => $pr->{'descr_long'}},
6502                                         $search_regexp
6503                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6504                                                                     $pr->{'descr'}, $search_regexp)
6505                                         : esc_html($pr->{'descr'})) .
6506                       "</td>\n";
6507                 unless ($omit_owner) {
6508                         print "<td><i>" . ($owner_link_hook
6509                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6510                                                     chop_and_escape_str($pr->{'owner'}, 15))
6511                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6512                 }
6513                 unless ($omit_age_column) {
6514                         print "<td class=\"". age_class($pr->{'age'}) . "\">" .
6515                             (defined $pr->{'age_string'} ? $pr->{'age_string'} : "No commits") . "</td>\n";
6516                 }
6517                 print"<td class=\"link\">" .
6518                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
6519                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . " | " .
6520                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6521                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6522                       "</td>\n" .
6523                       "</tr>\n";
6524         }
6525 }
6526
6527 sub git_project_list_body {
6528         # actually uses global variable $project
6529         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
6530         my @projects = @$projlist;
6531
6532         my $check_forks = gitweb_check_feature('forks');
6533         my $show_ctags  = gitweb_check_feature('ctags');
6534         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6535         $check_forks = undef
6536                 if ($tagfilter || $search_regexp);
6537
6538         # filtering out forks before filling info allows us to do less work
6539         if ($check_forks) {
6540                 @projects = filter_forks_from_projects_list(\@projects);
6541                 push @projects, { 'path' => "$project_filter.git" }
6542                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
6543         }
6544         # search_projects_list pre-fills required info
6545         @projects = search_projects_list(\@projects,
6546                                          'search_regexp' => $search_regexp,
6547                                          'tagfilter'  => $tagfilter)
6548                 if ($tagfilter || $search_regexp);
6549         # fill the rest
6550         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6551         push @all_fields, ('age', 'age_string') unless($omit_age_column);
6552         push @all_fields, 'owner' unless($omit_owner);
6553         @projects = fill_project_list_info(\@projects, @all_fields);
6554
6555         $order ||= $default_projects_order;
6556         $from = 0 unless defined $from;
6557         $to = $#projects if (!defined $to || $#projects < $to);
6558
6559         # short circuit
6560         if ($from > $to) {
6561                 print "<center>\n".
6562                       "<b>No such projects found</b><br />\n".
6563                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
6564                       "</center>\n<br />\n";
6565                 return;
6566         }
6567
6568         @projects = sort_projects_list(\@projects, $order);
6569
6570         if ($show_ctags) {
6571                 my $ctags = git_gather_all_ctags(\@projects);
6572                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
6573                 print git_show_project_tagcloud($cloud, 64);
6574         }
6575
6576         print "<table class=\"project_list\">\n";
6577         unless ($no_header) {
6578                 print "<tr>\n";
6579                 if ($check_forks) {
6580                         print "<th></th>\n";
6581                 }
6582                 print_sort_th('project', $order, 'Project');
6583                 print_sort_th('descr', $order, 'Description');
6584                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
6585                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
6586                 print "<th></th>\n" . # for links
6587                       "</tr>\n";
6588         }
6589
6590         if ($projects_list_group_categories) {
6591                 # only display categories with projects in the $from-$to window
6592                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
6593                 my %categories = build_projlist_by_category(\@projects, $from, $to);
6594                 foreach my $cat (sort keys %categories) {
6595                         unless ($cat eq "") {
6596                                 print "<tr>\n";
6597                                 if ($check_forks) {
6598                                         print "<td></td>\n";
6599                                 }
6600                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
6601                                 print "</tr>\n";
6602                         }
6603
6604                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
6605                 }
6606         } else {
6607                 git_project_list_rows(\@projects, $from, $to, $check_forks);
6608         }
6609
6610         if (defined $extra) {
6611                 print "<tr>\n";
6612                 if ($check_forks) {
6613                         print "<td></td>\n";
6614                 }
6615                 print "<td colspan=\"5\">$extra</td>\n" .
6616                       "</tr>\n";
6617         }
6618         print "</table>\n";
6619 }
6620
6621 sub git_log_body {
6622         # uses global variable $project
6623         my ($commitlist, $from, $to, $refs, $extra) = @_;
6624
6625         $from = 0 unless defined $from;
6626         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6627
6628         for (my $i = 0; $i <= $to; $i++) {
6629                 my %co = %{$commitlist->[$i]};
6630                 next if !%co;
6631                 my $commit = $co{'id'};
6632                 my $ref = format_ref_marker($refs, $commit);
6633                 git_print_header_div('commit',
6634                                "<span class=\"age\">$co{'age_string'}</span>" .
6635                                esc_html($co{'title'}),
6636                                $commit, undef, $ref);
6637                 print "<div class=\"title_text\">\n" .
6638                       "<div class=\"log_link\">\n" .
6639                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
6640                       " | " .
6641                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
6642                       " | " .
6643                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
6644                       "<br/>\n" .
6645                       "</div>\n";
6646                       git_print_authorship(\%co, -tag => 'span');
6647                       print "<br/>\n</div>\n";
6648
6649                 print "<div class=\"log_body\">\n";
6650                 git_print_log($co{'comment'}, -final_empty_line=> 1);
6651                 print "</div>\n";
6652         }
6653         if ($extra) {
6654                 print "<div class=\"page_nav\">\n";
6655                 print "$extra\n";
6656                 print "</div>\n";
6657         }
6658 }
6659
6660 sub git_shortlog_body {
6661         # uses global variable $project
6662         my ($commitlist, $from, $to, $refs, $extra) = @_;
6663
6664         $from = 0 unless defined $from;
6665         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6666
6667         print "<table class=\"shortlog\">\n";
6668         my $alternate = 1;
6669         for (my $i = $from; $i <= $to; $i++) {
6670                 my %co = %{$commitlist->[$i]};
6671                 my $commit = $co{'id'};
6672                 my $ref = format_ref_marker($refs, $commit);
6673                 if ($alternate) {
6674                         print "<tr class=\"dark\">\n";
6675                 } else {
6676                         print "<tr class=\"light\">\n";
6677                 }
6678                 $alternate ^= 1;
6679                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
6680                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6681                       format_author_html('td', \%co, 10) . "<td>";
6682                 print format_subject_html($co{'title'}, $co{'title_short'},
6683                                           href(action=>"commit", hash=>$commit), $ref);
6684                 print "</td>\n" .
6685                       "<td class=\"link\">" .
6686                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
6687                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
6688                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
6689                 my $snapshot_links = format_snapshot_links($commit);
6690                 if (defined $snapshot_links) {
6691                         print " | " . $snapshot_links;
6692                 }
6693                 print "</td>\n" .
6694                       "</tr>\n";
6695         }
6696         if (defined $extra) {
6697                 print "<tr>\n" .
6698                       "<td colspan=\"4\">$extra</td>\n" .
6699                       "</tr>\n";
6700         }
6701         print "</table>\n";
6702 }
6703
6704 sub git_history_body {
6705         # Warning: assumes constant type (blob or tree) during history
6706         my ($commitlist, $from, $to, $refs, $extra,
6707             $file_name, $file_hash, $ftype) = @_;
6708
6709         $from = 0 unless defined $from;
6710         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
6711
6712         print "<table class=\"history\">\n";
6713         my $alternate = 1;
6714         for (my $i = $from; $i <= $to; $i++) {
6715                 my %co = %{$commitlist->[$i]};
6716                 if (!%co) {
6717                         next;
6718                 }
6719                 my $commit = $co{'id'};
6720
6721                 my $ref = format_ref_marker($refs, $commit);
6722
6723                 if ($alternate) {
6724                         print "<tr class=\"dark\">\n";
6725                 } else {
6726                         print "<tr class=\"light\">\n";
6727                 }
6728                 $alternate ^= 1;
6729                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6730         # shortlog:   format_author_html('td', \%co, 10)
6731                       format_author_html('td', \%co, 15, 3) . "<td>";
6732                 # originally git_history used chop_str($co{'title'}, 50)
6733                 print format_subject_html($co{'title'}, $co{'title_short'},
6734                                           href(action=>"commit", hash=>$commit), $ref);
6735                 print "</td>\n" .
6736                       "<td class=\"link\">" .
6737                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
6738                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
6739
6740                 if ($ftype eq 'blob') {
6741                         my $blob_current = $file_hash;
6742                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
6743                         if (defined $blob_current && defined $blob_parent &&
6744                                         $blob_current ne $blob_parent) {
6745                                 print " | " .
6746                                         $cgi->a({-href => href(action=>"blobdiff",
6747                                                                hash=>$blob_current, hash_parent=>$blob_parent,
6748                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
6749                                                                file_name=>$file_name)},
6750                                                 "diff to current");
6751                         }
6752                 }
6753                 print "</td>\n" .
6754                       "</tr>\n";
6755         }
6756         if (defined $extra) {
6757                 print "<tr>\n" .
6758                       "<td colspan=\"4\">$extra</td>\n" .
6759                       "</tr>\n";
6760         }
6761         print "</table>\n";
6762 }
6763
6764 sub git_tags_body {
6765         # uses global variable $project
6766         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
6767         $from = 0 unless defined $from;
6768         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
6769         $order ||= $default_refs_order;
6770
6771         print "<table class=\"tags\">\n";
6772         if ($full) {
6773                 print "<tr class=\"tags_header\">\n";
6774                 print_sort_th('age', $order, 'Last Change');
6775                 print_sort_th('name', $order, 'Name');
6776                 print "<th></th>\n" . # for comment
6777                       "<th></th>\n" . # for tag
6778                       "<th></th>\n" . # for links
6779                       "</tr>\n";
6780         }
6781         my $alternate = 1;
6782         for (my $i = $from; $i <= $to; $i++) {
6783                 my $entry = $taglist->[$i];
6784                 my %tag = %$entry;
6785                 my $comment = $tag{'subject'};
6786                 my $comment_short;
6787                 if (defined $comment) {
6788                         $comment_short = chop_str($comment, 30, 5);
6789                 }
6790                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
6791                 if ($alternate) {
6792                         print "<tr class=\"dark\">\n";
6793                 } else {
6794                         print "<tr class=\"light\">\n";
6795                 }
6796                 $alternate ^= 1;
6797                 if (defined $tag{'age'}) {
6798                         print "<td><i>$tag{'age'}</i></td>\n";
6799                 } else {
6800                         print "<td></td>\n";
6801                 }
6802                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
6803                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
6804                                -class => "list name"}, esc_html($tag{'name'})) .
6805                       "</td>\n" .
6806                       "<td>");
6807                 if (defined $comment) {
6808                         print format_subject_html($comment, $comment_short,
6809                                                   href(action=>"tag", hash=>$tag{'id'}));
6810                 }
6811                 print "</td>\n" .
6812                       "<td class=\"selflink\">";
6813                 if ($tag{'type'} eq "tag") {
6814                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
6815                 } else {
6816                         print "&#160;";
6817                 }
6818                 print "</td>\n" .
6819                       "<td class=\"link\">" . " | " .
6820                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
6821                 if ($tag{'reftype'} eq "commit") {
6822                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
6823                         print " | " . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
6824                 } elsif ($tag{'reftype'} eq "blob") {
6825                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
6826                 }
6827                 print "</td>\n" .
6828                       "</tr>";
6829         }
6830         if (defined $extra) {
6831                 print "<tr>\n" .
6832                       "<td colspan=\"5\">$extra</td>\n" .
6833                       "</tr>\n";
6834         }
6835         print "</table>\n";
6836 }
6837
6838 sub git_heads_body {
6839         # uses global variable $project
6840         my ($headlist, $head_at, $from, $to, $extra) = @_;
6841         $from = 0 unless defined $from;
6842         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
6843
6844         print "<table class=\"heads\">\n";
6845         my $alternate = 1;
6846         for (my $i = $from; $i <= $to; $i++) {
6847                 my $entry = $headlist->[$i];
6848                 my %ref = %$entry;
6849                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
6850                 if ($alternate) {
6851                         print "<tr class=\"dark\">\n";
6852                 } else {
6853                         print "<tr class=\"light\">\n";
6854                 }
6855                 $alternate ^= 1;
6856                 print "<td><i>$ref{'age'}</i></td>\n" .
6857                       ($curr ? "<td class=\"current_head\">" : "<td>") .
6858                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
6859                                -class => "list name"},esc_html($ref{'name'})) .
6860                       "</td>\n" .
6861                       "<td class=\"link\">" .
6862                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . " | " .
6863                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
6864                       "</td>\n" .
6865                       "</tr>";
6866         }
6867         if (defined $extra) {
6868                 print "<tr>\n" .
6869                       "<td colspan=\"3\">$extra</td>\n" .
6870                       "</tr>\n";
6871         }
6872         print "</table>\n";
6873 }
6874
6875 # Display a single remote block
6876 sub git_remote_block {
6877         my ($remote, $rdata, $limit, $head) = @_;
6878
6879         my $heads = $rdata->{'heads'};
6880         my $fetch = $rdata->{'fetch'};
6881         my $push = $rdata->{'push'};
6882
6883         my $urls_table = "<table class=\"projects_list\">\n" ;
6884
6885         if (defined $fetch) {
6886                 if ($fetch eq $push) {
6887                         $urls_table .= format_repo_url("URL", $fetch);
6888                 } else {
6889                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
6890                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
6891                 }
6892         } elsif (defined $push) {
6893                 $urls_table .= format_repo_url("Push&#160;URL", $push);
6894         } else {
6895                 $urls_table .= format_repo_url("", "No remote URL");
6896         }
6897
6898         $urls_table .= "</table>\n";
6899
6900         my $dots;
6901         if (defined $limit && $limit < @$heads) {
6902                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
6903         }
6904
6905         print $urls_table;
6906         git_heads_body($heads, $head, 0, $limit, $dots);
6907 }
6908
6909 # Display a list of remote names with the respective fetch and push URLs
6910 sub git_remotes_list {
6911         my ($remotedata, $limit) = @_;
6912         print "<table class=\"heads\">\n";
6913         my $alternate = 1;
6914         my @remotes = sort keys %$remotedata;
6915
6916         my $limited = $limit && $limit < @remotes;
6917
6918         $#remotes = $limit - 1 if $limited;
6919
6920         while (my $remote = shift @remotes) {
6921                 my $rdata = $remotedata->{$remote};
6922                 my $fetch = $rdata->{'fetch'};
6923                 my $push = $rdata->{'push'};
6924                 if ($alternate) {
6925                         print "<tr class=\"dark\">\n";
6926                 } else {
6927                         print "<tr class=\"light\">\n";
6928                 }
6929                 $alternate ^= 1;
6930                 print "<td>" .
6931                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
6932                                -class=> "list name"},esc_html($remote)) .
6933                       "</td>";
6934                 print "<td class=\"link\">" .
6935                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
6936                       " | " .
6937                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
6938                       "</td>";
6939
6940                 print "</tr>\n";
6941         }
6942
6943         if ($limited) {
6944                 print "<tr>\n" .
6945                       "<td colspan=\"3\">" .
6946                       $cgi->a({-href => href(action=>"remotes")}, "...") .
6947                       "</td>\n" . "</tr>\n";
6948         }
6949
6950         print "</table>";
6951 }
6952
6953 # Display remote heads grouped by remote, unless there are too many
6954 # remotes, in which case we only display the remote names
6955 sub git_remotes_body {
6956         my ($remotedata, $limit, $head) = @_;
6957         if ($limit and $limit < keys %$remotedata) {
6958                 git_remotes_list($remotedata, $limit);
6959         } else {
6960                 fill_remote_heads($remotedata);
6961                 while (my ($remote, $rdata) = each %$remotedata) {
6962                         git_print_section({-class=>"remote", -id=>$remote},
6963                                 ["remotes", $remote, $remote], sub {
6964                                         git_remote_block($remote, $rdata, $limit, $head);
6965                                 });
6966                 }
6967         }
6968 }
6969
6970 sub git_search_message {
6971         my %co = @_;
6972
6973         my $greptype;
6974         if ($searchtype eq 'commit') {
6975                 $greptype = "--grep=";
6976         } elsif ($searchtype eq 'author') {
6977                 $greptype = "--author=";
6978         } elsif ($searchtype eq 'committer') {
6979                 $greptype = "--committer=";
6980         }
6981         $greptype .= $searchtext;
6982         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
6983                                        $greptype, '--regexp-ignore-case',
6984                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
6985
6986         my $paging_nav = '';
6987         if ($page > 0) {
6988                 $paging_nav .=
6989                         $cgi->a({-href => href(-replay=>1, page=>undef)},
6990                                 "first") .
6991                         " &#183; " .
6992                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
6993                                  -accesskey => "p", -title => "Alt-p"}, "prev");
6994         } else {
6995                 $paging_nav .= "first &#183; prev";
6996         }
6997         my $next_link = '';
6998         if ($#commitlist >= 100) {
6999                 $next_link =
7000                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7001                                  -accesskey => "n", -title => "Alt-n"}, "next");
7002                 $paging_nav .= " &#183; $next_link";
7003         } else {
7004                 $paging_nav .= " &#183; next";
7005         }
7006
7007         git_header_html();
7008
7009         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
7010         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7011         if ($page == 0 && !@commitlist) {
7012                 print "<p>No match.</p>\n";
7013         } else {
7014                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7015         }
7016
7017         git_footer_html();
7018 }
7019
7020 sub git_search_changes {
7021         my %co = @_;
7022
7023         local $/ = "\n";
7024         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7025                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7026                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7027                         or die_error(500, "Open git-log failed");
7028
7029         git_header_html();
7030
7031         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7032         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7033
7034         print "<table class=\"pickaxe search\">\n";
7035         my $alternate = 1;
7036         undef %co;
7037         my @files;
7038         while (my $line = to_utf8(scalar <$fd>)) {
7039                 chomp $line;
7040                 next unless $line;
7041
7042                 my %set = parse_difftree_raw_line($line);
7043                 if (defined $set{'commit'}) {
7044                         # finish previous commit
7045                         if (%co) {
7046                                 print "</td>\n" .
7047                                       "<td class=\"link\">" .
7048                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7049                                               "commit") .
7050                                       " | " .
7051                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7052                                                              hash_base=>$co{'id'})},
7053                                               "tree") .
7054                                       "</td>\n" .
7055                                       "</tr>\n";
7056                         }
7057
7058                         if ($alternate) {
7059                                 print "<tr class=\"dark\">\n";
7060                         } else {
7061                                 print "<tr class=\"light\">\n";
7062                         }
7063                         $alternate ^= 1;
7064                         %co = parse_commit($set{'commit'});
7065                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7066                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7067                               "<td><i>$author</i></td>\n" .
7068                               "<td>" .
7069                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7070                                       -class => "list subject"},
7071                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7072                 } elsif (defined $set{'to_id'}) {
7073                         next if ($set{'to_id'} =~ m/^0{40}$/);
7074
7075                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7076                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7077                                       -class => "list"},
7078                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7079                               "<br/>\n";
7080                 }
7081         }
7082         close $fd;
7083
7084         # finish last commit (warning: repetition!)
7085         if (%co) {
7086                 print "</td>\n" .
7087                       "<td class=\"link\">" .
7088                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7089                               "commit") .
7090                       " | " .
7091                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7092                                              hash_base=>$co{'id'})},
7093                               "tree") .
7094                       "</td>\n" .
7095                       "</tr>\n";
7096         }
7097
7098         print "</table>\n";
7099
7100         git_footer_html();
7101 }
7102
7103 sub git_search_files {
7104         my %co = @_;
7105
7106         local $/ = "\n";
7107         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7108                 $search_use_regexp ? ('-E', '-i') : '-F',
7109                 $searchtext, $co{'tree'})
7110                         or die_error(500, "Open git-grep failed");
7111
7112         git_header_html();
7113
7114         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7115         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7116
7117         print "<table class=\"grep_search\">\n";
7118         my $alternate = 1;
7119         my $matches = 0;
7120         my $lastfile = '';
7121         my $file_href;
7122         while (my $line = to_utf8(scalar <$fd>)) {
7123                 chomp $line;
7124                 my ($file, $lno, $ltext, $binary);
7125                 last if ($matches++ > 1000);
7126                 if ($line =~ /^Binary file (.+) matches$/) {
7127                         $file = $1;
7128                         $binary = 1;
7129                 } else {
7130                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7131                         $file =~ s/^$co{'tree'}://;
7132                 }
7133                 if ($file ne $lastfile) {
7134                         $lastfile and print "</td></tr>\n";
7135                         if ($alternate++) {
7136                                 print "<tr class=\"dark\">\n";
7137                         } else {
7138                                 print "<tr class=\"light\">\n";
7139                         }
7140                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7141                                           file_name=>$file);
7142                         print "<td class=\"list\">".
7143                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7144                         print "</td><td>\n";
7145                         $lastfile = $file;
7146                 }
7147                 if ($binary) {
7148                         print "<div class=\"binary\">Binary file</div>\n";
7149                 } else {
7150                         $ltext = untabify($ltext);
7151                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7152                                 $ltext = esc_html($1, -nbsp=>1);
7153                                 $ltext .= '<span class="match">';
7154                                 $ltext .= esc_html($2, -nbsp=>1);
7155                                 $ltext .= '</span>';
7156                                 $ltext .= esc_html($3, -nbsp=>1);
7157                         } else {
7158                                 $ltext = esc_html($ltext, -nbsp=>1);
7159                         }
7160                         print "<div class=\"pre\">" .
7161                                 $cgi->a({-href => $file_href.'#l'.$lno,
7162                                         -class => "linenr"}, sprintf('%4i', $lno)) .
7163                                 ' ' .  $ltext . "</div>\n";
7164                 }
7165         }
7166         if ($lastfile) {
7167                 print "</td></tr>\n";
7168                 if ($matches > 1000) {
7169                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7170                 }
7171         } else {
7172                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7173         }
7174         close $fd;
7175
7176         print "</table>\n";
7177
7178         git_footer_html();
7179 }
7180
7181 sub git_search_grep_body {
7182         my ($commitlist, $from, $to, $extra) = @_;
7183         $from = 0 unless defined $from;
7184         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7185
7186         print "<table class=\"commit_search\">\n";
7187         my $alternate = 1;
7188         for (my $i = $from; $i <= $to; $i++) {
7189                 my %co = %{$commitlist->[$i]};
7190                 if (!%co) {
7191                         next;
7192                 }
7193                 my $commit = $co{'id'};
7194                 if ($alternate) {
7195                         print "<tr class=\"dark\">\n";
7196                 } else {
7197                         print "<tr class=\"light\">\n";
7198                 }
7199                 $alternate ^= 1;
7200                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7201                       format_author_html('td', \%co, 15, 5) .
7202                       "<td>" .
7203                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7204                                -class => "list subject"},
7205                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7206                 my $comment = $co{'comment'};
7207                 foreach my $line (@$comment) {
7208                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7209                                 my ($lead, $match, $trail) = ($1, $2, $3);
7210                                 $match = chop_str($match, 70, 5, 'center');
7211                                 my $contextlen = int((80 - length($match))/2);
7212                                 $contextlen = 30 if ($contextlen > 30);
7213                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7214                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7215
7216                                 $lead  = esc_html($lead);
7217                                 $match = esc_html($match);
7218                                 $trail = esc_html($trail);
7219
7220                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7221                         }
7222                 }
7223                 print "</td>\n" .
7224                       "<td class=\"link\">" .
7225                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7226                       " | " .
7227                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7228                       " | " .
7229                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7230                 print "</td>\n" .
7231                       "</tr>\n";
7232         }
7233         if (defined $extra) {
7234                 print "<tr>\n" .
7235                       "<td colspan=\"3\">$extra</td>\n" .
7236                       "</tr>\n";
7237         }
7238         print "</table>\n";
7239 }
7240
7241 ## ======================================================================
7242 ## ======================================================================
7243 ## actions
7244
7245 sub git_project_list_load {
7246         my $empty_list_ok = shift;
7247         my $order = $input_params{'order'};
7248         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7249                 die_error(400, "Unknown order parameter");
7250         }
7251
7252         my @list = git_get_projects_list($project_filter, $strict_export);
7253         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7254                 push @list, { 'path' => "$project_filter.git" }
7255                         if is_valid_project("$project_filter.git");
7256         }
7257         if (!@list) {
7258                 die_error(404, "No projects found") unless $empty_list_ok;
7259         }
7260
7261         return (\@list, $order);
7262 }
7263
7264 sub git_frontpage {
7265         my ($projlist, $order);
7266
7267         if ($frontpage_no_project_list) {
7268                 $project = undef;
7269                 $project_filter = undef;
7270         } else {
7271                 ($projlist, $order) = git_project_list_load(1);
7272         }
7273         git_header_html();
7274         if (defined $home_text && -f $home_text) {
7275                 print "<div class=\"index_include\">\n";
7276                 insert_file($home_text);
7277                 print "</div>\n";
7278         }
7279         git_project_search_form($searchtext, $search_use_regexp);
7280         if ($frontpage_no_project_list) {
7281                 my $show_ctags = gitweb_check_feature('ctags');
7282                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7283                         my @projects = git_get_projects_list($project_filter, $strict_export);
7284                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7285                         @projects = fill_project_list_info(\@projects, 'ctags');
7286                         my $ctags = git_gather_all_ctags(\@projects);
7287                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7288                         print git_show_project_tagcloud($cloud, 64);
7289                 }
7290         } else {
7291                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7292         }
7293         git_footer_html();
7294 }
7295
7296 sub git_project_list {
7297         my ($projlist, $order) = git_project_list_load();
7298         git_header_html();
7299         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7300                 print "<div class=\"index_include\">\n";
7301                 insert_file($home_text);
7302                 print "</div>\n";
7303         }
7304         git_project_search_form();
7305         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7306         git_footer_html();
7307 }
7308
7309 sub git_forks {
7310         my $order = $input_params{'order'};
7311         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7312                 die_error(400, "Unknown order parameter");
7313         }
7314
7315         my $filter = $project;
7316         $filter =~ s/\.git$//;
7317         my @list = git_get_projects_list($filter);
7318         if (!@list) {
7319                 die_error(404, "No forks found");
7320         }
7321
7322         git_header_html();
7323         git_print_page_nav('','');
7324         git_print_header_div('summary', "$project forks");
7325         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7326         git_footer_html();
7327 }
7328
7329 sub git_project_index {
7330         my @projects = git_get_projects_list($project_filter, $strict_export);
7331         if (!@projects) {
7332                 die_error(404, "No projects found");
7333         }
7334
7335         print $cgi->header(
7336                 -type => 'text/plain',
7337                 -charset => 'utf-8',
7338                 -content_disposition => 'inline; filename="index.aux"');
7339
7340         foreach my $pr (@projects) {
7341                 if (!exists $pr->{'owner'}) {
7342                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7343                 }
7344
7345                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7346                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7347                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7348                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7349                 $path  =~ s/ /\+/g;
7350                 $owner =~ s/ /\+/g;
7351
7352                 print "$path $owner\n";
7353         }
7354 }
7355
7356 sub git_summary {
7357         my $descr = git_get_project_description($project) || "none";
7358         my %co = parse_commit("HEAD");
7359         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7360         my $head = $co{'id'};
7361         my $remote_heads = gitweb_check_feature('remote_heads');
7362
7363         my $owner = git_get_project_owner($project);
7364         my $homepage = git_get_project_config('homepage');
7365         my $base_url = git_get_project_config('baseurl');
7366         my $last_refresh = git_get_project_config("lastrefresh");
7367
7368         my $refs = git_get_references();
7369         # These get_*_list functions return one more to allow us to see if
7370         # there are more ...
7371         my @taglist  = git_get_tags_list(16);
7372         my @headlist = git_get_heads_list(16);
7373         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7374         my @forklist;
7375         my $check_forks = gitweb_check_feature('forks');
7376
7377         if ($check_forks) {
7378                 # find forks of a project
7379                 my $filter = $project;
7380                 $filter =~ s/\.git$//;
7381                 @forklist = git_get_projects_list($filter);
7382                 # filter out forks of forks
7383                 @forklist = filter_forks_from_projects_list(\@forklist)
7384                         if (@forklist);
7385         }
7386
7387         git_header_html();
7388         git_print_page_nav('summary','', $head);
7389
7390         if ($check_forks and $project =~ m#/#) {
7391                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7392                 my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7393                 print <<EOT;
7394 <div class="forkinfo">
7395 This project is a fork of the $r project. If you have that one
7396 already cloned locally, you can use
7397 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7398 to save bandwidth during cloning.
7399 </div>
7400 EOT
7401         }
7402
7403         print "<div class=\"title\">&#160;</div>\n";
7404         print "<table class=\"projects_list\">\n" .
7405               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7406         if ($homepage) {
7407                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7408         }
7409         if ($base_url) {
7410                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7411         }
7412         if ($owner and not $omit_owner) {
7413                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7414                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7415                         : email_obfuscate($owner)) . "</td></tr>\n";
7416         }
7417         if (defined $cd{'rfc2822'}) {
7418                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7419                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7420         }
7421         if ($last_refresh) {
7422                 print "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td><td>$last_refresh</td></tr>\n";
7423         }
7424
7425         # use per project git URL list in $projectroot/$project/cloneurl
7426         # or make project git URL from git base URL and project name
7427         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7428         my @url_list = git_get_project_url_list($project);
7429         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7430         foreach my $git_url (@url_list) {
7431                 next unless $git_url;
7432                 print format_repo_url($url_tag, $git_url);
7433                 $url_tag = "";
7434         }
7435         @url_list = map { "$_/$project" } @git_base_push_urls;
7436         if (-f "$projectroot/$project/.nofetch") {
7437                 $url_tag = "Push&#160;URL";
7438                 foreach my $git_push_url (@url_list) {
7439                         next unless $git_push_url;
7440                         my $hint = $https_hint_html && $git_push_url =~ /^https:/i ?
7441                                 "&#160;$https_hint_html" : '';
7442                         print "<tr class=\"metadata_pushurl\"><td>$url_tag</td><td>$git_push_url$hint</td></tr>\n";
7443                         $url_tag = "";
7444                 }
7445         }
7446
7447         # Tag cloud
7448         my $show_ctags = gitweb_check_feature('ctags');
7449         if ($show_ctags) {
7450                 my $ctags = git_get_project_ctags($project);
7451                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7452                         # without ability to add tags, don't show if there are none
7453                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7454                         print "<tr id=\"metadata_ctags\">" .
7455                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7456                         print "</td>\n<td>" unless %$ctags;
7457                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7458                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7459                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7460                               unless $show_ctags =~ /^\d+$/;
7461                         print "</td>\n<td>" if %$ctags;
7462                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7463                               "</tr>\n";
7464                 }
7465         }
7466
7467         print "</table>\n";
7468
7469         # If XSS prevention is on, we don't include README.html.
7470         # TODO: Allow a readme in some safe format.
7471         if (!$prevent_xss && -s "$projectroot/$project/README.html") {
7472                 print "<div class=\"title\">readme</div>\n" .
7473                       "<div class=\"readme\">\n";
7474                 insert_file("$projectroot/$project/README.html");
7475                 print "\n</div>\n"; # class="readme"
7476         }
7477
7478         # we need to request one more than 16 (0..15) to check if
7479         # those 16 are all
7480         my @commitlist = $head ? parse_commits($head, 17) : ();
7481         if (@commitlist) {
7482                 git_print_header_div('shortlog');
7483                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7484                                   $#commitlist <=  15 ? undef :
7485                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7486         }
7487
7488         if (@taglist) {
7489                 git_print_header_div('tags');
7490                 git_tags_body(\@taglist, 0, 15,
7491                               $#taglist <=  15 ? undef :
7492                               $cgi->a({-href => href(action=>"tags")}, "..."));
7493         }
7494
7495         if (@headlist) {
7496                 git_print_header_div('heads');
7497                 git_heads_body(\@headlist, $head, 0, 15,
7498                                $#headlist <= 15 ? undef :
7499                                $cgi->a({-href => href(action=>"heads")}, "..."));
7500         }
7501
7502         if (%remotedata) {
7503                 git_print_header_div('remotes');
7504                 git_remotes_body(\%remotedata, 15, $head);
7505         }
7506
7507         if (@forklist) {
7508                 git_print_header_div('forks');
7509                 git_project_list_body(\@forklist, 'age', 0, 15,
7510                                       $#forklist <= 15 ? undef :
7511                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7512                                       'no_header', 'forks');
7513         }
7514
7515         git_footer_html();
7516 }
7517
7518 sub git_tag {
7519         my %tag = parse_tag($hash);
7520
7521         if (! %tag) {
7522                 die_error(404, "Unknown tag object");
7523         }
7524
7525         my $fullhash;
7526         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
7527         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
7528
7529         my $head = git_get_head_hash($project);
7530         git_header_html();
7531         git_print_page_nav('','', $head,undef,$head);
7532         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
7533         print "<div class=\"title_text\">\n" .
7534               "<table class=\"object_header\">\n" .
7535               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
7536               "<tr>\n" .
7537               "<td>object</td>\n" .
7538               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7539                                $tag{'object'}) . "</td>\n" .
7540               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7541                                               $tag{'type'}) . "</td>\n" .
7542               "</tr>\n";
7543         if (defined($tag{'author'})) {
7544                 git_print_authorship_rows(\%tag, 'author');
7545         }
7546         print "</table>\n\n" .
7547               "</div>\n";
7548         print "<div class=\"page_body\">";
7549         my $comment = $tag{'comment'};
7550         foreach my $line (@$comment) {
7551                 chomp $line;
7552                 print esc_html($line, -nbsp=>1) . "<br/>\n";
7553         }
7554         print "</div>\n";
7555         git_footer_html();
7556 }
7557
7558 sub git_blame_common {
7559         my $format = shift || 'porcelain';
7560         if ($format eq 'porcelain' && $input_params{'javascript'}) {
7561                 $format = 'incremental';
7562                 $action = 'blame_incremental'; # for page title etc
7563         }
7564
7565         # permissions
7566         gitweb_check_feature('blame')
7567                 or die_error(403, "Blame view not allowed");
7568
7569         # error checking
7570         die_error(400, "No file name given") unless $file_name;
7571         $hash_base ||= git_get_head_hash($project);
7572         die_error(404, "Couldn't find base commit") unless $hash_base;
7573         my %co = parse_commit($hash_base)
7574                 or die_error(404, "Commit not found");
7575         my $ftype = "blob";
7576         if (!defined $hash) {
7577                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
7578                         or die_error(404, "Error looking up file");
7579         } else {
7580                 $ftype = git_get_type($hash);
7581                 if ($ftype !~ "blob") {
7582                         die_error(400, "Object is not a blob");
7583                 }
7584         }
7585
7586         my $fd;
7587         if ($format eq 'incremental') {
7588                 # get file contents (as base)
7589                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
7590                         or die_error(500, "Open git-cat-file failed");
7591         } elsif ($format eq 'data') {
7592                 # run git-blame --incremental
7593                 defined($fd = git_cmd_pipe "blame", "--incremental",
7594                         $hash_base, "--", $file_name)
7595                         or die_error(500, "Open git-blame --incremental failed");
7596         } else {
7597                 # run git-blame --porcelain
7598                 defined($fd = git_cmd_pipe "blame", '-p',
7599                         $hash_base, '--', $file_name)
7600                         or die_error(500, "Open git-blame --porcelain failed");
7601         }
7602
7603         # incremental blame data returns early
7604         if ($format eq 'data') {
7605                 print $cgi->header(
7606                         -type=>"text/plain", -charset => "utf-8",
7607                         -status=> "200 OK");
7608                 local $| = 1; # output autoflush
7609                 while (<$fd>) {
7610                         print to_utf8($_);
7611                 }
7612                 close $fd
7613                         or print "ERROR $!\n";
7614
7615                 print 'END';
7616                 if (defined $t0 && gitweb_check_feature('timed')) {
7617                         print ' '.
7618                               tv_interval($t0, [ gettimeofday() ]).
7619                               ' '.$number_of_git_cmds;
7620                 }
7621                 print "\n";
7622
7623                 return;
7624         }
7625
7626         # page header
7627         git_header_html();
7628         my $formats_nav =
7629                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
7630                         "blob");
7631         $formats_nav .=
7632                 " | " .
7633                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7634                         "history") .
7635                 " | " .
7636                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
7637                         "HEAD");
7638         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7639         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7640         git_print_page_path($file_name, $ftype, $hash_base);
7641
7642         # page body
7643         if ($format eq 'incremental') {
7644                 print "<noscript>\n<div class=\"error\"><center><b>\n".
7645                       "This page requires JavaScript to run.\n Use ".
7646                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
7647                               'this page').
7648                       " instead.\n".
7649                       "</b></center></div>\n</noscript>\n";
7650
7651                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
7652         }
7653
7654         print qq!<div class="page_body">\n!;
7655         print qq!<div id="progress_info">... / ...</div>\n!
7656                 if ($format eq 'incremental');
7657         print qq!<table id="blame_table" class="blame" width="100%">\n!.
7658               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
7659               qq!<thead>\n!.
7660               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
7661               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
7662               qq!title="toggles blame author information display">[+]</a></th>!.
7663               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
7664               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
7665               qq!</thead>\n!.
7666               qq!<tbody>\n!;
7667
7668         my @rev_color = qw(light dark);
7669         my $num_colors = scalar(@rev_color);
7670         my $current_color = 0;
7671
7672         if ($format eq 'incremental') {
7673                 my $color_class = $rev_color[$current_color];
7674
7675                 #contents of a file
7676                 my $linenr = 0;
7677         LINE:
7678                 while (my $line = to_utf8(scalar <$fd>)) {
7679                         chomp $line;
7680                         $linenr++;
7681
7682                         print qq!<tr id="l$linenr" class="$color_class">!.
7683                               qq!<td class="sha1"><a href=""> </a></td>!.
7684                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
7685                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
7686                               qq!<td class="linenr">!.
7687                               qq!<a class="linenr" href="">$linenr</a></td>!;
7688                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
7689                         print qq!</tr>\n!;
7690                 }
7691
7692         } else { # porcelain, i.e. ordinary blame
7693                 my %metainfo = (); # saves information about commits
7694
7695                 # blame data
7696         LINE:
7697                 while (my $line = to_utf8(scalar <$fd>)) {
7698                         chomp $line;
7699                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
7700                         # no <lines in group> for subsequent lines in group of lines
7701                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
7702                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
7703                         if (!exists $metainfo{$full_rev}) {
7704                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
7705                         }
7706                         my $meta = $metainfo{$full_rev};
7707                         my $data;
7708                         while ($data = to_utf8(scalar <$fd>)) {
7709                                 chomp $data;
7710                                 last if ($data =~ s/^\t//); # contents of line
7711                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
7712                                         $meta->{$1} = $2 unless exists $meta->{$1};
7713                                 }
7714                                 if ($data =~ /^previous /) {
7715                                         $meta->{'nprevious'}++;
7716                                 }
7717                         }
7718                         my $short_rev = substr($full_rev, 0, 8);
7719                         my $author = $meta->{'author'};
7720                         my %date =
7721                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
7722                         my $date = $date{'iso-tz'};
7723                         if ($group_size) {
7724                                 $current_color = ($current_color + 1) % $num_colors;
7725                         }
7726                         my $tr_class = $rev_color[$current_color];
7727                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
7728                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
7729                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
7730                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
7731                         if ($group_size) {
7732                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
7733                                 print "<td class=\"sha1\"";
7734                                 print " title=\"". esc_html($author) . ", $date\"";
7735                                 print "$rowspan>";
7736                                 print $cgi->a({-href => href(action=>"commit",
7737                                                              hash=>$full_rev,
7738                                                              file_name=>$file_name)},
7739                                               esc_html($short_rev));
7740                                 if ($group_size >= 2) {
7741                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
7742                                         if (@author_initials) {
7743                                                 print "<br />" .
7744                                                       esc_html(join('', @author_initials));
7745                                                 #           or join('.', ...)
7746                                         }
7747                                 }
7748                                 print "</td>\n";
7749                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
7750                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
7751                         }
7752                         # 'previous' <sha1 of parent commit> <filename at commit>
7753                         if (exists $meta->{'previous'} &&
7754                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
7755                                 $meta->{'parent'} = $1;
7756                                 $meta->{'file_parent'} = unquote($2);
7757                         }
7758                         my $linenr_commit =
7759                                 exists($meta->{'parent'}) ?
7760                                 $meta->{'parent'} : $full_rev;
7761                         my $linenr_filename =
7762                                 exists($meta->{'file_parent'}) ?
7763                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
7764                         my $blamed = href(action => 'blame',
7765                                           file_name => $linenr_filename,
7766                                           hash_base => $linenr_commit);
7767                         print "<td class=\"linenr\">";
7768                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
7769                                         -class => "linenr" },
7770                                       esc_html($lineno));
7771                         print "</td>";
7772                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
7773                         print "</tr>\n";
7774                 } # end while
7775
7776         }
7777
7778         # footer
7779         print "</tbody>\n".
7780               "</table>\n"; # class="blame"
7781         print "</div>\n";   # class="blame_body"
7782         close $fd
7783                 or print "Reading blob failed\n";
7784
7785         git_footer_html();
7786 }
7787
7788 sub git_blame {
7789         git_blame_common();
7790 }
7791
7792 sub git_blame_incremental {
7793         git_blame_common('incremental');
7794 }
7795
7796 sub git_blame_data {
7797         git_blame_common('data');
7798 }
7799
7800 sub git_tags {
7801         my $head = git_get_head_hash($project);
7802         git_header_html();
7803         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
7804         git_print_header_div('summary', $project);
7805
7806         my @tagslist = git_get_tags_list();
7807         if (@tagslist) {
7808                 git_tags_body(\@tagslist);
7809         }
7810         git_footer_html();
7811 }
7812
7813 sub git_refs {
7814         my $order = $input_params{'order'};
7815         if (defined $order && $order !~ m/age|name/) {
7816                 die_error(400, "Unknown order parameter");
7817         }
7818
7819         my $head = git_get_head_hash($project);
7820         git_header_html();
7821         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
7822         git_print_header_div('summary', $project);
7823
7824         my @refslist = git_get_tags_list(undef, 1, $order);
7825         if (@refslist) {
7826                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
7827         }
7828         git_footer_html();
7829 }
7830
7831 sub git_heads {
7832         my $head = git_get_head_hash($project);
7833         git_header_html();
7834         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
7835         git_print_header_div('summary', $project);
7836
7837         my @headslist = git_get_heads_list();
7838         if (@headslist) {
7839                 git_heads_body(\@headslist, $head);
7840         }
7841         git_footer_html();
7842 }
7843
7844 # used both for single remote view and for list of all the remotes
7845 sub git_remotes {
7846         gitweb_check_feature('remote_heads')
7847                 or die_error(403, "Remote heads view is disabled");
7848
7849         my $head = git_get_head_hash($project);
7850         my $remote = $input_params{'hash'};
7851
7852         my $remotedata = git_get_remotes_list($remote);
7853         die_error(500, "Unable to get remote information") unless defined $remotedata;
7854
7855         unless (%$remotedata) {
7856                 die_error(404, defined $remote ?
7857                         "Remote $remote not found" :
7858                         "No remotes found");
7859         }
7860
7861         git_header_html(undef, undef, -action_extra => $remote);
7862         git_print_page_nav('', '',  $head, undef, $head,
7863                 format_ref_views($remote ? '' : 'remotes'));
7864
7865         fill_remote_heads($remotedata);
7866         if (defined $remote) {
7867                 git_print_header_div('remotes', "$remote remote for $project");
7868                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
7869         } else {
7870                 git_print_header_div('summary', "$project remotes");
7871                 git_remotes_body($remotedata, undef, $head);
7872         }
7873
7874         git_footer_html();
7875 }
7876
7877 sub git_blob_plain {
7878         my $type = shift;
7879         my $expires;
7880
7881         if (!defined $hash) {
7882                 if (defined $file_name) {
7883                         my $base = $hash_base || git_get_head_hash($project);
7884                         $hash = git_get_hash_by_path($base, $file_name, "blob")
7885                                 or die_error(404, "Cannot find file");
7886                 } else {
7887                         die_error(400, "No file name defined");
7888                 }
7889         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7890                 # blobs defined by non-textual hash id's can be cached
7891                 $expires = "+1d";
7892         }
7893
7894         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
7895                 or die_error(500, "Open git-cat-file blob '$hash' failed");
7896         binmode($fd);
7897
7898         # content-type (can include charset)
7899         my $leader;
7900         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
7901
7902         # "save as" filename, even when no $file_name is given
7903         my $save_as = "$hash";
7904         if (defined $file_name) {
7905                 $save_as = $file_name;
7906         } elsif ($type =~ m/^text\//) {
7907                 $save_as .= '.txt';
7908         }
7909
7910         # With XSS prevention on, blobs of all types except a few known safe
7911         # ones are served with "Content-Disposition: attachment" to make sure
7912         # they don't run in our security domain.  For certain image types,
7913         # blob view writes an <img> tag referring to blob_plain view, and we
7914         # want to be sure not to break that by serving the image as an
7915         # attachment (though Firefox 3 doesn't seem to care).
7916         my $sandbox = $prevent_xss &&
7917                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
7918
7919         # serve text/* as text/plain
7920         if ($prevent_xss &&
7921             ($type =~ m!^text/[a-z]+\b(.*)$! ||
7922              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
7923                 my $rest = $1;
7924                 $rest = defined $rest ? $rest : '';
7925                 $type = "text/plain$rest";
7926         }
7927
7928         print $cgi->header(
7929                 -type => $type,
7930                 -expires => $expires,
7931                 -content_disposition =>
7932                         ($sandbox ? 'attachment' : 'inline')
7933                         . '; filename="' . $save_as . '"');
7934         binmode STDOUT, ':raw';
7935         $fcgi_raw_mode = 1;
7936         print $leader if defined $leader;
7937         my $buf;
7938         while (read($fd, $buf, 32768)) {
7939                 print $buf;
7940         }
7941         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
7942         $fcgi_raw_mode = 0;
7943         close $fd;
7944 }
7945
7946 sub git_blob {
7947         my $expires;
7948
7949         my $fullhash;
7950         if (!defined $hash) {
7951                 if (defined $file_name) {
7952                         my $base = $hash_base || git_get_head_hash($project);
7953                         $hash = git_get_hash_by_path($base, $file_name, "blob")
7954                                 or die_error(404, "Cannot find file");
7955                         $fullhash = $hash;
7956                 } else {
7957                         die_error(400, "No file name defined");
7958                 }
7959         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7960                 # blobs defined by non-textual hash id's can be cached
7961                 $expires = "+1d";
7962                 $fullhash = $hash;
7963         }
7964         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
7965
7966         my $have_blame = gitweb_check_feature('blame');
7967         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
7968                 or die_error(500, "Couldn't cat $file_name, $hash");
7969         binmode($fd);
7970         my $mimetype = blob_mimetype($fd, $file_name);
7971         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
7972         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
7973                 close $fd;
7974                 return git_blob_plain($mimetype);
7975         }
7976         # we can have blame only for text/* mimetype
7977         $have_blame &&= ($mimetype =~ m!^text/!);
7978
7979         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
7980         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
7981         my $highlight_mode_active;
7982         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
7983
7984         git_header_html(undef, $expires);
7985         my $formats_nav = '';
7986         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7987                 if (defined $file_name) {
7988                         if ($have_blame) {
7989                                 $formats_nav .=
7990                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
7991                                                 -class => "blamelink"},
7992                                                 "blame") .
7993                                         " | ";
7994                         }
7995                         $formats_nav .=
7996                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7997                                         "history") .
7998                                 " | " .
7999                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8000                                         "raw") .
8001                                 " | " .
8002                                 $cgi->a({-href => href(action=>"blob",
8003                                                        hash_base=>"HEAD", file_name=>$file_name)},
8004                                         "HEAD");
8005                 } else {
8006                         $formats_nav .=
8007                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8008                                         "raw");
8009                 }
8010                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8011                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8012         } else {
8013                 print "<div class=\"page_nav\">\n" .
8014                       "<br/><br/></div>\n" .
8015                       "<div class=\"title\">".esc_html($hash)."</div>\n";
8016         }
8017         git_print_page_path($file_name, "blob", $hash_base);
8018         print "<div class=\"title_text\">\n" .
8019               "<table class=\"object_header\">\n";
8020         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8021         print "</table>".
8022               "</div>\n";
8023         print "<div class=\"page_body\">\n";
8024         if ($mimetype =~ m!^image/!) {
8025                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8026                 if ($file_name) {
8027                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8028                 }
8029                 print qq! src="! .
8030                       href(action=>"blob_plain", hash=>$hash,
8031                            hash_base=>$hash_base, file_name=>$file_name) .
8032                       qq!" />\n!;
8033         } else {
8034                 my $nr;
8035                 while (my $line = to_utf8(scalar <$fd>)) {
8036                         chomp $line;
8037                         $nr++;
8038                         $line = untabify($line);
8039                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
8040                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8041                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8042                 }
8043         }
8044         close $fd
8045                 or print "Reading blob failed.\n";
8046         print "</div>";
8047         git_footer_html();
8048 }
8049
8050 sub git_tree {
8051         my $fullhash;
8052         if (!defined $hash_base) {
8053                 $hash_base = "HEAD";
8054         }
8055         if (!defined $hash) {
8056                 if (defined $file_name) {
8057                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8058                         $fullhash = $hash;
8059                 } else {
8060                         $hash = $hash_base;
8061                 }
8062         }
8063         die_error(404, "No such tree") unless defined($hash);
8064         $fullhash = $hash if !$fullhash && $hash =~ m/^[0-9a-fA-F]{40}$/;
8065         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8066
8067         my $show_sizes = gitweb_check_feature('show-sizes');
8068         my $have_blame = gitweb_check_feature('blame');
8069
8070         my @entries = ();
8071         {
8072                 local $/ = "\0";
8073                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8074                         ($show_sizes ? '-l' : ()), @extra_options, $hash)
8075                         or die_error(500, "Open git-ls-tree failed");
8076                 @entries = map { chomp; to_utf8($_) } <$fd>;
8077                 close $fd
8078                         or die_error(404, "Reading tree failed");
8079         }
8080
8081         git_header_html();
8082         my $basedir = '';
8083         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8084                 my $refs = git_get_references();
8085                 my $ref = format_ref_marker($refs, $co{'id'});
8086                 my @views_nav = ();
8087                 if (defined $file_name) {
8088                         push @views_nav,
8089                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8090                                         "history"),
8091                                 $cgi->a({-href => href(action=>"tree",
8092                                                        hash_base=>"HEAD", file_name=>$file_name)},
8093                                         "HEAD"),
8094                 }
8095                 my $snapshot_links = format_snapshot_links($hash);
8096                 if (defined $snapshot_links) {
8097                         # FIXME: Should be available when we have no hash base as well.
8098                         push @views_nav, $snapshot_links;
8099                 }
8100                 git_print_page_nav('tree','', $hash_base, undef, undef,
8101                                    join(' | ', @views_nav));
8102                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8103         } else {
8104                 undef $hash_base;
8105                 print "<div class=\"page_nav\">\n";
8106                 print "<br/><br/></div>\n";
8107                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8108         }
8109         if (defined $file_name) {
8110                 $basedir = $file_name;
8111                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8112                         $basedir .= '/';
8113                 }
8114                 git_print_page_path($file_name, 'tree', $hash_base);
8115         }
8116         print "<div class=\"title_text\">\n" .
8117               "<table class=\"object_header\">\n";
8118         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8119         print "</table>".
8120               "</div>\n";
8121         print "<div class=\"page_body\">\n";
8122         print "<table class=\"tree\">\n";
8123         my $alternate = 1;
8124         # '..' (top directory) link if possible
8125         if (defined $hash_base &&
8126             defined $file_name && $file_name =~ m![^/]+$!) {
8127                 if ($alternate) {
8128                         print "<tr class=\"dark\">\n";
8129                 } else {
8130                         print "<tr class=\"light\">\n";
8131                 }
8132                 $alternate ^= 1;
8133
8134                 my $up = $file_name;
8135                 $up =~ s!/?[^/]+$!!;
8136                 undef $up unless $up;
8137                 # based on git_print_tree_entry
8138                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8139                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8140                 print '<td class="list">';
8141                 print $cgi->a({-href => href(action=>"tree",
8142                                              hash_base=>$hash_base,
8143                                              file_name=>$up)},
8144                               "..");
8145                 print "</td>\n";
8146                 print "<td class=\"link\"></td>\n";
8147
8148                 print "</tr>\n";
8149         }
8150         foreach my $line (@entries) {
8151                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8152
8153                 if ($alternate) {
8154                         print "<tr class=\"dark\">\n";
8155                 } else {
8156                         print "<tr class=\"light\">\n";
8157                 }
8158                 $alternate ^= 1;
8159
8160                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8161
8162                 print "</tr>\n";
8163         }
8164         print "</table>\n" .
8165               "</div>";
8166         git_footer_html();
8167 }
8168
8169 sub sanitize_for_filename {
8170     my $name = shift;
8171
8172     $name =~ s!/!-!g;
8173     $name =~ s/[^[:alnum:]_.-]//g;
8174
8175     return $name;
8176 }
8177
8178 sub snapshot_name {
8179         my ($project, $hash) = @_;
8180
8181         # path/to/project.git  -> project
8182         # path/to/project/.git -> project
8183         my $name = to_utf8($project);
8184         $name =~ s,([^/])/*\.git$,$1,;
8185         $name = sanitize_for_filename(basename($name));
8186
8187         my $ver = $hash;
8188         if ($hash =~ /^[0-9a-fA-F]+$/) {
8189                 # shorten SHA-1 hash
8190                 my $full_hash = git_get_full_hash($project, $hash);
8191                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8192                         $ver = git_get_short_hash($project, $hash);
8193                 }
8194         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8195                 # tags don't need shortened SHA-1 hash
8196                 $ver = $1;
8197         } else {
8198                 # branches and other need shortened SHA-1 hash
8199                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8200                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8201                         my $ref_dir = (defined $1) ? $1 : '';
8202                         $ver = $2;
8203
8204                         $ref_dir = sanitize_for_filename($ref_dir);
8205                         # for refs neither in heads nor remotes we want to
8206                         # add a ref dir to archive name
8207                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8208                                 $ver = $ref_dir . '-' . $ver;
8209                         }
8210                 }
8211                 $ver .= '-' . git_get_short_hash($project, $hash);
8212         }
8213         # special case of sanitization for filename - we change
8214         # slashes to dots instead of dashes
8215         # in case of hierarchical branch names
8216         $ver =~ s!/!.!g;
8217         $ver =~ s/[^[:alnum:]_.-]//g;
8218
8219         # name = project-version_string
8220         $name = "$name-$ver";
8221
8222         return wantarray ? ($name, $name) : $name;
8223 }
8224
8225 sub exit_if_unmodified_since {
8226         my ($latest_epoch) = @_;
8227         our $cgi;
8228
8229         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8230         if (defined $if_modified) {
8231                 my $since;
8232                 if (eval { require HTTP::Date; 1; }) {
8233                         $since = HTTP::Date::str2time($if_modified);
8234                 } elsif (eval { require Time::ParseDate; 1; }) {
8235                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8236                 }
8237                 if (defined $since && $latest_epoch <= $since) {
8238                         my %latest_date = parse_date($latest_epoch);
8239                         print $cgi->header(
8240                                 -last_modified => $latest_date{'rfc2822'},
8241                                 -status => '304 Not Modified');
8242                         goto DONE_GITWEB;
8243                 }
8244         }
8245 }
8246
8247 sub git_snapshot {
8248         my $format = $input_params{'snapshot_format'};
8249         if (!@snapshot_fmts) {
8250                 die_error(403, "Snapshots not allowed");
8251         }
8252         # default to first supported snapshot format
8253         $format ||= $snapshot_fmts[0];
8254         if ($format !~ m/^[a-z0-9]+$/) {
8255                 die_error(400, "Invalid snapshot format parameter");
8256         } elsif (!exists($known_snapshot_formats{$format})) {
8257                 die_error(400, "Unknown snapshot format");
8258         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8259                 die_error(403, "Snapshot format not allowed");
8260         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8261                 die_error(403, "Unsupported snapshot format");
8262         }
8263
8264         my $type = git_get_type("$hash^{}");
8265         if (!$type) {
8266                 die_error(404, 'Object does not exist');
8267         }  elsif ($type eq 'blob') {
8268                 die_error(400, 'Object is not a tree-ish');
8269         }
8270
8271         my ($name, $prefix) = snapshot_name($project, $hash);
8272         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8273
8274         my %co = parse_commit($hash);
8275         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8276
8277         my @cmd = (
8278                 git_cmd(), 'archive',
8279                 "--format=$known_snapshot_formats{$format}{'format'}",
8280                 "--prefix=$prefix/", $hash);
8281         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8282                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8283                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8284         }
8285
8286         $filename =~ s/(["\\])/\\$1/g;
8287         my %latest_date;
8288         if (%co) {
8289                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8290         }
8291
8292         print $cgi->header(
8293                 -type => $known_snapshot_formats{$format}{'type'},
8294                 -content_disposition => 'inline; filename="' . $filename . '"',
8295                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8296                 -status => '200 OK');
8297
8298         defined(my $fd = cmd_pipe @cmd)
8299                 or die_error(500, "Execute git-archive failed");
8300         binmode($fd);
8301         binmode STDOUT, ':raw';
8302         $fcgi_raw_mode = 1;
8303         my $buf;
8304         while (read($fd, $buf, 32768)) {
8305                 print $buf;
8306         }
8307         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8308         $fcgi_raw_mode = 0;
8309         close $fd;
8310 }
8311
8312 sub git_log_generic {
8313         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8314
8315         my $head = git_get_head_hash($project);
8316         if (!defined $base) {
8317                 $base = $head;
8318         }
8319         if (!defined $page) {
8320                 $page = 0;
8321         }
8322         my $refs = git_get_references();
8323
8324         my $commit_hash = $base;
8325         if (defined $parent) {
8326                 $commit_hash = "$parent..$base";
8327         }
8328         my @commitlist =
8329                 parse_commits($commit_hash, 101, (100 * $page),
8330                               defined $file_name ? ($file_name, "--full-history") : ());
8331
8332         my $ftype;
8333         if (!defined $file_hash && defined $file_name) {
8334                 # some commits could have deleted file in question,
8335                 # and not have it in tree, but one of them has to have it
8336                 for (my $i = 0; $i < @commitlist; $i++) {
8337                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8338                         last if defined $file_hash;
8339                 }
8340         }
8341         if (defined $file_hash) {
8342                 $ftype = git_get_type($file_hash);
8343         }
8344         if (defined $file_name && !defined $ftype) {
8345                 die_error(500, "Unknown type of object");
8346         }
8347         my %co;
8348         if (defined $file_name) {
8349                 %co = parse_commit($base)
8350                         or die_error(404, "Unknown commit object");
8351         }
8352
8353
8354         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100);
8355         my $next_link = '';
8356         if ($#commitlist >= 100) {
8357                 $next_link =
8358                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8359                                  -accesskey => "n", -title => "Alt-n"}, "next");
8360         }
8361         my ($patch_max) = gitweb_get_feature('patches');
8362         if ($patch_max && !defined $file_name) {
8363                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8364                         $paging_nav .= " &#183; " .
8365                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
8366                                         "patches");
8367                 }
8368         }
8369
8370         {
8371                 local $action = 'fulllog';
8372                 git_header_html();
8373         }
8374         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8375         if (defined $file_name) {
8376                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8377         } else {
8378                 git_print_header_div('summary', $project)
8379         }
8380         git_print_page_path($file_name, $ftype, $hash_base)
8381                 if (defined $file_name);
8382
8383         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8384                      $file_name, $file_hash, $ftype);
8385
8386         git_footer_html();
8387 }
8388
8389 sub git_log {
8390         git_log_generic('log', \&git_log_body,
8391                         $hash, $hash_parent);
8392 }
8393
8394 sub git_commit {
8395         $hash ||= $hash_base || "HEAD";
8396         my %co = parse_commit($hash)
8397             or die_error(404, "Unknown commit object");
8398
8399         my $parent  = $co{'parent'};
8400         my $parents = $co{'parents'}; # listref
8401
8402         # we need to prepare $formats_nav before any parameter munging
8403         my $formats_nav;
8404         if (!defined $parent) {
8405                 # --root commitdiff
8406                 $formats_nav .= '(initial)';
8407         } elsif (@$parents == 1) {
8408                 # single parent commit
8409                 $formats_nav .=
8410                         '(parent: ' .
8411                         $cgi->a({-href => href(action=>"commit",
8412                                                hash=>$parent)},
8413                                 esc_html(substr($parent, 0, 7))) .
8414                         ')';
8415         } else {
8416                 # merge commit
8417                 $formats_nav .=
8418                         '(merge: ' .
8419                         join(' ', map {
8420                                 $cgi->a({-href => href(action=>"commit",
8421                                                        hash=>$_)},
8422                                         esc_html(substr($_, 0, 7)));
8423                         } @$parents ) .
8424                         ')';
8425         }
8426         if (gitweb_check_feature('patches') && @$parents <= 1) {
8427                 $formats_nav .= " | " .
8428                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8429                                 "patch");
8430         }
8431
8432         if (!defined $parent) {
8433                 $parent = "--root";
8434         }
8435         my @difftree;
8436         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8437                 @diff_opts,
8438                 (@$parents <= 1 ? $parent : '-c'),
8439                 $hash, "--")
8440                 or die_error(500, "Open git-diff-tree failed");
8441         @difftree = map { chomp; to_utf8($_) } <$fd>;
8442         close $fd or die_error(404, "Reading git-diff-tree failed");
8443
8444         # non-textual hash id's can be cached
8445         my $expires;
8446         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8447                 $expires = "+1d";
8448         }
8449         my $refs = git_get_references();
8450         my $ref = format_ref_marker($refs, $co{'id'});
8451
8452         git_header_html(undef, $expires);
8453         git_print_page_nav('commit', '',
8454                            $hash, $co{'tree'}, $hash,
8455                            $formats_nav);
8456
8457         if (defined $co{'parent'}) {
8458                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
8459         } else {
8460                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
8461         }
8462         print "<div class=\"title_text\">\n" .
8463               "<table class=\"object_header\">\n";
8464         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8465         git_print_authorship_rows(\%co);
8466         print "<tr>" .
8467               "<td>tree</td>" .
8468               "<td class=\"sha1\">" .
8469               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8470                        class => "list"}, $co{'tree'}) .
8471               "</td>" .
8472               "<td class=\"link\">" .
8473               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8474                       "tree");
8475         my $snapshot_links = format_snapshot_links($hash);
8476         if (defined $snapshot_links) {
8477                 print " | " . $snapshot_links;
8478         }
8479         print "</td>" .
8480               "</tr>\n";
8481
8482         foreach my $par (@$parents) {
8483                 print "<tr>" .
8484                       "<td>parent</td>" .
8485                       "<td class=\"sha1\">" .
8486                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8487                                class => "list"}, $par) .
8488                       "</td>" .
8489                       "<td class=\"link\">" .
8490                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8491                       " | " .
8492                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8493                       "</td>" .
8494                       "</tr>\n";
8495         }
8496         print "</table>".
8497               "</div>\n";
8498
8499         print "<div class=\"page_body\">\n";
8500         git_print_log($co{'comment'});
8501         print "</div>\n";
8502
8503         git_difftree_body(\@difftree, $hash, @$parents);
8504
8505         git_footer_html();
8506 }
8507
8508 sub git_object {
8509         # object is defined by:
8510         # - hash or hash_base alone
8511         # - hash_base and file_name
8512         my $type;
8513
8514         # - hash or hash_base alone
8515         if ($hash || ($hash_base && !defined $file_name)) {
8516                 my $object_id = $hash || $hash_base;
8517
8518                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8519                         or die_error(404, "Object does not exist");
8520                 $type = <$fd>;
8521                 chomp $type;
8522                 close $fd
8523                         or die_error(404, "Object does not exist");
8524
8525         # - hash_base and file_name
8526         } elsif ($hash_base && defined $file_name) {
8527                 $file_name =~ s,/+$,,;
8528
8529                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
8530                         or die_error(404, "Base object does not exist");
8531
8532                 # here errors should not happen
8533                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
8534                         or die_error(500, "Open git-ls-tree failed");
8535                 my $line = to_utf8(scalar <$fd>);
8536                 close $fd;
8537
8538                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
8539                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
8540                         die_error(404, "File or directory for given base does not exist");
8541                 }
8542                 $type = $2;
8543                 $hash = $3;
8544         } else {
8545                 die_error(400, "Not enough information to find object");
8546         }
8547
8548         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
8549                                           hash=>$hash, hash_base=>$hash_base,
8550                                           file_name=>$file_name),
8551                              -status => '302 Found');
8552 }
8553
8554 sub git_blobdiff {
8555         my $format = shift || 'html';
8556         my $diff_style = $input_params{'diff_style'} || 'inline';
8557
8558         my $fd;
8559         my @difftree;
8560         my %diffinfo;
8561         my $expires;
8562
8563         # preparing $fd and %diffinfo for git_patchset_body
8564         # new style URI
8565         if (defined $hash_base && defined $hash_parent_base) {
8566                 if (defined $file_name) {
8567                         # read raw output
8568                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8569                                 $hash_parent_base, $hash_base,
8570                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
8571                                 or die_error(500, "Open git-diff-tree failed");
8572                         @difftree = map { chomp; to_utf8($_) } <$fd>;
8573                         close $fd
8574                                 or die_error(404, "Reading git-diff-tree failed");
8575                         @difftree
8576                                 or die_error(404, "Blob diff not found");
8577
8578                 } elsif (defined $hash &&
8579                          $hash =~ /[0-9a-fA-F]{40}/) {
8580                         # try to find filename from $hash
8581
8582                         # read filtered raw output
8583                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8584                                 $hash_parent_base, $hash_base, "--")
8585                                 or die_error(500, "Open git-diff-tree failed");
8586                         @difftree =
8587                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
8588                                 # $hash == to_id
8589                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
8590                                 map { chomp; to_utf8($_) } <$fd>;
8591                         close $fd
8592                                 or die_error(404, "Reading git-diff-tree failed");
8593                         @difftree
8594                                 or die_error(404, "Blob diff not found");
8595
8596                 } else {
8597                         die_error(400, "Missing one of the blob diff parameters");
8598                 }
8599
8600                 if (@difftree > 1) {
8601                         die_error(400, "Ambiguous blob diff specification");
8602                 }
8603
8604                 %diffinfo = parse_difftree_raw_line($difftree[0]);
8605                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
8606                 $file_name   ||= $diffinfo{'to_file'};
8607
8608                 $hash_parent ||= $diffinfo{'from_id'};
8609                 $hash        ||= $diffinfo{'to_id'};
8610
8611                 # non-textual hash id's can be cached
8612                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
8613                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
8614                         $expires = '+1d';
8615                 }
8616
8617                 # open patch output
8618                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8619                         '-p', ($format eq 'html' ? "--full-index" : ()),
8620                         $hash_parent_base, $hash_base,
8621                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
8622                         or die_error(500, "Open git-diff-tree failed");
8623         }
8624
8625         # old/legacy style URI -- not generated anymore since 1.4.3.
8626         if (!%diffinfo) {
8627                 die_error('404 Not Found', "Missing one of the blob diff parameters")
8628         }
8629
8630         # header
8631         if ($format eq 'html') {
8632                 my $formats_nav =
8633                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
8634                                 "raw");
8635                 $formats_nav .= diff_style_nav($diff_style);
8636                 git_header_html(undef, $expires);
8637                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8638                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8639                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8640                 } else {
8641                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
8642                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
8643                 }
8644                 if (defined $file_name) {
8645                         git_print_page_path($file_name, "blob", $hash_base);
8646                 } else {
8647                         print "<div class=\"page_path\"></div>\n";
8648                 }
8649
8650         } elsif ($format eq 'plain') {
8651                 print $cgi->header(
8652                         -type => 'text/plain',
8653                         -charset => 'utf-8',
8654                         -expires => $expires,
8655                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
8656
8657                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8658
8659         } else {
8660                 die_error(400, "Unknown blobdiff format");
8661         }
8662
8663         # patch
8664         if ($format eq 'html') {
8665                 print "<div class=\"page_body\">\n";
8666
8667                 git_patchset_body($fd, $diff_style,
8668                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
8669                 close $fd;
8670
8671                 print "</div>\n"; # class="page_body"
8672                 git_footer_html();
8673
8674         } else {
8675                 while (my $line = to_utf8(scalar <$fd>)) {
8676                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
8677                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
8678
8679                         print $line;
8680
8681                         last if $line =~ m!^\+\+\+!;
8682                 }
8683                 while (<$fd>) {
8684                         print to_utf8($_);
8685                 }
8686                 close $fd;
8687         }
8688 }
8689
8690 sub git_blobdiff_plain {
8691         git_blobdiff('plain');
8692 }
8693
8694 # assumes that it is added as later part of already existing navigation,
8695 # so it returns "| foo | bar" rather than just "foo | bar"
8696 sub diff_style_nav {
8697         my ($diff_style, $is_combined) = @_;
8698         $diff_style ||= 'inline';
8699
8700         return "" if ($is_combined);
8701
8702         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
8703         my %styles = @styles;
8704         @styles =
8705                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
8706
8707         return join '',
8708                 map { " | ".$_ }
8709                 map {
8710                         $_ eq $diff_style ? $styles{$_} :
8711                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
8712                 } @styles;
8713 }
8714
8715 sub git_commitdiff {
8716         my %params = @_;
8717         my $format = $params{-format} || 'html';
8718         my $diff_style = $input_params{'diff_style'} || 'inline';
8719
8720         my ($patch_max) = gitweb_get_feature('patches');
8721         if ($format eq 'patch') {
8722                 die_error(403, "Patch view not allowed") unless $patch_max;
8723         }
8724
8725         $hash ||= $hash_base || "HEAD";
8726         my %co = parse_commit($hash)
8727             or die_error(404, "Unknown commit object");
8728
8729         # choose format for commitdiff for merge
8730         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
8731                 $hash_parent = '--cc';
8732         }
8733         # we need to prepare $formats_nav before almost any parameter munging
8734         my $formats_nav;
8735         if ($format eq 'html') {
8736                 $formats_nav =
8737                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
8738                                 "raw");
8739                 if ($patch_max && @{$co{'parents'}} <= 1) {
8740                         $formats_nav .= " | " .
8741                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
8742                                         "patch");
8743                 }
8744                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
8745
8746                 if (defined $hash_parent &&
8747                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
8748                         # commitdiff with two commits given
8749                         my $hash_parent_short = $hash_parent;
8750                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
8751                                 $hash_parent_short = substr($hash_parent, 0, 7);
8752                         }
8753                         $formats_nav .=
8754                                 ' (from';
8755                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
8756                                 if ($co{'parents'}[$i] eq $hash_parent) {
8757                                         $formats_nav .= ' parent ' . ($i+1);
8758                                         last;
8759                                 }
8760                         }
8761                         $formats_nav .= ': ' .
8762                                 $cgi->a({-href => href(-replay=>1,
8763                                                        hash=>$hash_parent, hash_base=>undef)},
8764                                         esc_html($hash_parent_short)) .
8765                                 ')';
8766                 } elsif (!$co{'parent'}) {
8767                         # --root commitdiff
8768                         $formats_nav .= ' (initial)';
8769                 } elsif (scalar @{$co{'parents'}} == 1) {
8770                         # single parent commit
8771                         $formats_nav .=
8772                                 ' (parent: ' .
8773                                 $cgi->a({-href => href(-replay=>1,
8774                                                        hash=>$co{'parent'}, hash_base=>undef)},
8775                                         esc_html(substr($co{'parent'}, 0, 7))) .
8776                                 ')';
8777                 } else {
8778                         # merge commit
8779                         if ($hash_parent eq '--cc') {
8780                                 $formats_nav .= ' | ' .
8781                                         $cgi->a({-href => href(-replay=>1,
8782                                                                hash=>$hash, hash_parent=>'-c')},
8783                                                 'combined');
8784                         } else { # $hash_parent eq '-c'
8785                                 $formats_nav .= ' | ' .
8786                                         $cgi->a({-href => href(-replay=>1,
8787                                                                hash=>$hash, hash_parent=>'--cc')},
8788                                                 'compact');
8789                         }
8790                         $formats_nav .=
8791                                 ' (merge: ' .
8792                                 join(' ', map {
8793                                         $cgi->a({-href => href(-replay=>1,
8794                                                                hash=>$_, hash_base=>undef)},
8795                                                 esc_html(substr($_, 0, 7)));
8796                                 } @{$co{'parents'}} ) .
8797                                 ')';
8798                 }
8799         }
8800
8801         my $hash_parent_param = $hash_parent;
8802         if (!defined $hash_parent_param) {
8803                 # --cc for multiple parents, --root for parentless
8804                 $hash_parent_param =
8805                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
8806         }
8807
8808         # read commitdiff
8809         my $fd;
8810         my @difftree;
8811         if ($format eq 'html') {
8812                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8813                         "--no-commit-id", "--patch-with-raw", "--full-index",
8814                         $hash_parent_param, $hash, "--")
8815                         or die_error(500, "Open git-diff-tree failed");
8816
8817                 while (my $line = to_utf8(scalar <$fd>)) {
8818                         chomp $line;
8819                         # empty line ends raw part of diff-tree output
8820                         last unless $line;
8821                         push @difftree, scalar parse_difftree_raw_line($line);
8822                 }
8823
8824         } elsif ($format eq 'plain') {
8825                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8826                         '-p', $hash_parent_param, $hash, "--")
8827                         or die_error(500, "Open git-diff-tree failed");
8828         } elsif ($format eq 'patch') {
8829                 # For commit ranges, we limit the output to the number of
8830                 # patches specified in the 'patches' feature.
8831                 # For single commits, we limit the output to a single patch,
8832                 # diverging from the git-format-patch default.
8833                 my @commit_spec = ();
8834                 if ($hash_parent) {
8835                         if ($patch_max > 0) {
8836                                 push @commit_spec, "-$patch_max";
8837                         }
8838                         push @commit_spec, '-n', "$hash_parent..$hash";
8839                 } else {
8840                         if ($params{-single}) {
8841                                 push @commit_spec, '-1';
8842                         } else {
8843                                 if ($patch_max > 0) {
8844                                         push @commit_spec, "-$patch_max";
8845                                 }
8846                                 push @commit_spec, "-n";
8847                         }
8848                         push @commit_spec, '--root', $hash;
8849                 }
8850                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
8851                         '--encoding=utf8', '--stdout', @commit_spec)
8852                         or die_error(500, "Open git-format-patch failed");
8853         } else {
8854                 die_error(400, "Unknown commitdiff format");
8855         }
8856
8857         # non-textual hash id's can be cached
8858         my $expires;
8859         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8860                 $expires = "+1d";
8861         }
8862
8863         # write commit message
8864         if ($format eq 'html') {
8865                 my $refs = git_get_references();
8866                 my $ref = format_ref_marker($refs, $co{'id'});
8867
8868                 git_header_html(undef, $expires);
8869                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
8870                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
8871                 print "<div class=\"title_text\">\n" .
8872                       "<table class=\"object_header\">\n";
8873                 git_print_authorship_rows(\%co);
8874                 print "</table>".
8875                       "</div>\n";
8876                 print "<div class=\"page_body\">\n";
8877                 if (@{$co{'comment'}} > 1) {
8878                         print "<div class=\"log\">\n";
8879                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
8880                         print "</div>\n"; # class="log"
8881                 }
8882
8883         } elsif ($format eq 'plain') {
8884                 my $refs = git_get_references("tags");
8885                 my $tagname = git_get_rev_name_tags($hash);
8886                 my $filename = basename($project) . "-$hash.patch";
8887
8888                 print $cgi->header(
8889                         -type => 'text/plain',
8890                         -charset => 'utf-8',
8891                         -expires => $expires,
8892                         -content_disposition => 'inline; filename="' . "$filename" . '"');
8893                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
8894                 print "From: " . to_utf8($co{'author'}) . "\n";
8895                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
8896                 print "Subject: " . to_utf8($co{'title'}) . "\n";
8897
8898                 print "X-Git-Tag: $tagname\n" if $tagname;
8899                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8900
8901                 foreach my $line (@{$co{'comment'}}) {
8902                         print to_utf8($line) . "\n";
8903                 }
8904                 print "---\n\n";
8905         } elsif ($format eq 'patch') {
8906                 my $filename = basename($project) . "-$hash.patch";
8907
8908                 print $cgi->header(
8909                         -type => 'text/plain',
8910                         -charset => 'utf-8',
8911                         -expires => $expires,
8912                         -content_disposition => 'inline; filename="' . "$filename" . '"');
8913         }
8914
8915         # write patch
8916         if ($format eq 'html') {
8917                 my $use_parents = !defined $hash_parent ||
8918                         $hash_parent eq '-c' || $hash_parent eq '--cc';
8919                 git_difftree_body(\@difftree, $hash,
8920                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
8921                 print "<br/>\n";
8922
8923                 git_patchset_body($fd, $diff_style,
8924                                   \@difftree, $hash,
8925                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
8926                 close $fd;
8927                 print "</div>\n"; # class="page_body"
8928                 git_footer_html();
8929
8930         } elsif ($format eq 'plain') {
8931                 while (<$fd>) {
8932                         print to_utf8($_);
8933                 }
8934                 close $fd
8935                         or print "Reading git-diff-tree failed\n";
8936         } elsif ($format eq 'patch') {
8937                 while (<$fd>) {
8938                         print to_utf8($_);
8939                 }
8940                 close $fd
8941                         or print "Reading git-format-patch failed\n";
8942         }
8943 }
8944
8945 sub git_commitdiff_plain {
8946         git_commitdiff(-format => 'plain');
8947 }
8948
8949 # format-patch-style patches
8950 sub git_patch {
8951         git_commitdiff(-format => 'patch', -single => 1);
8952 }
8953
8954 sub git_patches {
8955         git_commitdiff(-format => 'patch');
8956 }
8957
8958 sub git_history {
8959         git_log_generic('history', \&git_history_body,
8960                         $hash_base, $hash_parent_base,
8961                         $file_name, $hash);
8962 }
8963
8964 sub git_search {
8965         $searchtype ||= 'commit';
8966
8967         # check if appropriate features are enabled
8968         gitweb_check_feature('search')
8969                 or die_error(403, "Search is disabled");
8970         if ($searchtype eq 'pickaxe') {
8971                 # pickaxe may take all resources of your box and run for several minutes
8972                 # with every query - so decide by yourself how public you make this feature
8973                 gitweb_check_feature('pickaxe')
8974                         or die_error(403, "Pickaxe search is disabled");
8975         }
8976         if ($searchtype eq 'grep') {
8977                 # grep search might be potentially CPU-intensive, too
8978                 gitweb_check_feature('grep')
8979                         or die_error(403, "Grep search is disabled");
8980         }
8981
8982         if (!defined $searchtext) {
8983                 die_error(400, "Text field is empty");
8984         }
8985         if (!defined $hash) {
8986                 $hash = git_get_head_hash($project);
8987         }
8988         my %co = parse_commit($hash);
8989         if (!%co) {
8990                 die_error(404, "Unknown commit object");
8991         }
8992         if (!defined $page) {
8993                 $page = 0;
8994         }
8995
8996         if ($searchtype eq 'commit' ||
8997             $searchtype eq 'author' ||
8998             $searchtype eq 'committer') {
8999                 git_search_message(%co);
9000         } elsif ($searchtype eq 'pickaxe') {
9001                 git_search_changes(%co);
9002         } elsif ($searchtype eq 'grep') {
9003                 git_search_files(%co);
9004         } else {
9005                 die_error(400, "Unknown search type");
9006         }
9007 }
9008
9009 sub git_search_help {
9010         git_header_html();
9011         git_print_page_nav('','', $hash,$hash,$hash);
9012         print <<EOT;
9013 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9014 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9015 the pattern entered is recognized as the POSIX extended
9016 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9017 insensitive).</p>
9018 <dl>
9019 <dt><b>commit</b></dt>
9020 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9021 EOT
9022         my $have_grep = gitweb_check_feature('grep');
9023         if ($have_grep) {
9024                 print <<EOT;
9025 <dt><b>grep</b></dt>
9026 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9027     a different one) are searched for the given pattern. On large trees, this search can take
9028 a while and put some strain on the server, so please use it with some consideration. Note that
9029 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9030 case-sensitive.</dd>
9031 EOT
9032         }
9033         print <<EOT;
9034 <dt><b>author</b></dt>
9035 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9036 <dt><b>committer</b></dt>
9037 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9038 EOT
9039         my $have_pickaxe = gitweb_check_feature('pickaxe');
9040         if ($have_pickaxe) {
9041                 print <<EOT;
9042 <dt><b>pickaxe</b></dt>
9043 <dd>All commits that caused the string to appear or disappear from any file (changes that
9044 added, removed or "modified" the string) will be listed. This search can take a while and
9045 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9046 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9047 EOT
9048         }
9049         print "</dl>\n";
9050         git_footer_html();
9051 }
9052
9053 sub git_shortlog {
9054         git_log_generic('shortlog', \&git_shortlog_body,
9055                         $hash, $hash_parent);
9056 }
9057
9058 ## ......................................................................
9059 ## feeds (RSS, Atom; OPML)
9060
9061 sub git_feed {
9062         my $format = shift || 'atom';
9063         my $have_blame = gitweb_check_feature('blame');
9064
9065         # Atom: http://www.atomenabled.org/developers/syndication/
9066         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9067         if ($format ne 'rss' && $format ne 'atom') {
9068                 die_error(400, "Unknown web feed format");
9069         }
9070
9071         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9072         my $head = $hash || 'HEAD';
9073         my @commitlist = parse_commits($head, 150, 0, $file_name);
9074
9075         my %latest_commit;
9076         my %latest_date;
9077         my $content_type = "application/$format+xml";
9078         if (defined $cgi->http('HTTP_ACCEPT') &&
9079                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9080                 # browser (feed reader) prefers text/xml
9081                 $content_type = 'text/xml';
9082         }
9083         if (defined($commitlist[0])) {
9084                 %latest_commit = %{$commitlist[0]};
9085                 my $latest_epoch = $latest_commit{'committer_epoch'};
9086                 exit_if_unmodified_since($latest_epoch);
9087                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9088         }
9089         print $cgi->header(
9090                 -type => $content_type,
9091                 -charset => 'utf-8',
9092                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9093                 -status => '200 OK');
9094
9095         # Optimization: skip generating the body if client asks only
9096         # for Last-Modified date.
9097         return if ($cgi->request_method() eq 'HEAD');
9098
9099         # header variables
9100         my $title = "$site_name - $project/$action";
9101         my $feed_type = 'log';
9102         if (defined $hash) {
9103                 $title .= " - '$hash'";
9104                 $feed_type = 'branch log';
9105                 if (defined $file_name) {
9106                         $title .= " :: $file_name";
9107                         $feed_type = 'history';
9108                 }
9109         } elsif (defined $file_name) {
9110                 $title .= " - $file_name";
9111                 $feed_type = 'history';
9112         }
9113         $title .= " $feed_type";
9114         $title = esc_html($title);
9115         my $descr = git_get_project_description($project);
9116         if (defined $descr) {
9117                 $descr = esc_html($descr);
9118         } else {
9119                 $descr = "$project " .
9120                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9121                          " feed";
9122         }
9123         my $owner = git_get_project_owner($project);
9124         $owner = esc_html($owner);
9125
9126         #header
9127         my $alt_url;
9128         if (defined $file_name) {
9129                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9130         } elsif (defined $hash) {
9131                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9132         } else {
9133                 $alt_url = href(-full=>1, action=>"summary");
9134         }
9135         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9136         if ($format eq 'rss') {
9137                 print <<XML;
9138 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9139 <channel>
9140 XML
9141                 print "<title>$title</title>\n" .
9142                       "<link>$alt_url</link>\n" .
9143                       "<description>$descr</description>\n" .
9144                       "<language>en</language>\n" .
9145                       # project owner is responsible for 'editorial' content
9146                       "<managingEditor>$owner</managingEditor>\n";
9147                 if (defined $logo || defined $favicon) {
9148                         # prefer the logo to the favicon, since RSS
9149                         # doesn't allow both
9150                         my $img = esc_url($logo || $favicon);
9151                         print "<image>\n" .
9152                               "<url>$img</url>\n" .
9153                               "<title>$title</title>\n" .
9154                               "<link>$alt_url</link>\n" .
9155                               "</image>\n";
9156                 }
9157                 if (%latest_date) {
9158                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9159                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9160                 }
9161                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9162         } elsif ($format eq 'atom') {
9163                 print <<XML;
9164 <feed xmlns="http://www.w3.org/2005/Atom">
9165 XML
9166                 print "<title>$title</title>\n" .
9167                       "<subtitle>$descr</subtitle>\n" .
9168                       '<link rel="alternate" type="text/html" href="' .
9169                       $alt_url . '" />' . "\n" .
9170                       '<link rel="self" type="' . $content_type . '" href="' .
9171                       $cgi->self_url() . '" />' . "\n" .
9172                       "<id>" . href(-full=>1) . "</id>\n" .
9173                       # use project owner for feed author
9174                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9175                 if (defined $favicon) {
9176                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9177                 }
9178                 if (defined $logo) {
9179                         # not twice as wide as tall: 72 x 27 pixels
9180                         print "<logo>" . esc_url($logo) . "</logo>\n";
9181                 }
9182                 if (! %latest_date) {
9183                         # dummy date to keep the feed valid until commits trickle in:
9184                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9185                 } else {
9186                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9187                 }
9188                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9189         }
9190
9191         # contents
9192         for (my $i = 0; $i <= $#commitlist; $i++) {
9193                 my %co = %{$commitlist[$i]};
9194                 my $commit = $co{'id'};
9195                 # we read 150, we always show 30 and the ones more recent than 48 hours
9196                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9197                         last;
9198                 }
9199                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9200
9201                 # get list of changed files
9202                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9203                         $co{'parent'} || "--root",
9204                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9205                         or next;
9206                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9207                 close $fd
9208                         or next;
9209
9210                 # print element (entry, item)
9211                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9212                 if ($format eq 'rss') {
9213                         print "<item>\n" .
9214                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9215                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9216                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9217                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9218                               "<link>$co_url</link>\n" .
9219                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9220                               "<content:encoded>" .
9221                               "<![CDATA[\n";
9222                 } elsif ($format eq 'atom') {
9223                         print "<entry>\n" .
9224                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9225                               "<updated>$cd{'iso-8601'}</updated>\n" .
9226                               "<author>\n" .
9227                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9228                         if ($co{'author_email'}) {
9229                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9230                         }
9231                         print "</author>\n" .
9232                               # use committer for contributor
9233                               "<contributor>\n" .
9234                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9235                         if ($co{'committer_email'}) {
9236                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9237                         }
9238                         print "</contributor>\n" .
9239                               "<published>$cd{'iso-8601'}</published>\n" .
9240                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9241                               "<id>$co_url</id>\n" .
9242                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9243                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9244                 }
9245                 my $comment = $co{'comment'};
9246                 print "<pre>\n";
9247                 foreach my $line (@$comment) {
9248                         $line = esc_html($line);
9249                         print "$line\n";
9250                 }
9251                 print "</pre><ul>\n";
9252                 foreach my $difftree_line (@difftree) {
9253                         my %difftree = parse_difftree_raw_line($difftree_line);
9254                         next if !$difftree{'from_id'};
9255
9256                         my $file = $difftree{'file'} || $difftree{'to_file'};
9257
9258                         print "<li>" .
9259                               "[" .
9260                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9261                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9262                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9263                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9264                                       -title => "diff"}, 'D');
9265                         if ($have_blame) {
9266                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9267                                                              file_name=>$file, hash_base=>$commit),
9268                                               -class => "blamelink",
9269                                               -title => "blame"}, 'B');
9270                         }
9271                         # if this is not a feed of a file history
9272                         if (!defined $file_name || $file_name ne $file) {
9273                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9274                                                              file_name=>$file, hash=>$commit),
9275                                               -title => "history"}, 'H');
9276                         }
9277                         $file = esc_path($file);
9278                         print "] ".
9279                               "$file</li>\n";
9280                 }
9281                 if ($format eq 'rss') {
9282                         print "</ul>]]>\n" .
9283                               "</content:encoded>\n" .
9284                               "</item>\n";
9285                 } elsif ($format eq 'atom') {
9286                         print "</ul>\n</div>\n" .
9287                               "</content>\n" .
9288                               "</entry>\n";
9289                 }
9290         }
9291
9292         # end of feed
9293         if ($format eq 'rss') {
9294                 print "</channel>\n</rss>\n";
9295         } elsif ($format eq 'atom') {
9296                 print "</feed>\n";
9297         }
9298 }
9299
9300 sub git_rss {
9301         git_feed('rss');
9302 }
9303
9304 sub git_atom {
9305         git_feed('atom');
9306 }
9307
9308 sub git_opml {
9309         my @list = git_get_projects_list($project_filter, $strict_export);
9310         if (!@list) {
9311                 die_error(404, "No projects found");
9312         }
9313
9314         print $cgi->header(
9315                 -type => 'text/xml',
9316                 -charset => 'utf-8',
9317                 -content_disposition => 'inline; filename="opml.xml"');
9318
9319         my $title = esc_html($site_name);
9320         my $filter = " within subdirectory ";
9321         if (defined $project_filter) {
9322                 $filter .= esc_html($project_filter);
9323         } else {
9324                 $filter = "";
9325         }
9326         print <<XML;
9327 <?xml version="1.0" encoding="utf-8"?>
9328 <opml version="1.0">
9329 <head>
9330   <title>$title OPML Export$filter</title>
9331 </head>
9332 <body>
9333 <outline text="git RSS feeds">
9334 XML
9335
9336         foreach my $pr (@list) {
9337                 my %proj = %$pr;
9338                 my $head = git_get_head_hash($proj{'path'});
9339                 if (!defined $head) {
9340                         next;
9341                 }
9342                 $git_dir = "$projectroot/$proj{'path'}";
9343                 my %co = parse_commit($head);
9344                 if (!%co) {
9345                         next;
9346                 }
9347
9348                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9349                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9350                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9351                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9352         }
9353         print <<XML;
9354 </outline>
9355 </body>
9356 </opml>
9357 XML
9358 }