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