gitweb/gitweb.perl

   1 #!/usr/bin/perl
   2
   3 # gitweb - simple web interface to track changes in git repositories
   4 #
   5 # (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
   6 # (C) 2005, Christian Gierke
   7 #
   8 # This program is licensed under the GPLv2
   9
  10 use 5.008;
  11 use strict;
  12 use warnings;
  13 use CGI qw(:standard :escapeHTML -nosticky);
  14 use CGI::Util qw(unescape);
  15 use CGI::Carp qw(fatalsToBrowser set_message);
  16 use Encode;
  17 use Fcntl ':mode';
  18 use File::Find qw();
  19 use File::Basename qw(basename);
  20 use File::Spec;
  21 use Time::HiRes qw(gettimeofday tv_interval);
  22 use Time::Local;
  23 use constant GITWEB_CACHE_FORMAT => "Gitweb Cache Format 3";
  24 binmode STDOUT, ':utf8';
  25
  26 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
  27         eval 'sub CGI::multi_param { CGI::param(@_) }'
  28 }
  29
  30 our $t0 = [ gettimeofday() ];
  31 our $number_of_git_cmds = 0;
  32
  33 BEGIN {
  34         CGI->compile() if $ENV{'MOD_PERL'};
  35 }
  36
  37 our $version = "++GIT_VERSION++";
  38
  39 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  40 sub evaluate_uri {
  41         our $cgi;
  42
  43         our $my_url = $cgi->url();
  44         our $my_uri = $cgi->url(-absolute => 1);
  45
  46         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  47         # needed and used only for URLs with nonempty PATH_INFO
  48         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  49         our $base_url = $my_uri || '/';
  50
  51         # When the script is used as DirectoryIndex, the URL does not contain the name
  52         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  53         # have to do it ourselves. We make $path_info global because it's also used
  54         # later on.
  55         #
  56         # Another issue with the script being the DirectoryIndex is that the resulting
  57         # $my_url data is not the full script URL: this is good, because we want
  58         # generated links to keep implying the script name if it wasn't explicitly
  59         # indicated in the URL we're handling, but it means that $my_url cannot be used
  60         # as base URL.
  61         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  62         # to build the base URL ourselves:
  63         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  64         if ($path_info) {
  65                 # $path_info has already been URL-decoded by the web server, but
  66                 # $my_url and $my_uri have not. URL-decode them so we can properly
  67                 # strip $path_info.
  68                 $my_url = unescape($my_url);
  69                 $my_uri = unescape($my_uri);
  70                 if ($my_url =~ s,\Q$path_info\E$,, &&
  71                     $my_uri =~ s,\Q$path_info\E$,, &&
  72                     defined $ENV{'SCRIPT_NAME'}) {
  73                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  74                 }
  75         }
  76
  77         # target of the home link on top of all pages
  78         our $home_link = $my_uri || "/";
  79 }
  80
  81 # core git executable to use
  82 # this can just be "git" if your webserver has a sensible PATH
  83 our $GIT = "++GIT_BINDIR++/git";
  84
  85 # absolute fs-path which will be prepended to the project path
  86 #our $projectroot = "/pub/scm";
  87 our $projectroot = "++GITWEB_PROJECTROOT++";
  88
  89 # fs traversing limit for getting project list
  90 # the number is relative to the projectroot
  91 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  92
  93 # string of the home link on top of all pages
  94 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  95
  96 # extra breadcrumbs preceding the home link
  97 our @extra_breadcrumbs = ();
  98
  99 # name of your site or organization to appear in page titles
 100 # replace this with something more descriptive for clearer bookmarks
 101 our $site_name = "++GITWEB_SITENAME++"
 102                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 103
 104 # html snippet to include in the <head> section of each page
 105 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 106 # filename of html text to include at top of each page
 107 our $site_header = "++GITWEB_SITE_HEADER++";
 108 # html text to include at home page
 109 our $home_text = "++GITWEB_HOMETEXT++";
 110 # filename of html text to include at bottom of each page
 111 our $site_footer = "++GITWEB_SITE_FOOTER++";
 112
 113 # URI of stylesheets
 114 our @stylesheets = ("++GITWEB_CSS++");
 115 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 116 our $stylesheet = undef;
 117 # URI of GIT logo (72x27 size)
 118 our $logo = "++GITWEB_LOGO++";
 119 # URI of GIT favicon, assumed to be image/png type
 120 our $favicon = "++GITWEB_FAVICON++";
 121 # URI of gitweb.js (JavaScript code for gitweb)
 122 our $javascript = "++GITWEB_JS++";
 123
 124 # URI and label (title) of GIT logo link
 125 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 126 #our $logo_label = "git documentation";
 127 our $logo_url = "http://git-scm.com/";
 128 our $logo_label = "git homepage";
 129
 130 # source of projects list
 131 our $projects_list = "++GITWEB_LIST++";
 132
 133 # the width (in characters) of the projects list "Description" column
 134 our $projects_list_description_width = 25;
 135
 136 # group projects by category on the projects list
 137 # (enabled if this variable evaluates to true)
 138 our $projects_list_group_categories = 0;
 139
 140 # default category if none specified
 141 # (leave the empty string for no category)
 142 our $project_list_default_category = "";
 143
 144 # default order of projects list
 145 # valid values are none, project, descr, owner, and age
 146 our $default_projects_order = "project";
 147
 148 # default order of refs list
 149 # valid values are age and name
 150 our $default_refs_order = "age";
 151
 152 # show repository only if this file exists
 153 # (only effective if this variable evaluates to true)
 154 our $export_ok = "++GITWEB_EXPORT_OK++";
 155
 156 # don't generate age column on the projects list page
 157 our $omit_age_column = 0;
 158
 159 # use contents of this file (in iso, iso-strict or raw format) as
 160 # the last activity data if it exists and is a valid date
 161 our $lastactivity_file = undef;
 162
 163 # don't generate information about owners of repositories
 164 our $omit_owner=0;
 165
 166 # owner link hook given owner name (full and NOT obfuscated)
 167 # should return full URL-escaped link to attach to owner, for example:
 168 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 169 our $owner_link_hook = undef;
 170
 171 # show repository only if this subroutine returns true
 172 # when given the path to the project, for example:
 173 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 174 our $export_auth_hook = undef;
 175
 176 # only allow viewing of repositories also shown on the overview page
 177 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 178
 179 # list of git base URLs used for URL to where fetch project from,
 180 # i.e. full URL is "$git_base_url/$project"
 181 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 182
 183 # URLs designated for pushing new changes, extended by the
 184 # project name (i.e. "$git_base_push_url[0]/$project")
 185 our @git_base_push_urls = ();
 186
 187 # https hint html inserted right after any https push URL (undef for none)
 188 our $https_hint_html = undef;
 189
 190 # default blob_plain mimetype and default charset for text/plain blob
 191 our $default_blob_plain_mimetype = 'application/octet-stream';
 192 our $default_text_plain_charset  = undef;
 193
 194 # file to use for guessing MIME types before trying /etc/mime.types
 195 # (relative to the current git repository)
 196 our $mimetypes_file = undef;
 197
 198 # assume this charset if line contains non-UTF-8 characters;
 199 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 200 # for which encoding all byte sequences are valid, for example
 201 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 202 # could be even 'utf-8' for the old behavior)
 203 our $fallback_encoding = 'latin1';
 204
 205 # rename detection options for git-diff and git-diff-tree
 206 # - default is '-M', with the cost proportional to
 207 #   (number of removed files) * (number of new files).
 208 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 209 #   (number of changed files + number of removed files) * (number of new files)
 210 # - even more costly is '-C', '--find-copies-harder' with cost
 211 #   (number of files in the original tree) * (number of new files)
 212 # - one might want to include '-B' option, e.g. '-B', '-M'
 213 our @diff_opts = ('-M'); # taken from git_commit
 214
 215 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 216 # the directory must exist and be writable by the process running gitweb.
 217 # additionally some actions must be selected for caching in %html_cache_actions
 218 # - default is 'htmlcache'
 219 our $html_cache_dir = 'htmlcache';
 220
 221 # which actions to cache in $html_cache_dir
 222 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 223 # process running gitweb, then any actions selected here will have their output
 224 # cached and the cache file will be returned instead of regenerating the page
 225 # if it exists.  For this to be useful, an external process must create the
 226 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 227 # the project information has been changed.  Alternatively it may create a
 228 # "$action.changed" file (if it does not exist) instead to limit the changes
 229 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 230 # exist, then the cached version will never be used for "$action" and a new
 231 # cache page will be regenerated (and the "changed" files removed as appropriate).
 232 #
 233 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 234 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 235 # process must create the 'forkchange' file or update its timestamp if it already
 236 # exists whenever a fork is added to or removed from the project (as well as
 237 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 238 # section on the summary page may remain out-of-date indefinately.
 239 #
 240 # - default is none
 241 #   currently only caching of the summary page is supported
 242 # - to enable caching of the summary page use:
 243 #   $html_cache_actions{'summary'} = 1;
 244 our %html_cache_actions = ();
 245
 246 # Disables features that would allow repository owners to inject script into
 247 # the gitweb domain.
 248 our $prevent_xss = 0;
 249
 250 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 251 # Only used when highlight is enabled or snapshots with compressors are enabled.
 252 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 253
 254 # Path to the highlight executable to use (must be the one from
 255 # http://www.andre-simon.de due to assumptions about parameters and output).
 256 # Useful if highlight is not installed on your webserver's PATH.
 257 # [Default: highlight]
 258 our $highlight_bin = "++HIGHLIGHT_BIN++";
 259
 260 # Whether to include project list on the gitweb front page; 0 means yes,
 261 # 1 means no list but show tag cloud if enabled (all projects still need
 262 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 263 # (very fast)
 264 our $frontpage_no_project_list = 0;
 265
 266 # projects list cache for busy sites with many projects;
 267 # if you set this to non-zero, it will be used as the cached
 268 # index lifetime in minutes
 269 #
 270 # the cached list version is stored in $cache_dir/$cache_name and can
 271 # be tweaked by other scripts running with the same uid as gitweb -
 272 # use this ONLY at secure installations; only single gitweb project
 273 # root per system is supported, unless you tweak configuration!
 274 our $projlist_cache_lifetime = 0; # in minutes
 275 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 276 our $cache_dir =
 277         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 278 our $projlist_cache_name = 'gitweb.index.cache';
 279 our $cache_grpshared = 0;
 280
 281 # information about snapshot formats that gitweb is capable of serving
 282 our %known_snapshot_formats = (
 283         # name => {
 284         #       'display' => display name,
 285         #       'type' => mime type,
 286         #       'suffix' => filename suffix,
 287         #       'format' => --format for git-archive,
 288         #       'compressor' => [compressor command and arguments]
 289         #                       (array reference, optional)
 290         #       'disabled' => boolean (optional)}
 291         #
 292         'tgz' => {
 293                 'display' => 'tar.gz',
 294                 'type' => 'application/x-gzip',
 295                 'suffix' => '.tar.gz',
 296                 'format' => 'tar',
 297                 'compressor' => ['gzip', '-n']},
 298
 299         'tbz2' => {
 300                 'display' => 'tar.bz2',
 301                 'type' => 'application/x-bzip2',
 302                 'suffix' => '.tar.bz2',
 303                 'format' => 'tar',
 304                 'compressor' => ['bzip2']},
 305
 306         'txz' => {
 307                 'display' => 'tar.xz',
 308                 'type' => 'application/x-xz',
 309                 'suffix' => '.tar.xz',
 310                 'format' => 'tar',
 311                 'compressor' => ['xz'],
 312                 'disabled' => 1},
 313
 314         'zip' => {
 315                 'display' => 'zip',
 316                 'type' => 'application/x-zip',
 317                 'suffix' => '.zip',
 318                 'format' => 'zip'},
 319 );
 320
 321 # Aliases so we understand old gitweb.snapshot values in repository
 322 # configuration.
 323 our %known_snapshot_format_aliases = (
 324         'gzip'  => 'tgz',
 325         'bzip2' => 'tbz2',
 326         'xz'    => 'txz',
 327
 328         # backward compatibility: legacy gitweb config support
 329         'x-gzip' => undef, 'gz' => undef,
 330         'x-bzip2' => undef, 'bz2' => undef,
 331         'x-zip' => undef, '' => undef,
 332 );
 333
 334 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 335 # are changed, it may be appropriate to change these values too via
 336 # $GITWEB_CONFIG.
 337 our %avatar_size = (
 338         'default' => 16,
 339         'double'  => 32
 340 );
 341
 342 # Used to set the maximum load that we will still respond to gitweb queries.
 343 # If server load exceed this value then return "503 server busy" error.
 344 # If gitweb cannot determined server load, it is taken to be 0.
 345 # Leave it undefined (or set to 'undef') to turn off load checking.
 346 our $maxload = 300;
 347
 348 # configuration for 'highlight' (http://www.andre-simon.de/)
 349 # match by basename
 350 our %highlight_basename = (
 351         #'Program' => 'py',
 352         #'Library' => 'py',
 353         'SConstruct' => 'py', # SCons equivalent of Makefile
 354         'Makefile' => 'make',
 355         'makefile' => 'make',
 356         'GNUmakefile' => 'make',
 357         'BSDmakefile' => 'make',
 358 );
 359 # match by shebang regex
 360 our %highlight_shebang = (
 361         # Each entry has a key which is the syntax to use and
 362         # a value which is either a qr regex or an array of qr regexs to match
 363         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 364         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 365         # allow a limited subset of NAME=value items to appear.
 366         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 367                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 368         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 369                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 370         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 371                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 372         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 373                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 374         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 375                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 376         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 377                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 378         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 379                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 380 );
 381 # match by extension
 382 our %highlight_ext = (
 383         # main extensions, defining name of syntax;
 384         # see files in /usr/share/highlight/langDefs/ directory
 385         (map { $_ => $_ } qw(
 386                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 387                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 388                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 389                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 390                 go haskell hcl html httpd hx icl icn idl idlang ili
 391                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 392                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 393                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 394                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 395                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 396                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 397                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 398                 yaiff znn)),
 399         # alternate extensions, see /etc/highlight/filetypes.conf
 400         (map { $_ => '4gl' } qw(informix)),
 401         (map { $_ => 'a4c' } qw(ascend)),
 402         (map { $_ => 'abp' } qw(abp4)),
 403         (map { $_ => 'ada' } qw(a adb ads gnad)),
 404         (map { $_ => 'ahk' } qw(autohotkey)),
 405         (map { $_ => 'ampl' } qw(dat run)),
 406         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 407         (map { $_ => 'as' } qw(actionscript)),
 408         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 409         (map { $_ => 'asp' } qw(asa)),
 410         (map { $_ => 'aspect' } qw(was wud)),
 411         (map { $_ => 'ats' } qw(dats)),
 412         (map { $_ => 'au3' } qw(autoit)),
 413         (map { $_ => 'bat' } qw(cmd)),
 414         (map { $_ => 'bb' } qw(blitzbasic)),
 415         (map { $_ => 'bib' } qw(bibtex)),
 416         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 417         (map { $_ => 'cb' } qw(clearbasic)),
 418         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 419         (map { $_ => 'chl' } qw(chill)),
 420         (map { $_ => 'cob' } qw(cbl cobol)),
 421         (map { $_ => 'cs' } qw(csharp)),
 422         (map { $_ => 'diff' } qw(patch)),
 423         (map { $_ => 'dot' } qw(graphviz)),
 424         (map { $_ => 'e' } qw(eiffel se)),
 425         (map { $_ => 'erl' } qw(erlang hrl)),
 426         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 427         (map { $_ => 'exp' } qw(express)),
 428         (map { $_ => 'f90' } qw(f95)),
 429         (map { $_ => 'flx' } qw(felix)),
 430         (map { $_ => 'for' } qw(f f77 ftn)),
 431         (map { $_ => 'fs' } qw(fsharp fsx)),
 432         (map { $_ => 'haskell' } qw(hs)),
 433         (map { $_ => 'html' } qw(htm xhtml)),
 434         (map { $_ => 'hx' } qw(haxe)),
 435         (map { $_ => 'icl' } qw(clean)),
 436         (map { $_ => 'icn' } qw(icon)),
 437         (map { $_ => 'ili' } qw(interlis)),
 438         (map { $_ => 'inp' } qw(fame)),
 439         (map { $_ => 'iss' } qw(innosetup)),
 440         (map { $_ => 'j' } qw(jasmin)),
 441         (map { $_ => 'java' } qw(groovy grv)),
 442         (map { $_ => 'lbn' } qw(luban)),
 443         (map { $_ => 'lgt' } qw(logtalk)),
 444         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 445         (map { $_ => 'ls' } qw(lotus)),
 446         (map { $_ => 'lsl' } qw(lindenscript)),
 447         (map { $_ => 'ly' } qw(lilypond)),
 448         (map { $_ => 'make' } qw(mak mk kmk)),
 449         (map { $_ => 'mel' } qw(maya)),
 450         (map { $_ => 'mib' } qw(smi snmp)),
 451         (map { $_ => 'ml' } qw(mli ocaml)),
 452         (map { $_ => 'mo' } qw(modelica)),
 453         (map { $_ => 'mod2' } qw(def mod)),
 454         (map { $_ => 'mod3' } qw(i3 m3)),
 455         (map { $_ => 'mpl' } qw(maple)),
 456         (map { $_ => 'n' } qw(nemerle)),
 457         (map { $_ => 'nas' } qw(nasal)),
 458         (map { $_ => 'nrx' } qw(netrexx)),
 459         (map { $_ => 'nsi' } qw(nsis)),
 460         (map { $_ => 'nut' } qw(squirrel)),
 461         (map { $_ => 'oberon' } qw(ooc)),
 462         (map { $_ => 'objc' } qw(M m mm)),
 463         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 464         (map { $_ => 'pike' } qw(pmod)),
 465         (map { $_ => 'pl' } qw(perl plex plx pm)),
 466         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 467         (map { $_ => 'progress' } qw(i p w)),
 468         (map { $_ => 'py' } qw(python)),
 469         (map { $_ => 'pyx' } qw(pyrex)),
 470         (map { $_ => 'rb' } qw(pp rjs ruby)),
 471         (map { $_ => 'rexx' } qw(rex rx the)),
 472         (map { $_ => 'sc' } qw(paradox)),
 473         (map { $_ => 'scilab' } qw(sce sci)),
 474         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 475         (map { $_ => 'sma' } qw(small)),
 476         (map { $_ => 'smalltalk' } qw(gst sq st)),
 477         (map { $_ => 'sno' } qw(snobal)),
 478         (map { $_ => 'sybase' } qw(sp)),
 479         (map { $_ => 'tcl' } qw(itcl wish)),
 480         (map { $_ => 'tex' } qw(cls sty)),
 481         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 482         (map { $_ => 'verilog' } qw(v)),
 483         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 484         (map { $_ => 'y' } qw(bison)),
 485 );
 486
 487 # You define site-wide feature defaults here; override them with
 488 # $GITWEB_CONFIG as necessary.
 489 our %feature = (
 490         # feature => {
 491         #       'sub' => feature-sub (subroutine),
 492         #       'override' => allow-override (boolean),
 493         #       'default' => [ default options...] (array reference)}
 494         #
 495         # if feature is overridable (it means that allow-override has true value),
 496         # then feature-sub will be called with default options as parameters;
 497         # return value of feature-sub indicates if to enable specified feature
 498         #
 499         # if there is no 'sub' key (no feature-sub), then feature cannot be
 500         # overridden
 501         #
 502         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 503         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 504         # is enabled
 505
 506         # Enable the 'blame' blob view, showing the last commit that modified
 507         # each line in the file. This can be very CPU-intensive.
 508
 509         # To enable system wide have in $GITWEB_CONFIG
 510         # $feature{'blame'}{'default'} = [1];
 511         # To have project specific config enable override in $GITWEB_CONFIG
 512         # $feature{'blame'}{'override'} = 1;
 513         # and in project config gitweb.blame = 0|1;
 514         'blame' => {
 515                 'sub' => sub { feature_bool('blame', @_) },
 516                 'override' => 0,
 517                 'default' => [0]},
 518
 519         # Enable the 'incremental blame' blob view, which uses javascript to
 520         # incrementally show the revisions of lines as they are discovered
 521         # in the history. It is better for large histories, files and slow
 522         # servers, but requires javascript in the client and can slow down the
 523         # browser on large files.
 524
 525         # To enable system wide have in $GITWEB_CONFIG
 526         # $feature{'blame_incremental'}{'default'} = [1];
 527         # To have project specific config enable override in $GITWEB_CONFIG
 528         # $feature{'blame_incremental'}{'override'} = 1;
 529         # and in project config gitweb.blame_incremental = 0|1;
 530         'blame_incremental' => {
 531                 'sub' => sub { feature_bool('blame_incremental', @_) },
 532                 'override' => 0,
 533                 'default' => [0]},
 534
 535         # Enable the 'snapshot' link, providing a compressed archive of any
 536         # tree. This can potentially generate high traffic if you have large
 537         # project.
 538
 539         # Value is a list of formats defined in %known_snapshot_formats that
 540         # you wish to offer.
 541         # To disable system wide have in $GITWEB_CONFIG
 542         # $feature{'snapshot'}{'default'} = [];
 543         # To have project specific config enable override in $GITWEB_CONFIG
 544         # $feature{'snapshot'}{'override'} = 1;
 545         # and in project config, a comma-separated list of formats or "none"
 546         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 547         'snapshot' => {
 548                 'sub' => \&feature_snapshot,
 549                 'override' => 0,
 550                 'default' => ['tgz']},
 551
 552         # Enable text search, which will list the commits which match author,
 553         # committer or commit text to a given string.  Enabled by default.
 554         # Project specific override is not supported.
 555         #
 556         # Note that this controls all search features, which means that if
 557         # it is disabled, then 'grep' and 'pickaxe' search would also be
 558         # disabled.
 559         'search' => {
 560                 'override' => 0,
 561                 'default' => [1]},
 562
 563         # Enable grep search, which will list the files in currently selected
 564         # tree containing the given string. Enabled by default. This can be
 565         # potentially CPU-intensive, of course.
 566         # Note that you need to have 'search' feature enabled too.
 567
 568         # To enable system wide have in $GITWEB_CONFIG
 569         # $feature{'grep'}{'default'} = [1];
 570         # To have project specific config enable override in $GITWEB_CONFIG
 571         # $feature{'grep'}{'override'} = 1;
 572         # and in project config gitweb.grep = 0|1;
 573         'grep' => {
 574                 'sub' => sub { feature_bool('grep', @_) },
 575                 'override' => 0,
 576                 'default' => [1]},
 577
 578         # Enable the pickaxe search, which will list the commits that modified
 579         # a given string in a file. This can be practical and quite faster
 580         # alternative to 'blame', but still potentially CPU-intensive.
 581         # Note that you need to have 'search' feature enabled too.
 582
 583         # To enable system wide have in $GITWEB_CONFIG
 584         # $feature{'pickaxe'}{'default'} = [1];
 585         # To have project specific config enable override in $GITWEB_CONFIG
 586         # $feature{'pickaxe'}{'override'} = 1;
 587         # and in project config gitweb.pickaxe = 0|1;
 588         'pickaxe' => {
 589                 'sub' => sub { feature_bool('pickaxe', @_) },
 590                 'override' => 0,
 591                 'default' => [1]},
 592
 593         # Enable showing size of blobs in a 'tree' view, in a separate
 594         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 595
 596         # To disable system wide have in $GITWEB_CONFIG
 597         # $feature{'show-sizes'}{'default'} = [0];
 598         # To have project specific config enable override in $GITWEB_CONFIG
 599         # $feature{'show-sizes'}{'override'} = 1;
 600         # and in project config gitweb.showsizes = 0|1;
 601         'show-sizes' => {
 602                 'sub' => sub { feature_bool('showsizes', @_) },
 603                 'override' => 0,
 604                 'default' => [1]},
 605
 606         # Make gitweb use an alternative format of the URLs which can be
 607         # more readable and natural-looking: project name is embedded
 608         # directly in the path and the query string contains other
 609         # auxiliary information. All gitweb installations recognize
 610         # URL in either format; this configures in which formats gitweb
 611         # generates links.
 612
 613         # To enable system wide have in $GITWEB_CONFIG
 614         # $feature{'pathinfo'}{'default'} = [1];
 615         # Project specific override is not supported.
 616
 617         # Note that you will need to change the default location of CSS,
 618         # favicon, logo and possibly other files to an absolute URL. Also,
 619         # if gitweb.cgi serves as your indexfile, you will need to force
 620         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 621         # will also likely want to set $home_link if you're setting $my_uri).
 622         'pathinfo' => {
 623                 'override' => 0,
 624                 'default' => [0]},
 625
 626         # Make gitweb consider projects in project root subdirectories
 627         # to be forks of existing projects. Given project $projname.git,
 628         # projects matching $projname/*.git will not be shown in the main
 629         # projects list, instead a '+' mark will be added to $projname
 630         # there and a 'forks' view will be enabled for the project, listing
 631         # all the forks. If project list is taken from a file, forks have
 632         # to be listed after the main project.
 633
 634         # To enable system wide have in $GITWEB_CONFIG
 635         # $feature{'forks'}{'default'} = [1];
 636         # Project specific override is not supported.
 637         'forks' => {
 638                 'override' => 0,
 639                 'default' => [0]},
 640
 641         # Insert custom links to the action bar of all project pages.
 642         # This enables you mainly to link to third-party scripts integrating
 643         # into gitweb; e.g. git-browser for graphical history representation
 644         # or custom web-based repository administration interface.
 645
 646         # The 'default' value consists of a list of triplets in the form
 647         # (label, link, position) where position is the label after which
 648         # to insert the link and link is a format string where %n expands
 649         # to the project name, %f to the project path within the filesystem,
 650         # %h to the current hash (h gitweb parameter) and %b to the current
 651         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 652         # project name where all '+' characters have been replaced with '%2B'.
 653
 654         # To enable system wide have in $GITWEB_CONFIG e.g.
 655         # $feature{'actions'}{'default'} = [('graphiclog',
 656         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 657         # Project specific override is not supported.
 658         'actions' => {
 659                 'override' => 0,
 660                 'default' => []},
 661
 662         # Allow gitweb scan project content tags of project repository,
 663         # and display the popular Web 2.0-ish "tag cloud" near the projects
 664         # list.  Note that this is something COMPLETELY different from the
 665         # normal Git tags.
 666
 667         # gitweb by itself can show existing tags, but it does not handle
 668         # tagging itself; you need to do it externally, outside gitweb.
 669         # The format is described in git_get_project_ctags() subroutine.
 670         # You may want to install the HTML::TagCloud Perl module to get
 671         # a pretty tag cloud instead of just a list of tags.
 672
 673         # To enable system wide have in $GITWEB_CONFIG
 674         # $feature{'ctags'}{'default'} = [1];
 675         # Project specific override is not supported.
 676
 677         # A value of 0 means no ctags display or editing.  A value of
 678         # 1 enables ctags display but never editing.  A non-empty value
 679         # that is not a string of digits enables ctags display AND the
 680         # ability to add tags using a form that uses method POST and
 681         # an action value set to the configured 'ctags' value.
 682         'ctags' => {
 683                 'override' => 0,
 684                 'default' => [0]},
 685
 686         # The maximum number of patches in a patchset generated in patch
 687         # view. Set this to 0 or undef to disable patch view, or to a
 688         # negative number to remove any limit.
 689
 690         # To disable system wide have in $GITWEB_CONFIG
 691         # $feature{'patches'}{'default'} = [0];
 692         # To have project specific config enable override in $GITWEB_CONFIG
 693         # $feature{'patches'}{'override'} = 1;
 694         # and in project config gitweb.patches = 0|n;
 695         # where n is the maximum number of patches allowed in a patchset.
 696         'patches' => {
 697                 'sub' => \&feature_patches,
 698                 'override' => 0,
 699                 'default' => [16]},
 700
 701         # Avatar support. When this feature is enabled, views such as
 702         # shortlog or commit will display an avatar associated with
 703         # the email of the committer(s) and/or author(s).
 704
 705         # Currently available providers are gravatar and picon.
 706         # If an unknown provider is specified, the feature is disabled.
 707
 708         # Gravatar depends on Digest::MD5.
 709         # Picon currently relies on the indiana.edu database.
 710
 711         # To enable system wide have in $GITWEB_CONFIG
 712         # $feature{'avatar'}{'default'} = ['<provider>'];
 713         # where <provider> is either gravatar or picon.
 714         # To have project specific config enable override in $GITWEB_CONFIG
 715         # $feature{'avatar'}{'override'} = 1;
 716         # and in project config gitweb.avatar = <provider>;
 717         'avatar' => {
 718                 'sub' => \&feature_avatar,
 719                 'override' => 0,
 720                 'default' => ['']},
 721
 722         # Enable displaying how much time and how many git commands
 723         # it took to generate and display page.  Disabled by default.
 724         # Project specific override is not supported.
 725         'timed' => {
 726                 'override' => 0,
 727                 'default' => [0]},
 728
 729         # Enable turning some links into links to actions which require
 730         # JavaScript to run (like 'blame_incremental').  Not enabled by
 731         # default.  Project specific override is currently not supported.
 732         'javascript-actions' => {
 733                 'override' => 0,
 734                 'default' => [0]},
 735
 736         # Enable and configure ability to change common timezone for dates
 737         # in gitweb output via JavaScript.  Enabled by default.
 738         # Project specific override is not supported.
 739         'javascript-timezone' => {
 740                 'override' => 0,
 741                 'default' => [
 742                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 743                                      # or undef to turn off this feature
 744                         'gitweb_tz', # name of cookie where to store selected timezone
 745                         'datetime',  # CSS class used to mark up dates for manipulation
 746                 ]},
 747
 748         # Syntax highlighting support. This is based on Daniel Svensson's
 749         # and Sham Chukoury's work in gitweb-xmms2.git.
 750         # It requires the 'highlight' program present in $PATH,
 751         # and therefore is disabled by default.
 752
 753         # To enable system wide have in $GITWEB_CONFIG
 754         # $feature{'highlight'}{'default'} = [1];
 755
 756         'highlight' => {
 757                 'sub' => sub { feature_bool('highlight', @_) },
 758                 'override' => 0,
 759                 'default' => [0]},
 760
 761         # Enable displaying of remote heads in the heads list
 762
 763         # To enable system wide have in $GITWEB_CONFIG
 764         # $feature{'remote_heads'}{'default'} = [1];
 765         # To have project specific config enable override in $GITWEB_CONFIG
 766         # $feature{'remote_heads'}{'override'} = 1;
 767         # and in project config gitweb.remoteheads = 0|1;
 768         'remote_heads' => {
 769                 'sub' => sub { feature_bool('remote_heads', @_) },
 770                 'override' => 0,
 771                 'default' => [0]},
 772
 773         # Enable showing branches under other refs in addition to heads
 774
 775         # To set system wide extra branch refs have in $GITWEB_CONFIG
 776         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 777         # To have project specific config enable override in $GITWEB_CONFIG
 778         # $feature{'extra-branch-refs'}{'override'} = 1;
 779         # and in project config gitweb.extrabranchrefs = dirs of choice
 780         # Every directory is separated with whitespace.
 781
 782         'extra-branch-refs' => {
 783                 'sub' => \&feature_extra_branch_refs,
 784                 'override' => 0,
 785                 'default' => []},
 786 );
 787
 788 sub gitweb_get_feature {
 789         my ($name) = @_;
 790         return unless exists $feature{$name};
 791         my ($sub, $override, @defaults) = (
 792                 $feature{$name}{'sub'},
 793                 $feature{$name}{'override'},
 794                 @{$feature{$name}{'default'}});
 795         # project specific override is possible only if we have project
 796         our $git_dir; # global variable, declared later
 797         if (!$override || !defined $git_dir) {
 798                 return @defaults;
 799         }
 800         if (!defined $sub) {
 801                 warn "feature $name is not overridable";
 802                 return @defaults;
 803         }
 804         return $sub->(@defaults);
 805 }
 806
 807 # A wrapper to check if a given feature is enabled.
 808 # With this, you can say
 809 #
 810 #   my $bool_feat = gitweb_check_feature('bool_feat');
 811 #   gitweb_check_feature('bool_feat') or somecode;
 812 #
 813 # instead of
 814 #
 815 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 816 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 817 #
 818 sub gitweb_check_feature {
 819         return (gitweb_get_feature(@_))[0];
 820 }
 821
 822
 823 sub feature_bool {
 824         my $key = shift;
 825         my ($val) = git_get_project_config($key, '--bool');
 826
 827         if (!defined $val) {
 828                 return ($_[0]);
 829         } elsif ($val eq 'true') {
 830                 return (1);
 831         } elsif ($val eq 'false') {
 832                 return (0);
 833         }
 834 }
 835
 836 sub feature_snapshot {
 837         my (@fmts) = @_;
 838
 839         my ($val) = git_get_project_config('snapshot');
 840
 841         if ($val) {
 842                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 843         }
 844
 845         return @fmts;
 846 }
 847
 848 sub feature_patches {
 849         my @val = (git_get_project_config('patches', '--int'));
 850
 851         if (@val) {
 852                 return @val;
 853         }
 854
 855         return ($_[0]);
 856 }
 857
 858 sub feature_avatar {
 859         my @val = (git_get_project_config('avatar'));
 860
 861         return @val ? @val : @_;
 862 }
 863
 864 sub feature_extra_branch_refs {
 865         my (@branch_refs) = @_;
 866         my $values = git_get_project_config('extrabranchrefs');
 867
 868         if ($values) {
 869                 $values = config_to_multi ($values);
 870                 @branch_refs = ();
 871                 foreach my $value (@{$values}) {
 872                         push @branch_refs, split /\s+/, $value;
 873                 }
 874         }
 875
 876         return @branch_refs;
 877 }
 878
 879 # checking HEAD file with -e is fragile if the repository was
 880 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 881 # and then pruned.
 882 sub check_head_link {
 883         my ($dir) = @_;
 884         return 0 unless -d "$dir/objects" && -x _;
 885         return 0 unless -d "$dir/refs" && -x _;
 886         my $headfile = "$dir/HEAD";
 887         return -l $headfile ?
 888                 readlink($headfile) =~ /^refs\/heads\// : -f $headfile;
 889 }
 890
 891 sub check_export_ok {
 892         my ($dir) = @_;
 893         return (check_head_link($dir) &&
 894                 (!$export_ok || -e "$dir/$export_ok") &&
 895                 (!$export_auth_hook || $export_auth_hook->($dir)));
 896 }
 897
 898 # process alternate names for backward compatibility
 899 # filter out unsupported (unknown) snapshot formats
 900 sub filter_snapshot_fmts {
 901         my @fmts = @_;
 902
 903         @fmts = map {
 904                 exists $known_snapshot_format_aliases{$_} ?
 905                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 906         @fmts = grep {
 907                 exists $known_snapshot_formats{$_} &&
 908                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 909 }
 910
 911 sub filter_and_validate_refs {
 912         my @refs = @_;
 913         my %unique_refs = ();
 914
 915         foreach my $ref (@refs) {
 916                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 917                 # 'heads' are added implicitly in get_branch_refs().
 918                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 919         }
 920         return sort keys %unique_refs;
 921 }
 922
 923 # If it is set to code reference, it is code that it is to be run once per
 924 # request, allowing updating configurations that change with each request,
 925 # while running other code in config file only once.
 926 #
 927 # Otherwise, if it is false then gitweb would process config file only once;
 928 # if it is true then gitweb config would be run for each request.
 929 our $per_request_config = 1;
 930
 931 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 932 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 933 # same way as though the --fcgi option had been given instead.
 934 our $auto_fcgi = 0;
 935
 936 # read and parse gitweb config file given by its parameter.
 937 # returns true on success, false on recoverable error, allowing
 938 # to chain this subroutine, using first file that exists.
 939 # dies on errors during parsing config file, as it is unrecoverable.
 940 sub read_config_file {
 941         my $filename = shift;
 942         return unless defined $filename;
 943         # die if there are errors parsing config file
 944         if (-e $filename) {
 945                 do $filename;
 946                 die $@ if $@;
 947                 return 1;
 948         }
 949         return;
 950 }
 951
 952 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
 953 sub evaluate_gitweb_config {
 954         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
 955         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
 956         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
 957
 958         # Protect against duplications of file names, to not read config twice.
 959         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
 960         # there possibility of duplication of filename there doesn't matter.
 961         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
 962         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
 963
 964         # Common system-wide settings for convenience.
 965         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
 966         read_config_file($GITWEB_CONFIG_COMMON);
 967
 968         # Use first config file that exists.  This means use the per-instance
 969         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
 970         read_config_file($GITWEB_CONFIG) and return;
 971         read_config_file($GITWEB_CONFIG_SYSTEM);
 972 }
 973
 974 our $encode_object;
 975
 976 sub evaluate_encoding {
 977         my $requested = $fallback_encoding || 'ISO-8859-1';
 978         my $obj = Encode::find_encoding($requested) or
 979                 die_error(400, "Requested fallback encoding not found");
 980         if ($obj->name eq 'iso-8859-1') {
 981                 # Use Windows-1252 instead as required by the HTML 5 standard
 982                 my $altobj = Encode::find_encoding('Windows-1252');
 983                 $obj = $altobj if $altobj;
 984         }
 985         $encode_object = $obj;
 986 }
 987
 988 sub evaluate_email_obfuscate {
 989         # email obfuscation
 990         our $email;
 991         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
 992                 $email = HTML::Email::Obfuscate->new(lite => 1);
 993         }
 994 }
 995
 996 # Get loadavg of system, to compare against $maxload.
 997 # Currently it requires '/proc/loadavg' present to get loadavg;
 998 # if it is not present it returns 0, which means no load checking.
 999 sub get_loadavg {
1000         if( -e '/proc/loadavg' ){
1001                 open my $fd, '<', '/proc/loadavg'
1002                         or return 0;
1003                 my @load = split(/\s+/, scalar <$fd>);
1004                 close $fd;
1005
1006                 # The first three columns measure CPU and IO utilization of the last one,
1007                 # five, and 10 minute periods.  The fourth column shows the number of
1008                 # currently running processes and the total number of processes in the m/n
1009                 # format.  The last column displays the last process ID used.
1010                 return $load[0] || 0;
1011         }
1012         # additional checks for load average should go here for things that don't export
1013         # /proc/loadavg
1014
1015         return 0;
1016 }
1017
1018 # version of the core git binary
1019 our $git_version;
1020 sub evaluate_git_version {
1021         our $git_version = $version;
1022 }
1023
1024 sub check_loadavg {
1025         if (defined $maxload && get_loadavg() > $maxload) {
1026                 die_error(503, "The load average on the server is too high");
1027         }
1028 }
1029
1030 # ======================================================================
1031 # input validation and dispatch
1032
1033 # input parameters can be collected from a variety of sources (presently, CGI
1034 # and PATH_INFO), so we define an %input_params hash that collects them all
1035 # together during validation: this allows subsequent uses (e.g. href()) to be
1036 # agnostic of the parameter origin
1037
1038 our %input_params = ();
1039
1040 # input parameters are stored with the long parameter name as key. This will
1041 # also be used in the href subroutine to convert parameters to their CGI
1042 # equivalent, and since the href() usage is the most frequent one, we store
1043 # the name -> CGI key mapping here, instead of the reverse.
1044 #
1045 # XXX: Warning: If you touch this, check the search form for updating,
1046 # too.
1047
1048 our @cgi_param_mapping = (
1049         project => "p",
1050         action => "a",
1051         file_name => "f",
1052         file_parent => "fp",
1053         hash => "h",
1054         hash_parent => "hp",
1055         hash_base => "hb",
1056         hash_parent_base => "hpb",
1057         page => "pg",
1058         order => "o",
1059         searchtext => "s",
1060         searchtype => "st",
1061         snapshot_format => "sf",
1062         ctag_filter => 't',
1063         extra_options => "opt",
1064         search_use_regexp => "sr",
1065         ctag => "by_tag",
1066         diff_style => "ds",
1067         project_filter => "pf",
1068         # this must be last entry (for manipulation from JavaScript)
1069         javascript => "js"
1070 );
1071 our %cgi_param_mapping = @cgi_param_mapping;
1072
1073 # we will also need to know the possible actions, for validation
1074 our %actions = (
1075         "blame" => \&git_blame,
1076         "blame_incremental" => \&git_blame_incremental,
1077         "blame_data" => \&git_blame_data,
1078         "blobdiff" => \&git_blobdiff,
1079         "blobdiff_plain" => \&git_blobdiff_plain,
1080         "blob" => \&git_blob,
1081         "blob_plain" => \&git_blob_plain,
1082         "commitdiff" => \&git_commitdiff,
1083         "commitdiff_plain" => \&git_commitdiff_plain,
1084         "commit" => \&git_commit,
1085         "forks" => \&git_forks,
1086         "heads" => \&git_heads,
1087         "history" => \&git_history,
1088         "log" => \&git_log,
1089         "patch" => \&git_patch,
1090         "patches" => \&git_patches,
1091         "refs" => \&git_refs,
1092         "remotes" => \&git_remotes,
1093         "rss" => \&git_rss,
1094         "atom" => \&git_atom,
1095         "search" => \&git_search,
1096         "search_help" => \&git_search_help,
1097         "shortlog" => \&git_shortlog,
1098         "summary" => \&git_summary,
1099         "tag" => \&git_tag,
1100         "tags" => \&git_tags,
1101         "tree" => \&git_tree,
1102         "snapshot" => \&git_snapshot,
1103         "object" => \&git_object,
1104         # those below don't need $project
1105         "opml" => \&git_opml,
1106         "frontpage" => \&git_frontpage,
1107         "project_list" => \&git_project_list,
1108         "project_index" => \&git_project_index,
1109 );
1110
1111 # the only actions we will allow to be cached
1112 my %supported_cache_actions;
1113 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1114
1115 # finally, we have the hash of allowed extra_options for the commands that
1116 # allow them
1117 our %allowed_options = (
1118         "--no-merges" => [ qw(rss atom log shortlog history) ],
1119 );
1120
1121 # fill %input_params with the CGI parameters. All values except for 'opt'
1122 # should be single values, but opt can be an array. We should probably
1123 # build an array of parameters that can be multi-valued, but since for the time
1124 # being it's only this one, we just single it out
1125 sub evaluate_query_params {
1126         our $cgi;
1127
1128         while (my ($name, $symbol) = each %cgi_param_mapping) {
1129                 if ($symbol eq 'opt') {
1130                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1131                 } else {
1132                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1133                 }
1134         }
1135
1136         # Backwards compatibility - by_tag= <=> t=
1137         if ($input_params{'ctag'}) {
1138                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1139         }
1140 }
1141
1142 # now read PATH_INFO and update the parameter list for missing parameters
1143 sub evaluate_path_info {
1144         return if defined $input_params{'project'};
1145         return if !$path_info;
1146         $path_info =~ s,^/+,,;
1147         return if !$path_info;
1148
1149         # find which part of PATH_INFO is project
1150         my $project = $path_info;
1151         $project =~ s,/+$,,;
1152         while ($project && !check_head_link("$projectroot/$project")) {
1153                 $project =~ s,/*[^/]*$,,;
1154         }
1155         return unless $project;
1156         $input_params{'project'} = $project;
1157
1158         # do not change any parameters if an action is given using the query string
1159         return if $input_params{'action'};
1160         $path_info =~ s,^\Q$project\E/*,,;
1161
1162         # next, check if we have an action
1163         my $action = $path_info;
1164         $action =~ s,/.*$,,;
1165         if (exists $actions{$action}) {
1166                 $path_info =~ s,^$action/*,,;
1167                 $input_params{'action'} = $action;
1168         }
1169
1170         # list of actions that want hash_base instead of hash, but can have no
1171         # pathname (f) parameter
1172         my @wants_base = (
1173                 'tree',
1174                 'history',
1175         );
1176
1177         # we want to catch, among others
1178         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1179         my ($parentrefname, $parentpathname, $refname, $pathname) =
1180                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1181
1182         # first, analyze the 'current' part
1183         if (defined $pathname) {
1184                 # we got "branch:filename" or "branch:dir/"
1185                 # we could use git_get_type(branch:pathname), but:
1186                 # - it needs $git_dir
1187                 # - it does a git() call
1188                 # - the convention of terminating directories with a slash
1189                 #   makes it superfluous
1190                 # - embedding the action in the PATH_INFO would make it even
1191                 #   more superfluous
1192                 $pathname =~ s,^/+,,;
1193                 if (!$pathname || substr($pathname, -1) eq "/") {
1194                         $input_params{'action'} ||= "tree";
1195                         $pathname =~ s,/$,,;
1196                 } else {
1197                         # the default action depends on whether we had parent info
1198                         # or not
1199                         if ($parentrefname) {
1200                                 $input_params{'action'} ||= "blobdiff_plain";
1201                         } else {
1202                                 $input_params{'action'} ||= "blob_plain";
1203                         }
1204                 }
1205                 $input_params{'hash_base'} ||= $refname;
1206                 $input_params{'file_name'} ||= $pathname;
1207         } elsif (defined $refname) {
1208                 # we got "branch". In this case we have to choose if we have to
1209                 # set hash or hash_base.
1210                 #
1211                 # Most of the actions without a pathname only want hash to be
1212                 # set, except for the ones specified in @wants_base that want
1213                 # hash_base instead. It should also be noted that hand-crafted
1214                 # links having 'history' as an action and no pathname or hash
1215                 # set will fail, but that happens regardless of PATH_INFO.
1216                 if (defined $parentrefname) {
1217                         # if there is parent let the default be 'shortlog' action
1218                         # (for http://git.example.com/repo.git/A..B links); if there
1219                         # is no parent, dispatch will detect type of object and set
1220                         # action appropriately if required (if action is not set)
1221                         $input_params{'action'} ||= "shortlog";
1222                 }
1223                 if ($input_params{'action'} &&
1224                     grep { $_ eq $input_params{'action'} } @wants_base) {
1225                         $input_params{'hash_base'} ||= $refname;
1226                 } else {
1227                         $input_params{'hash'} ||= $refname;
1228                 }
1229         }
1230
1231         # next, handle the 'parent' part, if present
1232         if (defined $parentrefname) {
1233                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1234                 # someproject/blobdiff/oldrev..newrev:/filename
1235                 if ($parentpathname) {
1236                         $parentpathname =~ s,^/+,,;
1237                         $parentpathname =~ s,/$,,;
1238                         $input_params{'file_parent'} ||= $parentpathname;
1239                 } else {
1240                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1241                 }
1242                 # we assume that hash_parent_base is wanted if a path was specified,
1243                 # or if the action wants hash_base instead of hash
1244                 if (defined $input_params{'file_parent'} ||
1245                         grep { $_ eq $input_params{'action'} } @wants_base) {
1246                         $input_params{'hash_parent_base'} ||= $parentrefname;
1247                 } else {
1248                         $input_params{'hash_parent'} ||= $parentrefname;
1249                 }
1250         }
1251
1252         # for the snapshot action, we allow URLs in the form
1253         # $project/snapshot/$hash.ext
1254         # where .ext determines the snapshot and gets removed from the
1255         # passed $refname to provide the $hash.
1256         #
1257         # To be able to tell that $refname includes the format extension, we
1258         # require the following two conditions to be satisfied:
1259         # - the hash input parameter MUST have been set from the $refname part
1260         #   of the URL (i.e. they must be equal)
1261         # - the snapshot format MUST NOT have been defined already (e.g. from
1262         #   CGI parameter sf)
1263         # It's also useless to try any matching unless $refname has a dot,
1264         # so we check for that too
1265         if (defined $input_params{'action'} &&
1266                 $input_params{'action'} eq 'snapshot' &&
1267                 defined $refname && index($refname, '.') != -1 &&
1268                 $refname eq $input_params{'hash'} &&
1269                 !defined $input_params{'snapshot_format'}) {
1270                 # We loop over the known snapshot formats, checking for
1271                 # extensions. Allowed extensions are both the defined suffix
1272                 # (which includes the initial dot already) and the snapshot
1273                 # format key itself, with a prepended dot
1274                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1275                         my $hash = $refname;
1276                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1277                                 next;
1278                         }
1279                         my $sfx = $1;
1280                         # a valid suffix was found, so set the snapshot format
1281                         # and reset the hash parameter
1282                         $input_params{'snapshot_format'} = $fmt;
1283                         $input_params{'hash'} = $hash;
1284                         # we also set the format suffix to the one requested
1285                         # in the URL: this way a request for e.g. .tgz returns
1286                         # a .tgz instead of a .tar.gz
1287                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1288                         last;
1289                 }
1290         }
1291 }
1292
1293 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1294      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1295      $searchtext, $search_regexp, $project_filter);
1296 sub evaluate_and_validate_params {
1297         our $action = $input_params{'action'};
1298         if (defined $action) {
1299                 if (!is_valid_action($action)) {
1300                         die_error(400, "Invalid action parameter");
1301                 }
1302         }
1303
1304         # parameters which are pathnames
1305         our $project = $input_params{'project'};
1306         if (defined $project) {
1307                 if (!is_valid_project($project)) {
1308                         undef $project;
1309                         die_error(404, "No such project");
1310                 }
1311         }
1312
1313         our $project_filter = $input_params{'project_filter'};
1314         if (defined $project_filter) {
1315                 if (!is_valid_pathname($project_filter)) {
1316                         die_error(404, "Invalid project_filter parameter");
1317                 }
1318         }
1319
1320         our $file_name = $input_params{'file_name'};
1321         if (defined $file_name) {
1322                 if (!is_valid_pathname($file_name)) {
1323                         die_error(400, "Invalid file parameter");
1324                 }
1325         }
1326
1327         our $file_parent = $input_params{'file_parent'};
1328         if (defined $file_parent) {
1329                 if (!is_valid_pathname($file_parent)) {
1330                         die_error(400, "Invalid file parent parameter");
1331                 }
1332         }
1333
1334         # parameters which are refnames
1335         our $hash = $input_params{'hash'};
1336         if (defined $hash) {
1337                 if (!is_valid_refname($hash)) {
1338                         die_error(400, "Invalid hash parameter");
1339                 }
1340         }
1341
1342         our $hash_parent = $input_params{'hash_parent'};
1343         if (defined $hash_parent) {
1344                 if (!is_valid_refname($hash_parent)) {
1345                         die_error(400, "Invalid hash parent parameter");
1346                 }
1347         }
1348
1349         our $hash_base = $input_params{'hash_base'};
1350         if (defined $hash_base) {
1351                 if (!is_valid_refname($hash_base)) {
1352                         die_error(400, "Invalid hash base parameter");
1353                 }
1354         }
1355
1356         our @extra_options = @{$input_params{'extra_options'}};
1357         # @extra_options is always defined, since it can only be (currently) set from
1358         # CGI, and $cgi->param() returns the empty array in array context if the param
1359         # is not set
1360         foreach my $opt (@extra_options) {
1361                 if (not exists $allowed_options{$opt}) {
1362                         die_error(400, "Invalid option parameter");
1363                 }
1364                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1365                         die_error(400, "Invalid option parameter for this action");
1366                 }
1367         }
1368
1369         our $hash_parent_base = $input_params{'hash_parent_base'};
1370         if (defined $hash_parent_base) {
1371                 if (!is_valid_refname($hash_parent_base)) {
1372                         die_error(400, "Invalid hash parent base parameter");
1373                 }
1374         }
1375
1376         # other parameters
1377         our $page = $input_params{'page'};
1378         if (defined $page) {
1379                 if ($page =~ m/[^0-9]/) {
1380                         die_error(400, "Invalid page parameter");
1381                 }
1382         }
1383
1384         our $searchtype = $input_params{'searchtype'};
1385         if (defined $searchtype) {
1386                 if ($searchtype =~ m/[^a-z]/) {
1387                         die_error(400, "Invalid searchtype parameter");
1388                 }
1389         }
1390
1391         our $search_use_regexp = $input_params{'search_use_regexp'};
1392
1393         our $searchtext = $input_params{'searchtext'};
1394         our $search_regexp = undef;
1395         if (defined $searchtext) {
1396                 if (length($searchtext) < 2) {
1397                         die_error(403, "At least two characters are required for search parameter");
1398                 }
1399                 if ($search_use_regexp) {
1400                         $search_regexp = $searchtext;
1401                         if (!eval { qr/$search_regexp/; 1; }) {
1402                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1403                                 die_error(400, "Invalid search regexp '$search_regexp'",
1404                                           esc_html($error));
1405                         }
1406                 } else {
1407                         $search_regexp = quotemeta $searchtext;
1408                 }
1409         }
1410 }
1411
1412 # path to the current git repository
1413 our $git_dir;
1414 sub evaluate_git_dir {
1415         our $git_dir = $project ? "$projectroot/$project" : undef;
1416 }
1417
1418 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1419 sub configure_gitweb_features {
1420         # list of supported snapshot formats
1421         our @snapshot_fmts = gitweb_get_feature('snapshot');
1422         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1423
1424         # check that the avatar feature is set to a known provider name,
1425         # and for each provider check if the dependencies are satisfied.
1426         # if the provider name is invalid or the dependencies are not met,
1427         # reset $git_avatar to the empty string.
1428         our ($git_avatar) = gitweb_get_feature('avatar');
1429         if ($git_avatar eq 'gravatar') {
1430                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1431         } elsif ($git_avatar eq 'picon') {
1432                 # no dependencies
1433         } else {
1434                 $git_avatar = '';
1435         }
1436
1437         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1438         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1439 }
1440
1441 sub get_branch_refs {
1442         return ('heads', @extra_branch_refs);
1443 }
1444
1445 # custom error handler: 'die <message>' is Internal Server Error
1446 sub handle_errors_html {
1447         my $msg = shift; # it is already HTML escaped
1448
1449         # to avoid infinite loop where error occurs in die_error,
1450         # change handler to default handler, disabling handle_errors_html
1451         set_message("Error occurred when inside die_error:\n$msg");
1452
1453         # you cannot jump out of die_error when called as error handler;
1454         # the subroutine set via CGI::Carp::set_message is called _after_
1455         # HTTP headers are already written, so it cannot write them itself
1456         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1457 }
1458 set_message(\&handle_errors_html);
1459
1460 our $shown_stale_message = 0;
1461 our $cache_dump = undef;
1462 our $cache_dump_mtime = undef;
1463
1464 # dispatch
1465 my $cache_mode_active;
1466 sub dispatch {
1467         $shown_stale_message = 0;
1468         if (!defined $action) {
1469                 if (defined $hash) {
1470                         $action = git_get_type($hash);
1471                         $action or die_error(404, "Object does not exist");
1472                 } elsif (defined $hash_base && defined $file_name) {
1473                         $action = git_get_type("$hash_base:$file_name");
1474                         $action or die_error(404, "File or directory does not exist");
1475                 } elsif (defined $project) {
1476                         $action = 'summary';
1477                 } else {
1478                         $action = 'frontpage';
1479                 }
1480         }
1481         if (!defined($actions{$action})) {
1482                 die_error(400, "Unknown action");
1483         }
1484         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1485             !$project) {
1486                 die_error(400, "Project needed");
1487         }
1488
1489         my $cached_page = $supported_cache_actions{$action}
1490                 ? cached_action_page($action)
1491                 : undef;
1492         goto DUMPCACHE if $cached_page;
1493         local *SAVEOUT = *STDOUT;
1494         $cache_mode_active = $supported_cache_actions{$action}
1495                 ? cached_action_start($action)
1496                 : undef;
1497
1498         configure_gitweb_features();
1499         $actions{$action}->();
1500
1501         return unless $cache_mode_active;
1502
1503         $cached_page = cached_action_finish($action);
1504         *STDOUT = *SAVEOUT;
1505
1506         DUMPCACHE:
1507
1508         $cache_mode_active = 0;
1509         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1510         binmode STDOUT, ':raw';
1511         our $fcgi_raw_mode = 1;
1512         print expand_gitweb_pi($cached_page, time);
1513         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1514         $fcgi_raw_mode = 0;
1515 }
1516
1517 sub reset_timer {
1518         our $t0 = [ gettimeofday() ]
1519                 if defined $t0;
1520         our $number_of_git_cmds = 0;
1521 }
1522
1523 our $first_request = 1;
1524 our $evaluate_uri_force = undef;
1525 sub run_request {
1526         reset_timer();
1527
1528         # do not reuse stale config or project list from prior FCGI request
1529         our $config_file = '';
1530         our $gitweb_project_owner = undef;
1531
1532         # Only allow GET and HEAD methods
1533         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1534                 print <<EOT;
1535 Status: 405 Method Not Allowed
1536 Content-Type: text/plain
1537 Allow: GET,HEAD
1538
1539 405 Method Not Allowed
1540 EOT
1541                 return;
1542         }
1543
1544         evaluate_uri();
1545         &$evaluate_uri_force() if $evaluate_uri_force;
1546         if ($per_request_config) {
1547                 if (ref($per_request_config) eq 'CODE') {
1548                         $per_request_config->();
1549                 } elsif (!$first_request) {
1550                         evaluate_gitweb_config();
1551                         evaluate_email_obfuscate();
1552                 }
1553         }
1554         check_loadavg();
1555
1556         # $projectroot and $projects_list might be set in gitweb config file
1557         $projects_list ||= $projectroot;
1558
1559         evaluate_query_params();
1560         evaluate_path_info();
1561         evaluate_and_validate_params();
1562         evaluate_git_dir();
1563
1564         dispatch();
1565 }
1566
1567 our $is_last_request = sub { 1 };
1568 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1569 our $CGI = 'CGI';
1570 our $cgi;
1571 our $fcgi_mode = 0;
1572 our $fcgi_nproc_active = 0;
1573 our $fcgi_raw_mode = 0;
1574 sub is_fcgi {
1575         use Errno;
1576         my $stdinfno = fileno STDIN;
1577         return 0 unless defined $stdinfno && $stdinfno == 0;
1578         return 0 unless getsockname STDIN;
1579         return 0 if getpeername STDIN;
1580         return $!{ENOTCONN}?1:0;
1581 }
1582 sub configure_as_fcgi {
1583         return if $fcgi_mode;
1584
1585         require FCGI;
1586         require CGI::Fast;
1587
1588         # We have gone to great effort to make sure that all incoming data has
1589         # been converted from whatever format it was in into UTF-8.  We have
1590         # even taken care to make sure the output handle is in ':utf8' mode.
1591         # Now along comes FCGI and blows it with:
1592         #
1593         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1594         #      and will stop wprking[sic] in a future version of FCGI
1595         #
1596         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1597         # first encodes everything and then calls the original routine, but
1598         # not if $fcgi_raw_mode is true (then we just call the original routine).
1599         #
1600         # Note that we could do this by using utf8::is_utf8 to check instead
1601         # of having a $fcgi_raw_mode global, but that would be slower to run
1602         # the test on each element and much slower than skipping the conversion
1603         # entirely when we know we're outputting raw bytes.
1604         my $orig = \&FCGI::Stream::PRINT;
1605         undef *FCGI::Stream::PRINT;
1606         *FCGI::Stream::PRINT = sub {
1607                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1608                         unless $fcgi_raw_mode;
1609                 goto $orig;
1610         };
1611
1612         our $CGI = 'CGI::Fast';
1613
1614         $fcgi_mode = 1;
1615         $first_request = 0;
1616         my $request_number = 0;
1617         # let each child service 100 requests
1618         our $is_last_request = sub { ++$request_number > 100 };
1619 }
1620 sub evaluate_argv {
1621         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1622         configure_as_fcgi()
1623                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1624
1625         my $nproc_sub = sub {
1626                 my ($arg, $val) = @_;
1627                 return unless eval { require FCGI::ProcManager; 1; };
1628                 $fcgi_nproc_active = 1;
1629                 my $proc_manager = FCGI::ProcManager->new({
1630                         n_processes => $val,
1631                 });
1632                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1633                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1634                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1635         };
1636         if (@ARGV) {
1637                 require Getopt::Long;
1638                 Getopt::Long::GetOptions(
1639                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1640                         'nproc|n=i' => $nproc_sub,
1641                 );
1642         };
1643         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1644                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1645         }
1646 }
1647
1648 sub run {
1649         evaluate_gitweb_config();
1650         evaluate_encoding();
1651         evaluate_email_obfuscate();
1652         evaluate_git_version();
1653         my ($mu, $hl, $subroutine) = ($my_uri, $home_link, '');
1654         $subroutine .= '$my_uri = $mu;' if defined $my_uri && $my_uri ne '';
1655         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1656         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1657         $first_request = 1;
1658         evaluate_argv();
1659
1660         $pre_listen_hook->()
1661                 if $pre_listen_hook;
1662
1663  REQUEST:
1664         while ($cgi = $CGI->new()) {
1665                 $pre_dispatch_hook->()
1666                         if $pre_dispatch_hook;
1667
1668                 run_request();
1669
1670                 $post_dispatch_hook->()
1671                         if $post_dispatch_hook;
1672                 $first_request = 0;
1673
1674                 last REQUEST if ($is_last_request->());
1675         }
1676
1677  DONE_GITWEB:
1678         1;
1679 }
1680
1681 run();
1682
1683 if (defined caller) {
1684         # wrapped in a subroutine processing requests,
1685         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1686         return;
1687 } else {
1688         # pure CGI script, serving single request
1689         exit;
1690 }
1691
1692 ## ======================================================================
1693 ## action links
1694
1695 # possible values of extra options
1696 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1697 # -replay => 1      - start from a current view (replay with modifications)
1698 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1699 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1700 sub href {
1701         my %params = @_;
1702         # default is to use -absolute url() i.e. $my_uri
1703         my $href = $params{-full} ? $my_url : $my_uri;
1704
1705         # implicit -replay, must be first of implicit params
1706         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1707
1708         $params{'project'} = $project unless exists $params{'project'};
1709
1710         if ($params{-replay}) {
1711                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1712                         if (!exists $params{$name}) {
1713                                 $params{$name} = $input_params{$name};
1714                         }
1715                 }
1716         }
1717
1718         my $use_pathinfo = gitweb_check_feature('pathinfo');
1719         if (defined $params{'project'} &&
1720             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1721                 # try to put as many parameters as possible in PATH_INFO:
1722                 #   - project name
1723                 #   - action
1724                 #   - hash_parent or hash_parent_base:/file_parent
1725                 #   - hash or hash_base:/filename
1726                 #   - the snapshot_format as an appropriate suffix
1727
1728                 # When the script is the root DirectoryIndex for the domain,
1729                 # $href here would be something like http://gitweb.example.com/
1730                 # Thus, we strip any trailing / from $href, to spare us double
1731                 # slashes in the final URL
1732                 $href =~ s,/$,,;
1733
1734                 # Then add the project name, if present
1735                 $href .= "/".esc_path_info($params{'project'});
1736                 delete $params{'project'};
1737
1738                 # since we destructively absorb parameters, we keep this
1739                 # boolean that remembers if we're handling a snapshot
1740                 my $is_snapshot = $params{'action'} eq 'snapshot';
1741
1742                 # Summary just uses the project path URL, any other action is
1743                 # added to the URL
1744                 if (defined $params{'action'}) {
1745                         $href .= "/".esc_path_info($params{'action'})
1746                                 unless $params{'action'} eq 'summary';
1747                         delete $params{'action'};
1748                 }
1749
1750                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1751                 # stripping nonexistent or useless pieces
1752                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1753                         || $params{'hash_parent'} || $params{'hash'});
1754                 if (defined $params{'hash_base'}) {
1755                         if (defined $params{'hash_parent_base'}) {
1756                                 $href .= esc_path_info($params{'hash_parent_base'});
1757                                 # skip the file_parent if it's the same as the file_name
1758                                 if (defined $params{'file_parent'}) {
1759                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1760                                                 delete $params{'file_parent'};
1761                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1762                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1763                                                 delete $params{'file_parent'};
1764                                         }
1765                                 }
1766                                 $href .= "..";
1767                                 delete $params{'hash_parent'};
1768                                 delete $params{'hash_parent_base'};
1769                         } elsif (defined $params{'hash_parent'}) {
1770                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1771                                 delete $params{'hash_parent'};
1772                         }
1773
1774                         $href .= esc_path_info($params{'hash_base'});
1775                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1776                                 $href .= ":/".esc_path_info($params{'file_name'});
1777                                 delete $params{'file_name'};
1778                         }
1779                         delete $params{'hash'};
1780                         delete $params{'hash_base'};
1781                 } elsif (defined $params{'hash'}) {
1782                         $href .= esc_path_info($params{'hash'});
1783                         delete $params{'hash'};
1784                 }
1785
1786                 # If the action was a snapshot, we can absorb the
1787                 # snapshot_format parameter too
1788                 if ($is_snapshot) {
1789                         my $fmt = $params{'snapshot_format'};
1790                         # snapshot_format should always be defined when href()
1791                         # is called, but just in case some code forgets, we
1792                         # fall back to the default
1793                         $fmt ||= $snapshot_fmts[0];
1794                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1795                         delete $params{'snapshot_format'};
1796                 }
1797         }
1798
1799         # now encode the parameters explicitly
1800         my @result = ();
1801         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1802                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1803                 if (defined $params{$name}) {
1804                         if (ref($params{$name}) eq "ARRAY") {
1805                                 foreach my $par (@{$params{$name}}) {
1806                                         push @result, $symbol . "=" . esc_param($par);
1807                                 }
1808                         } else {
1809                                 push @result, $symbol . "=" . esc_param($params{$name});
1810                         }
1811                 }
1812         }
1813         $href .= "?" . join(';', @result) if scalar @result;
1814
1815         # final transformation: trailing spaces must be escaped (URI-encoded)
1816         $href =~ s/(\s+)$/CGI::escape($1)/e;
1817
1818         if ($params{-anchor}) {
1819                 $href .= "#".esc_param($params{-anchor});
1820         }
1821
1822         return $href;
1823 }
1824
1825
1826 ## ======================================================================
1827 ## validation, quoting/unquoting and escaping
1828
1829 sub is_valid_action {
1830         my $input = shift;
1831         return undef unless exists $actions{$input};
1832         return 1;
1833 }
1834
1835 sub is_valid_project {
1836         my $input = shift;
1837
1838         return unless defined $input;
1839         if (!is_valid_pathname($input) ||
1840                 !(-d "$projectroot/$input") ||
1841                 !check_export_ok("$projectroot/$input") ||
1842                 ($strict_export && !project_in_list($input))) {
1843                 return undef;
1844         } else {
1845                 return 1;
1846         }
1847 }
1848
1849 sub is_valid_pathname {
1850         my $input = shift;
1851
1852         return undef unless defined $input;
1853         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1854         # at the beginning, at the end, and between slashes.
1855         # also this catches doubled slashes
1856         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1857                 return undef;
1858         }
1859         # no null characters
1860         if ($input =~ m!\0!) {
1861                 return undef;
1862         }
1863         return 1;
1864 }
1865
1866 sub is_valid_ref_format {
1867         my $input = shift;
1868
1869         return undef unless defined $input;
1870         # restrictions on ref name according to git-check-ref-format
1871         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1872                 return undef;
1873         }
1874         return 1;
1875 }
1876
1877 sub is_valid_refname {
1878         my $input = shift;
1879
1880         return undef unless defined $input;
1881         # textual hashes are O.K.
1882         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1883                 return 1;
1884         }
1885         # it must be correct pathname
1886         is_valid_pathname($input) or return undef;
1887         # check git-check-ref-format restrictions
1888         is_valid_ref_format($input) or return undef;
1889         return 1;
1890 }
1891
1892 # decode sequences of octets in utf8 into Perl's internal form,
1893 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1894 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1895 sub to_utf8 {
1896         my $str = shift;
1897         return undef unless defined $str;
1898
1899         if (utf8::is_utf8($str) || utf8::decode($str)) {
1900                 return $str;
1901         } else {
1902                 return $encode_object->decode($str, Encode::FB_DEFAULT);
1903         }
1904 }
1905
1906 # quote unsafe chars, but keep the slash, even when it's not
1907 # correct, but quoted slashes look too horrible in bookmarks
1908 sub esc_param {
1909         my $str = shift;
1910         return undef unless defined $str;
1911         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1912         $str =~ s/ /\+/g;
1913         return $str;
1914 }
1915
1916 # the quoting rules for path_info fragment are slightly different
1917 sub esc_path_info {
1918         my $str = shift;
1919         return undef unless defined $str;
1920
1921         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1922         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1923
1924         return $str;
1925 }
1926
1927 # quote unsafe chars in whole URL, so some characters cannot be quoted
1928 sub esc_url {
1929         my $str = shift;
1930         return undef unless defined $str;
1931         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1932         $str =~ s/ /\+/g;
1933         return $str;
1934 }
1935
1936 # quote unsafe characters in HTML attributes
1937 sub esc_attr {
1938
1939         # for XHTML conformance escaping '"' to '&quot;' is not enough
1940         return esc_html(@_);
1941 }
1942
1943 # replace invalid utf8 character with SUBSTITUTION sequence
1944 sub esc_html {
1945         my $str = shift;
1946         my %opts = @_;
1947
1948         return undef unless defined $str;
1949
1950         $str = to_utf8($str);
1951         $str = $cgi->escapeHTML($str);
1952         if ($opts{'-nbsp'}) {
1953                 $str =~ s/ /&#160;/g;
1954         }
1955         use bytes;
1956         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
1957         return $str;
1958 }
1959
1960 # quote control characters and escape filename to HTML
1961 sub esc_path {
1962         my $str = shift;
1963         my %opts = @_;
1964
1965         return undef unless defined $str;
1966
1967         $str = to_utf8($str);
1968         $str = $cgi->escapeHTML($str);
1969         if ($opts{'-nbsp'}) {
1970                 $str =~ s/ /&#160;/g;
1971         }
1972         use bytes;
1973         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
1974         return $str;
1975 }
1976
1977 # Sanitize for use in XHTML + application/xml+xhtm (valid XML 1.0)
1978 sub sanitize {
1979         my $str = shift;
1980
1981         return undef unless defined $str;
1982
1983         $str = to_utf8($str);
1984         use bytes;
1985         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
1986         return $str;
1987 }
1988
1989 # Make control characters "printable", using character escape codes (CEC)
1990 sub quot_cec {
1991         my $cntrl = shift;
1992         my %opts = @_;
1993         my %es = ( # character escape codes, aka escape sequences
1994                 "\t" => '\t',   # tab            (HT)
1995                 "\n" => '\n',   # line feed      (LF)
1996                 "\r" => '\r',   # carrige return (CR)
1997                 "\f" => '\f',   # form feed      (FF)
1998                 "\b" => '\b',   # backspace      (BS)
1999                 "\a" => '\a',   # alarm (bell)   (BEL)
2000                 "\e" => '\e',   # escape         (ESC)
2001                 "\013" => '\v', # vertical tab   (VT)
2002                 "\000" => '\0', # nul character  (NUL)
2003         );
2004         my $chr = ( (exists $es{$cntrl})
2005                     ? $es{$cntrl}
2006                     : sprintf('\x%02x', ord($cntrl)) );
2007         if ($opts{-nohtml}) {
2008                 return $chr;
2009         } else {
2010                 return "<span class=\"cntrl\">$chr</span>";
2011         }
2012 }
2013
2014 # Alternatively use unicode control pictures codepoints,
2015 # Unicode "printable representation" (PR)
2016 sub quot_upr {
2017         my $cntrl = shift;
2018         my %opts = @_;
2019
2020         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2021         if ($opts{-nohtml}) {
2022                 return $chr;
2023         } else {
2024                 return "<span class=\"cntrl\">$chr</span>";
2025         }
2026 }
2027
2028 # git may return quoted and escaped filenames
2029 sub unquote {
2030         my $str = shift;
2031
2032         sub unq {
2033                 my $seq = shift;
2034                 my %es = ( # character escape codes, aka escape sequences
2035                         't' => "\t",   # tab            (HT, TAB)
2036                         'n' => "\n",   # newline        (NL)
2037                         'r' => "\r",   # return         (CR)
2038                         'f' => "\f",   # form feed      (FF)
2039                         'b' => "\b",   # backspace      (BS)
2040                         'a' => "\a",   # alarm (bell)   (BEL)
2041                         'e' => "\e",   # escape         (ESC)
2042                         'v' => "\013", # vertical tab   (VT)
2043                 );
2044
2045                 if ($seq =~ m/^[0-7]{1,3}$/) {
2046                         # octal char sequence
2047                         return chr(oct($seq));
2048                 } elsif (exists $es{$seq}) {
2049                         # C escape sequence, aka character escape code
2050                         return $es{$seq};
2051                 }
2052                 # quoted ordinary character
2053                 return $seq;
2054         }
2055
2056         if ($str =~ m/^"(.*)"$/) {
2057                 # needs unquoting
2058                 $str = $1;
2059                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2060         }
2061         return $str;
2062 }
2063
2064 # escape tabs (convert tabs to spaces)
2065 sub untabify {
2066         my $line = shift;
2067
2068         while ((my $pos = index($line, "\t")) != -1) {
2069                 if (my $count = (8 - ($pos % 8))) {
2070                         my $spaces = ' ' x $count;
2071                         $line =~ s/\t/$spaces/;
2072                 }
2073         }
2074
2075         return $line;
2076 }
2077
2078 sub project_in_list {
2079         my $project = shift;
2080         my @list = git_get_projects_list();
2081         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2082 }
2083
2084 sub cached_page_precondition_check {
2085         my $action = shift;
2086         return 1 unless
2087                 $action eq 'summary' &&
2088                 $projlist_cache_lifetime > 0 &&
2089                 gitweb_check_feature('forks');
2090
2091         # Note that ALL the 'forkchange' logic is in this function.
2092         # It does NOT belong in cached_action_page NOR in cached_action_start
2093         # NOR in cached_action_finish.  None of those functions should know anything
2094         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2095
2096         # besides the basic 'changed' "$action.changed" check, we may only use
2097         # a summary cache if:
2098         #
2099         #   1) we are not using a project list cache file
2100         #   -OR-
2101         #   2) we are not using the 'forks' feature
2102         #   -OR-
2103         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2104         #   -OR-
2105         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2106         #   -OR-
2107         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2108         #
2109         # Otherwise we must re-generate the cache because we've had a fork change
2110         # (either a fork was added or a fork was removed) AND the change has been
2111         # picked up in the cache file AND we've not got that in our cached copy
2112         #
2113         # For (5) regenerating the cached page wouldn't get us anything if the project
2114         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2115         # forks information comes from the project cache file and it's clearly not
2116         # picked up the changes yet so we may continue to use a cached page until it does.
2117
2118         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2119         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2120         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2121         return 1 unless defined($fc_mt) || defined($afc_mt);
2122         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2123         return 1 unless $prj_mt;
2124         my $old_mt = $fc_mt;
2125         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2126         return 1 if $old_mt > $prj_mt;
2127
2128         # We're going to regenerate the cached page because we know the project cache
2129         # has new fork information that we cannot possibly have in our cached copy.
2130         #
2131         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2132         # them is older than the project cache and one of them is newer, we still
2133         # need to regenerate the page cache, but we will also need to do it again
2134         # in the future because there's yet another fork update not yet in the cache.
2135         #
2136         # So we make sure to touch "$action.changed" to force a cache regeneration
2137         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2138         # they're older than the project cache (they've served their purpose, we're
2139         # forcing a page regeneration by touching "$action.changed" but the project
2140         # cache was rebuilt since then so there are no more pending fork updates to
2141         # pick up in the future and they need to go).
2142
2143         # For best results, the external code that touches 'forkchange' should always
2144         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2145         # if it does not already exist.  That way the cached page will be regenerated
2146         # each time it's requested and ANY fork updates are available in the proj
2147         # cache rather than waiting until they all are before updating.
2148
2149         # Note that we take a shortcut here and will zap 'forkchange' since we know
2150         # that it only affects the 'summary' cache.  If, in the future, it affects
2151         # other cache types, it will first need to be propogated down to
2152         # "$action.forkchange" for those types before we zap it.
2153
2154         my $fd;
2155         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2156         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2157         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2158
2159         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2160         # one and not the other.
2161
2162         if (defined $fc_mt && ! defined $afc_mt) {
2163                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2164                 -e "$htmlcd/$action.forkchange" and
2165                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2166                 unlink "$htmlcd/forkchange";
2167         }
2168
2169         return 0;
2170 }
2171
2172 sub cached_action_page {
2173         my $action = shift;
2174
2175         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2176         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2177         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2178         return undef unless cached_page_precondition_check($action);
2179         open my $fd, '<', "$htmlcd/$action" or return undef;
2180         binmode $fd;
2181         local $/;
2182         my $cached_page = <$fd>;
2183         close $fd or return undef;
2184         return $cached_page;
2185 }
2186
2187 package Git::Gitweb::CacheFile;
2188
2189 sub TIEHANDLE {
2190         use POSIX qw(:fcntl_h);
2191         my $class = shift;
2192         my $cachefile = shift;
2193
2194         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2195                 or return undef;
2196         $$self->{'cachefile'} = $cachefile;
2197         $$self->{'opened'} = 1;
2198         $$self->{'contents'} = '';
2199         return bless $self, $class;
2200 }
2201
2202 sub CLOSE {
2203         my $self = shift;
2204         if ($$self->{'opened'}) {
2205                 $$self->{'opened'} = 0;
2206                 my $result = close $self;
2207                 unlink $$self->{'cachefile'} unless $result;
2208                 return $result;
2209         }
2210         return 0;
2211 }
2212
2213 sub DESTROY {
2214         my $self = shift;
2215         if ($$self->{'opened'}) {
2216                 $self->CLOSE() and unlink $$self->{'cachefile'};
2217         }
2218 }
2219
2220 sub PRINT {
2221         my $self = shift;
2222         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2223         print $self @_ if $$self->{'opened'};
2224         $$self->{'contents'} .= join('', @_);
2225         return 1;
2226 }
2227
2228 sub PRINTF {
2229         my $self = shift;
2230         my $template = shift;
2231         return $self->PRINT(sprintf $template, @_);
2232 }
2233
2234 sub contents {
2235         my $self = shift;
2236         return $$self->{'contents'};
2237 }
2238
2239 package main;
2240
2241 # Caller is responsible for preserving STDOUT beforehand if needed
2242 sub cached_action_start {
2243         my $action = shift;
2244
2245         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2246         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2247         return undef unless -d $htmlcd;
2248         if (-e "$htmlcd/changed") {
2249                 foreach my $cacheable (keys(%html_cache_actions)) {
2250                         next unless $supported_cache_actions{$cacheable} &&
2251                                     $html_cache_actions{$cacheable};
2252                         my $fd;
2253                         open $fd, '>', "$htmlcd/$cacheable.changed"
2254                         and close $fd;
2255                 }
2256                 unlink "$htmlcd/changed";
2257         }
2258         local *CACHEFILE;
2259         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2260         *STDOUT = *CACHEFILE;
2261         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2262         return 1;
2263 }
2264
2265 # Caller is responsible for restoring STDOUT afterward if needed
2266 sub cached_action_finish {
2267         my $action = shift;
2268
2269         use File::Spec;
2270
2271         my $obj = tied *STDOUT;
2272         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2273         my $cached_page = $obj->contents;
2274         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2275         # Do not leave STDOUT file descriptor invalid!
2276         local *NULL;
2277         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2278         *STDOUT = *NULL;
2279         return $cached_page unless $result;
2280         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2281         return $cached_page unless -d $htmlcd;
2282         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2283         return $cached_page;
2284 }
2285
2286 my %expand_pi_subs;
2287 BEGIN {%expand_pi_subs = (
2288         'age_string'              => \&age_string,
2289         'age_string_date'         => \&age_string_date,
2290         'age_string_age'          => \&age_string_age,
2291         'compute_timed_interval'  => \&compute_timed_interval,
2292         'compute_commands_count'  => \&compute_commands_count,
2293         'format_lastrefresh_row'  => \&format_lastrefresh_row,
2294 )}
2295
2296 # Expands any <?gitweb...> processing instructions and returns the result
2297 sub expand_gitweb_pi {
2298         my $page = shift;
2299         $page .= '';
2300         my @time_now = gettimeofday();
2301         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2302                   {defined($1) ?
2303                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2304                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2305                                   '') :
2306                           '' }goes;
2307         return $page;
2308 }
2309
2310 ## ----------------------------------------------------------------------
2311 ## HTML aware string manipulation
2312
2313 # Try to chop given string on a word boundary between position
2314 # $len and $len+$add_len. If there is no word boundary there,
2315 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2316 # (marking chopped part) would be longer than given string.
2317 sub chop_str {
2318         my $str = shift;
2319         my $len = shift;
2320         my $add_len = shift || 10;
2321         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2322
2323         # Make sure perl knows it is utf8 encoded so we don't
2324         # cut in the middle of a utf8 multibyte char.
2325         $str = to_utf8($str);
2326
2327         # allow only $len chars, but don't cut a word if it would fit in $add_len
2328         # if it doesn't fit, cut it if it's still longer than the dots we would add
2329         # remove chopped character entities entirely
2330
2331         # when chopping in the middle, distribute $len into left and right part
2332         # return early if chopping wouldn't make string shorter
2333         if ($where eq 'center') {
2334                 return $str if ($len + 5 >= length($str)); # filler is length 5
2335                 $len = int($len/2);
2336         } else {
2337                 return $str if ($len + 4 >= length($str)); # filler is length 4
2338         }
2339
2340         # regexps: ending and beginning with word part up to $add_len
2341         my $endre = qr/.{$len}\w{0,$add_len}/;
2342         my $begre = qr/\w{0,$add_len}.{$len}/;
2343
2344         if ($where eq 'left') {
2345                 $str =~ m/^(.*?)($begre)$/;
2346                 my ($lead, $body) = ($1, $2);
2347                 if (length($lead) > 4) {
2348                         $lead = " ...";
2349                 }
2350                 return "$lead$body";
2351
2352         } elsif ($where eq 'center') {
2353                 $str =~ m/^($endre)(.*)$/;
2354                 my ($left, $str)  = ($1, $2);
2355                 $str =~ m/^(.*?)($begre)$/;
2356                 my ($mid, $right) = ($1, $2);
2357                 if (length($mid) > 5) {
2358                         $mid = " ... ";
2359                 }
2360                 return "$left$mid$right";
2361
2362         } else {
2363                 $str =~ m/^($endre)(.*)$/;
2364                 my $body = $1;
2365                 my $tail = $2;
2366                 if (length($tail) > 4) {
2367                         $tail = "... ";
2368                 }
2369                 return "$body$tail";
2370         }
2371 }
2372
2373 # pass-through email filter, obfuscating it when possible
2374 sub email_obfuscate {
2375         our $email;
2376         my ($str) = @_;
2377         if ($email) {
2378                 $str = $email->escape_html($str);
2379                 # Stock HTML::Email::Obfuscate version likes to produce
2380                 # invalid XHTML...
2381                 $str =~ s#<(/?)B>#<$1b>#g;
2382                 return $str;
2383         } else {
2384                 $str = esc_html($str);
2385                 $str =~ s/@/&#x40;/;
2386                 return $str;
2387         }
2388 }
2389
2390 # takes the same arguments as chop_str, but also wraps a <span> around the
2391 # result with a title attribute if it does get chopped. Additionally, the
2392 # string is HTML-escaped.
2393 sub chop_and_escape_str {
2394         my ($str) = @_;
2395
2396         my $chopped = chop_str(@_);
2397         $str = to_utf8($str);
2398         if ($chopped eq $str) {
2399                 return email_obfuscate($chopped);
2400         } else {
2401                 use bytes;
2402                 $str =~ s/[[:cntrl:]]/?/g;
2403                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2404         }
2405 }
2406
2407 # Highlight selected fragments of string, using given CSS class,
2408 # and escape HTML.  It is assumed that fragments do not overlap.
2409 # Regions are passed as list of pairs (array references).
2410 #
2411 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2412 # '<span class="mark">foo</span>bar'
2413 sub esc_html_hl_regions {
2414         my ($str, $css_class, @sel) = @_;
2415         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2416         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2417         return esc_html($str, %opts) unless @sel;
2418
2419         my $out = '';
2420         my $pos = 0;
2421
2422         for my $s (@sel) {
2423                 my ($begin, $end) = @$s;
2424
2425                 # Don't create empty <span> elements.
2426                 next if $end <= $begin;
2427
2428                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2429                                        %opts);
2430
2431                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2432                         if ($begin - $pos > 0);
2433                 $out .= $cgi->span({-class => $css_class}, $escaped);
2434
2435                 $pos = $end;
2436         }
2437         $out .= esc_html(substr($str, $pos), %opts)
2438                 if ($pos < length($str));
2439
2440         return $out;
2441 }
2442
2443 # return positions of beginning and end of each match
2444 sub matchpos_list {
2445         my ($str, $regexp) = @_;
2446         return unless (defined $str && defined $regexp);
2447
2448         my @matches;
2449         while ($str =~ /$regexp/g) {
2450                 push @matches, [$-[0], $+[0]];
2451         }
2452         return @matches;
2453 }
2454
2455 # highlight match (if any), and escape HTML
2456 sub esc_html_match_hl {
2457         my ($str, $regexp) = @_;
2458         return esc_html($str) unless defined $regexp;
2459
2460         my @matches = matchpos_list($str, $regexp);
2461         return esc_html($str) unless @matches;
2462
2463         return esc_html_hl_regions($str, 'match', @matches);
2464 }
2465
2466
2467 # highlight match (if any) of shortened string, and escape HTML
2468 sub esc_html_match_hl_chopped {
2469         my ($str, $chopped, $regexp) = @_;
2470         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2471
2472         my @matches = matchpos_list($str, $regexp);
2473         return esc_html($chopped) unless @matches;
2474
2475         # filter matches so that we mark chopped string
2476         my $tail = "... "; # see chop_str
2477         unless ($chopped =~ s/\Q$tail\E$//) {
2478                 $tail = '';
2479         }
2480         my $chop_len = length($chopped);
2481         my $tail_len = length($tail);
2482         my @filtered;
2483
2484         for my $m (@matches) {
2485                 if ($m->[0] > $chop_len) {
2486                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2487                         last;
2488                 } elsif ($m->[1] > $chop_len) {
2489                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2490                         last;
2491                 }
2492                 push @filtered, $m;
2493         }
2494
2495         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2496 }
2497
2498 ## ----------------------------------------------------------------------
2499 ## functions returning short strings
2500
2501 # CSS class for given age epoch value (in seconds)
2502 # and reference time (optional, defaults to now) as second value
2503 sub age_class {
2504         my ($age_epoch, $time_now) = @_;
2505         return "noage" unless defined $age_epoch;
2506         defined $time_now or $time_now = time;
2507         my $age = $time_now - $age_epoch;
2508
2509         if ($age < 60*60*2) {
2510                 return "age0";
2511         } elsif ($age < 60*60*24*2) {
2512                 return "age1";
2513         } else {
2514                 return "age2";
2515         }
2516 }
2517
2518 # convert age epoch in seconds to "nn units ago" string
2519 # reference time used is now unless second argument passed in
2520 # to get the old behavior, pass 0 as the first argument and
2521 # the time in seconds as the second
2522 sub age_string {
2523         my ($age_epoch, $time_now) = @_;
2524         return "unknown" unless defined $age_epoch;
2525         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2526         defined $time_now or $time_now = time;
2527         my $age = $time_now - $age_epoch;
2528         my $age_str;
2529
2530         if ($age > 60*60*24*365*2) {
2531                 $age_str = (int $age/60/60/24/365);
2532                 $age_str .= " years ago";
2533         } elsif ($age > 60*60*24*(365/12)*2) {
2534                 $age_str = int $age/60/60/24/(365/12);
2535                 $age_str .= " months ago";
2536         } elsif ($age > 60*60*24*7*2) {
2537                 $age_str = int $age/60/60/24/7;
2538                 $age_str .= " weeks ago";
2539         } elsif ($age > 60*60*24*2) {
2540                 $age_str = int $age/60/60/24;
2541                 $age_str .= " days ago";
2542         } elsif ($age > 60*60*2) {
2543                 $age_str = int $age/60/60;
2544                 $age_str .= " hours ago";
2545         } elsif ($age > 60*2) {
2546                 $age_str = int $age/60;
2547                 $age_str .= " min ago";
2548         } elsif ($age > 2) {
2549                 $age_str = int $age;
2550                 $age_str .= " sec ago";
2551         } else {
2552                 $age_str .= " right now";
2553         }
2554         return $age_str;
2555 }
2556
2557 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2558 # this is typically shown to the user directly with the age_string_age as a title
2559 sub age_string_date {
2560         my ($age_epoch, $time_now) = @_;
2561         return "unknown" unless defined $age_epoch;
2562         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2563         defined $time_now or $time_now = time;
2564         my $age = $time_now - $age_epoch;
2565
2566         if ($age > 60*60*24*7*2) {
2567                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2568                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2569         } else {
2570                 return age_string($age_epoch, $time_now);
2571         }
2572 }
2573
2574 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2575 # this is typically used for the 'title' attribute so it will show as a tooltip
2576 sub age_string_age {
2577         my ($age_epoch, $time_now) = @_;
2578         return "unknown" unless defined $age_epoch;
2579         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2580         defined $time_now or $time_now = time;
2581         my $age = $time_now - $age_epoch;
2582
2583         if ($age > 60*60*24*7*2) {
2584                 return age_string($age_epoch, $time_now);
2585         } else {
2586                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2587                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2588         }
2589 }
2590
2591 use constant {
2592         S_IFINVALID => 0030000,
2593         S_IFGITLINK => 0160000,
2594 };
2595
2596 # submodule/subproject, a commit object reference
2597 sub S_ISGITLINK {
2598         my $mode = shift;
2599
2600         return (($mode & S_IFMT) == S_IFGITLINK)
2601 }
2602
2603 # convert file mode in octal to symbolic file mode string
2604 sub mode_str {
2605         my $mode = oct shift;
2606
2607         if (S_ISGITLINK($mode)) {
2608                 return 'm---------';
2609         } elsif (S_ISDIR($mode & S_IFMT)) {
2610                 return 'drwxr-xr-x';
2611         } elsif (S_ISLNK($mode)) {
2612                 return 'lrwxrwxrwx';
2613         } elsif (S_ISREG($mode)) {
2614                 # git cares only about the executable bit
2615                 if ($mode & S_IXUSR) {
2616                         return '-rwxr-xr-x';
2617                 } else {
2618                         return '-rw-r--r--';
2619                 };
2620         } else {
2621                 return '----------';
2622         }
2623 }
2624
2625 # convert file mode in octal to file type string
2626 sub file_type {
2627         my $mode = shift;
2628
2629         if ($mode !~ m/^[0-7]+$/) {
2630                 return $mode;
2631         } else {
2632                 $mode = oct $mode;
2633         }
2634
2635         if (S_ISGITLINK($mode)) {
2636                 return "submodule";
2637         } elsif (S_ISDIR($mode & S_IFMT)) {
2638                 return "directory";
2639         } elsif (S_ISLNK($mode)) {
2640                 return "symlink";
2641         } elsif (S_ISREG($mode)) {
2642                 return "file";
2643         } else {
2644                 return "unknown";
2645         }
2646 }
2647
2648 # convert file mode in octal to file type description string
2649 sub file_type_long {
2650         my $mode = shift;
2651
2652         if ($mode !~ m/^[0-7]+$/) {
2653                 return $mode;
2654         } else {
2655                 $mode = oct $mode;
2656         }
2657
2658         if (S_ISGITLINK($mode)) {
2659                 return "submodule";
2660         } elsif (S_ISDIR($mode & S_IFMT)) {
2661                 return "directory";
2662         } elsif (S_ISLNK($mode)) {
2663                 return "symlink";
2664         } elsif (S_ISREG($mode)) {
2665                 if ($mode & S_IXUSR) {
2666                         return "executable";
2667                 } else {
2668                         return "file";
2669                 };
2670         } else {
2671                 return "unknown";
2672         }
2673 }
2674
2675
2676 ## ----------------------------------------------------------------------
2677 ## functions returning short HTML fragments, or transforming HTML fragments
2678 ## which don't belong to other sections
2679
2680 # format line of commit message.
2681 sub format_log_line_html {
2682         my $line = shift;
2683
2684         $line = esc_html($line, -nbsp=>1);
2685         $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
2686                 $cgi->a({-href => href(action=>"object", hash=>$1),
2687                                         -class => "text"}, $1);
2688         }eg unless $line =~ /^\s*git-svn-id:/;
2689
2690         return $line;
2691 }
2692
2693 # format marker of refs pointing to given object
2694
2695 # the destination action is chosen based on object type and current context:
2696 # - for annotated tags, we choose the tag view unless it's the current view
2697 #   already, in which case we go to shortlog view
2698 # - for other refs, we keep the current view if we're in history, shortlog or
2699 #   log view, and select shortlog otherwise
2700 sub format_ref_marker {
2701         my ($refs, $id) = @_;
2702         my $markers = '';
2703
2704         if (defined $refs->{$id}) {
2705                 foreach my $ref (@{$refs->{$id}}) {
2706                         # this code exploits the fact that non-lightweight tags are the
2707                         # only indirect objects, and that they are the only objects for which
2708                         # we want to use tag instead of shortlog as action
2709                         my ($type, $name) = qw();
2710                         my $indirect = ($ref =~ s/\^\{\}$//);
2711                         # e.g. tags/v2.6.11 or heads/next
2712                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2713                                 $type = $1;
2714                                 $name = $2;
2715                         } else {
2716                                 $type = "ref";
2717                                 $name = $ref;
2718                         }
2719
2720                         my $class = $type;
2721                         $class .= " indirect" if $indirect;
2722
2723                         my $dest_action = "shortlog";
2724
2725                         if ($indirect) {
2726                                 $dest_action = "tag" unless $action eq "tag";
2727                         } elsif ($action =~ /^(history|(short)?log)$/) {
2728                                 $dest_action = $action;
2729                         }
2730
2731                         my $dest = "";
2732                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2733                         $dest .= $ref;
2734
2735                         my $link = $cgi->a({
2736                                 -href => href(
2737                                         action=>$dest_action,
2738                                         hash=>$dest
2739                                 )}, $name);
2740
2741                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2742                                 $link . "</span>";
2743                 }
2744         }
2745
2746         if ($markers) {
2747                 return '<span class="refs">'. $markers . '</span>';
2748         } else {
2749                 return "";
2750         }
2751 }
2752
2753 # format, perhaps shortened and with markers, title line
2754 sub format_subject_html {
2755         my ($long, $short, $href, $extra) = @_;
2756         $extra = '' unless defined($extra);
2757
2758         if (length($short) < length($long)) {
2759                 use bytes;
2760                 $long =~ s/[[:cntrl:]]/?/g;
2761                 return $cgi->a({-href => $href, -class => "list subject",
2762                                 -title => to_utf8($long)},
2763                        esc_html($short)) . $extra;
2764         } else {
2765                 return $cgi->a({-href => $href, -class => "list subject"},
2766                        esc_html($long)) . $extra;
2767         }
2768 }
2769
2770 # Rather than recomputing the url for an email multiple times, we cache it
2771 # after the first hit. This gives a visible benefit in views where the avatar
2772 # for the same email is used repeatedly (e.g. shortlog).
2773 # The cache is shared by all avatar engines (currently gravatar only), which
2774 # are free to use it as preferred. Since only one avatar engine is used for any
2775 # given page, there's no risk for cache conflicts.
2776 our %avatar_cache = ();
2777
2778 # Compute the picon url for a given email, by using the picon search service over at
2779 # http://www.cs.indiana.edu/picons/search.html
2780 sub picon_url {
2781         my $email = lc shift;
2782         if (!$avatar_cache{$email}) {
2783                 my ($user, $domain) = split('@', $email);
2784                 $avatar_cache{$email} =
2785                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2786                         "$domain/$user/" .
2787                         "users+domains+unknown/up/single";
2788         }
2789         return $avatar_cache{$email};
2790 }
2791
2792 # Compute the gravatar url for a given email, if it's not in the cache already.
2793 # Gravatar stores only the part of the URL before the size, since that's the
2794 # one computationally more expensive. This also allows reuse of the cache for
2795 # different sizes (for this particular engine).
2796 sub gravatar_url {
2797         my $email = lc shift;
2798         my $size = shift;
2799         $avatar_cache{$email} ||=
2800                 "//www.gravatar.com/avatar/" .
2801                         Digest::MD5::md5_hex($email) . "?s=";
2802         return $avatar_cache{$email} . $size;
2803 }
2804
2805 # Insert an avatar for the given $email at the given $size if the feature
2806 # is enabled.
2807 sub git_get_avatar {
2808         my ($email, %opts) = @_;
2809         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2810         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2811         $opts{-size} ||= 'default';
2812         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2813         my $url = "";
2814         if ($git_avatar eq 'gravatar') {
2815                 $url = gravatar_url($email, $size);
2816         } elsif ($git_avatar eq 'picon') {
2817                 $url = picon_url($email);
2818         }
2819         # Other providers can be added by extending the if chain, defining $url
2820         # as needed. If no variant puts something in $url, we assume avatars
2821         # are completely disabled/unavailable.
2822         if ($url) {
2823                 return $pre_white .
2824                        "<img width=\"$size\" " .
2825                             "class=\"avatar\" " .
2826                             "src=\"".esc_url($url)."\" " .
2827                             "alt=\"\" " .
2828                        "/>" . $post_white;
2829         } else {
2830                 return "";
2831         }
2832 }
2833
2834 sub format_search_author {
2835         my ($author, $searchtype, $displaytext) = @_;
2836         my $have_search = gitweb_check_feature('search');
2837
2838         if ($have_search) {
2839                 my $performed = "";
2840                 if ($searchtype eq 'author') {
2841                         $performed = "authored";
2842                 } elsif ($searchtype eq 'committer') {
2843                         $performed = "committed";
2844                 }
2845
2846                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2847                                 searchtext=>$author,
2848                                 searchtype=>$searchtype), class=>"list",
2849                                 title=>"Search for commits $performed by $author"},
2850                                 $displaytext);
2851
2852         } else {
2853                 return $displaytext;
2854         }
2855 }
2856
2857 # format the author name of the given commit with the given tag
2858 # the author name is chopped and escaped according to the other
2859 # optional parameters (see chop_str).
2860 sub format_author_html {
2861         my $tag = shift;
2862         my $co = shift;
2863         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2864         return "<$tag class=\"author\">" .
2865                format_search_author($co->{'author_name'}, "author",
2866                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2867                        $author) .
2868                "</$tag>";
2869 }
2870
2871 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2872 sub format_git_diff_header_line {
2873         my $line = shift;
2874         my $diffinfo = shift;
2875         my ($from, $to) = @_;
2876
2877         if ($diffinfo->{'nparents'}) {
2878                 # combined diff
2879                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2880                 if ($to->{'href'}) {
2881                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2882                                          esc_path($to->{'file'}));
2883                 } else { # file was deleted (no href)
2884                         $line .= esc_path($to->{'file'});
2885                 }
2886         } else {
2887                 # "ordinary" diff
2888                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2889                 if ($from->{'href'}) {
2890                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2891                                          'a/' . esc_path($from->{'file'}));
2892                 } else { # file was added (no href)
2893                         $line .= 'a/' . esc_path($from->{'file'});
2894                 }
2895                 $line .= ' ';
2896                 if ($to->{'href'}) {
2897                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2898                                          'b/' . esc_path($to->{'file'}));
2899                 } else { # file was deleted
2900                         $line .= 'b/' . esc_path($to->{'file'});
2901                 }
2902         }
2903
2904         return "<div class=\"diff header\">$line</div>\n";
2905 }
2906
2907 # format extended diff header line, before patch itself
2908 sub format_extended_diff_header_line {
2909         my $line = shift;
2910         my $diffinfo = shift;
2911         my ($from, $to) = @_;
2912
2913         # match <path>
2914         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2915                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2916                                        esc_path($from->{'file'}));
2917         }
2918         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2919                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2920                                  esc_path($to->{'file'}));
2921         }
2922         # match single <mode>
2923         if ($line =~ m/\s(\d{6})$/) {
2924                 $line .= '<span class="info"> (' .
2925                          file_type_long($1) .
2926                          ')</span>';
2927         }
2928         # match <hash>
2929         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2930                 # can match only for combined diff
2931                 $line = 'index ';
2932                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2933                         if ($from->{'href'}[$i]) {
2934                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
2935                                                   -class=>"hash"},
2936                                                  substr($diffinfo->{'from_id'}[$i],0,7));
2937                         } else {
2938                                 $line .= '0' x 7;
2939                         }
2940                         # separator
2941                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
2942                 }
2943                 $line .= '..';
2944                 if ($to->{'href'}) {
2945                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2946                                          substr($diffinfo->{'to_id'},0,7));
2947                 } else {
2948                         $line .= '0' x 7;
2949                 }
2950
2951         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
2952                 # can match only for ordinary diff
2953                 my ($from_link, $to_link);
2954                 if ($from->{'href'}) {
2955                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
2956                                              substr($diffinfo->{'from_id'},0,7));
2957                 } else {
2958                         $from_link = '0' x 7;
2959                 }
2960                 if ($to->{'href'}) {
2961                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2962                                            substr($diffinfo->{'to_id'},0,7));
2963                 } else {
2964                         $to_link = '0' x 7;
2965                 }
2966                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
2967                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
2968         }
2969
2970         return $line . "<br/>\n";
2971 }
2972
2973 # format from-file/to-file diff header
2974 sub format_diff_from_to_header {
2975         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
2976         my $line;
2977         my $result = '';
2978
2979         $line = $from_line;
2980         #assert($line =~ m/^---/) if DEBUG;
2981         # no extra formatting for "^--- /dev/null"
2982         if (! $diffinfo->{'nparents'}) {
2983                 # ordinary (single parent) diff
2984                 if ($line =~ m!^--- "?a/!) {
2985                         if ($from->{'href'}) {
2986                                 $line = '--- a/' .
2987                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2988                                                 esc_path($from->{'file'}));
2989                         } else {
2990                                 $line = '--- a/' .
2991                                         esc_path($from->{'file'});
2992                         }
2993                 }
2994                 $result .= qq!<div class="diff from_file">$line</div>\n!;
2995
2996         } else {
2997                 # combined diff (merge commit)
2998                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2999                         if ($from->{'href'}[$i]) {
3000                                 $line = '--- ' .
3001                                         $cgi->a({-href=>href(action=>"blobdiff",
3002                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3003                                                              hash_parent_base=>$parents[$i],
3004                                                              file_parent=>$from->{'file'}[$i],
3005                                                              hash=>$diffinfo->{'to_id'},
3006                                                              hash_base=>$hash,
3007                                                              file_name=>$to->{'file'}),
3008                                                  -class=>"path",
3009                                                  -title=>"diff" . ($i+1)},
3010                                                 $i+1) .
3011                                         '/' .
3012                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3013                                                 esc_path($from->{'file'}[$i]));
3014                         } else {
3015                                 $line = '--- /dev/null';
3016                         }
3017                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3018                 }
3019         }
3020
3021         $line = $to_line;
3022         #assert($line =~ m/^\+\+\+/) if DEBUG;
3023         # no extra formatting for "^+++ /dev/null"
3024         if ($line =~ m!^\+\+\+ "?b/!) {
3025                 if ($to->{'href'}) {
3026                         $line = '+++ b/' .
3027                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3028                                         esc_path($to->{'file'}));
3029                 } else {
3030                         $line = '+++ b/' .
3031                                 esc_path($to->{'file'});
3032                 }
3033         }
3034         $result .= qq!<div class="diff to_file">$line</div>\n!;
3035
3036         return $result;
3037 }
3038
3039 # create note for patch simplified by combined diff
3040 sub format_diff_cc_simplified {
3041         my ($diffinfo, @parents) = @_;
3042         my $result = '';
3043
3044         $result .= "<div class=\"diff header\">" .
3045                    "diff --cc ";
3046         if (!is_deleted($diffinfo)) {
3047                 $result .= $cgi->a({-href => href(action=>"blob",
3048                                                   hash_base=>$hash,
3049                                                   hash=>$diffinfo->{'to_id'},
3050                                                   file_name=>$diffinfo->{'to_file'}),
3051                                     -class => "path"},
3052                                    esc_path($diffinfo->{'to_file'}));
3053         } else {
3054                 $result .= esc_path($diffinfo->{'to_file'});
3055         }
3056         $result .= "</div>\n" . # class="diff header"
3057                    "<div class=\"diff nodifferences\">" .
3058                    "Simple merge" .
3059                    "</div>\n"; # class="diff nodifferences"
3060
3061         return $result;
3062 }
3063
3064 sub diff_line_class {
3065         my ($line, $from, $to) = @_;
3066
3067         # ordinary diff
3068         my $num_sign = 1;
3069         # combined diff
3070         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3071                 $num_sign = scalar @{$from->{'href'}};
3072         }
3073
3074         my @diff_line_classifier = (
3075                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3076                 { regexp => qr/^\\/,               class => "incomplete"  },
3077                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3078                 # classifier for context must come before classifier add/rem,
3079                 # or we would have to use more complicated regexp, for example
3080                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3081                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3082                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3083         );
3084         for my $clsfy (@diff_line_classifier) {
3085                 return $clsfy->{'class'}
3086                         if ($line =~ $clsfy->{'regexp'});
3087         }
3088
3089         # fallback
3090         return "";
3091 }
3092
3093 # assumes that $from and $to are defined and correctly filled,
3094 # and that $line holds a line of chunk header for unified diff
3095 sub format_unidiff_chunk_header {
3096         my ($line, $from, $to) = @_;
3097
3098         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3099                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3100
3101         $from_lines = 0 unless defined $from_lines;
3102         $to_lines   = 0 unless defined $to_lines;
3103
3104         if ($from->{'href'}) {
3105                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3106                                      -class=>"list"}, $from_text);
3107         }
3108         if ($to->{'href'}) {
3109                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3110                                      -class=>"list"}, $to_text);
3111         }
3112         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3113                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3114         return $line;
3115 }
3116
3117 # assumes that $from and $to are defined and correctly filled,
3118 # and that $line holds a line of chunk header for combined diff
3119 sub format_cc_diff_chunk_header {
3120         my ($line, $from, $to) = @_;
3121
3122         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3123         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3124
3125         @from_text = split(' ', $ranges);
3126         for (my $i = 0; $i < @from_text; ++$i) {
3127                 ($from_start[$i], $from_nlines[$i]) =
3128                         (split(',', substr($from_text[$i], 1)), 0);
3129         }
3130
3131         $to_text   = pop @from_text;
3132         $to_start  = pop @from_start;
3133         $to_nlines = pop @from_nlines;
3134
3135         $line = "<span class=\"chunk_info\">$prefix ";
3136         for (my $i = 0; $i < @from_text; ++$i) {
3137                 if ($from->{'href'}[$i]) {
3138                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3139                                           -class=>"list"}, $from_text[$i]);
3140                 } else {
3141                         $line .= $from_text[$i];
3142                 }
3143                 $line .= " ";
3144         }
3145         if ($to->{'href'}) {
3146                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3147                                   -class=>"list"}, $to_text);
3148         } else {
3149                 $line .= $to_text;
3150         }
3151         $line .= " $prefix</span>" .
3152                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3153         return $line;
3154 }
3155
3156 # process patch (diff) line (not to be used for diff headers),
3157 # returning HTML-formatted (but not wrapped) line.
3158 # If the line is passed as a reference, it is treated as HTML and not
3159 # esc_html()'ed.
3160 sub format_diff_line {
3161         my ($line, $diff_class, $from, $to) = @_;
3162
3163         if (ref($line)) {
3164                 $line = $$line;
3165         } else {
3166                 chomp $line;
3167                 $line = untabify($line);
3168
3169                 if ($from && $to && $line =~ m/^\@{2} /) {
3170                         $line = format_unidiff_chunk_header($line, $from, $to);
3171                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3172                         $line = format_cc_diff_chunk_header($line, $from, $to);
3173                 } else {
3174                         $line = esc_html($line, -nbsp=>1);
3175                 }
3176         }
3177
3178         my $diff_classes = "diff diff_body";
3179         $diff_classes .= " $diff_class" if ($diff_class);
3180         $line = "<div class=\"$diff_classes\">$line</div>\n";
3181
3182         return $line;
3183 }
3184
3185 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3186 # linked.  Pass the hash of the tree/commit to snapshot.
3187 sub format_snapshot_links {
3188         my ($hash) = @_;
3189         my $num_fmts = @snapshot_fmts;
3190         if ($num_fmts > 1) {
3191                 # A parenthesized list of links bearing format names.
3192                 # e.g. "snapshot (_tar.gz_ _zip_)"
3193                 return "snapshot (" . join(' ', map
3194                         $cgi->a({
3195                                 -href => href(
3196                                         action=>"snapshot",
3197                                         hash=>$hash,
3198                                         snapshot_format=>$_
3199                                 )
3200                         }, $known_snapshot_formats{$_}{'display'})
3201                 , @snapshot_fmts) . ")";
3202         } elsif ($num_fmts == 1) {
3203                 # A single "snapshot" link whose tooltip bears the format name.
3204                 # i.e. "_snapshot_"
3205                 my ($fmt) = @snapshot_fmts;
3206                 return
3207                         $cgi->a({
3208                                 -href => href(
3209                                         action=>"snapshot",
3210                                         hash=>$hash,
3211                                         snapshot_format=>$fmt
3212                                 ),
3213                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3214                         }, "snapshot");
3215         } else { # $num_fmts == 0
3216                 return undef;
3217         }
3218 }
3219
3220 ## ......................................................................
3221 ## functions returning values to be passed, perhaps after some
3222 ## transformation, to other functions; e.g. returning arguments to href()
3223
3224 # returns hash to be passed to href to generate gitweb URL
3225 # in -title key it returns description of link
3226 sub get_feed_info {
3227         my $format = shift || 'Atom';
3228         my %res = (action => lc($format));
3229         my $matched_ref = 0;
3230
3231         # feed links are possible only for project views
3232         return unless (defined $project);
3233         # some views should link to OPML, or to generic project feed,
3234         # or don't have specific feed yet (so they should use generic)
3235         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3236
3237         my $branch = undef;
3238         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3239         # (fullname) to differentiate from tag links; this also makes
3240         # possible to detect branch links
3241         for my $ref (get_branch_refs()) {
3242                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3243                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3244                         $branch = $1;
3245                         $matched_ref = $ref;
3246                         last;
3247                 }
3248         }
3249         # find log type for feed description (title)
3250         my $type = 'log';
3251         if (defined $file_name) {
3252                 $type  = "history of $file_name";
3253                 $type .= "/" if ($action eq 'tree');
3254                 $type .= " on '$branch'" if (defined $branch);
3255         } else {
3256                 $type = "log of $branch" if (defined $branch);
3257         }
3258
3259         $res{-title} = $type;
3260         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3261         $res{'file_name'} = $file_name;
3262
3263         return %res;
3264 }
3265
3266 ## ----------------------------------------------------------------------
3267 ## git utility subroutines, invoking git commands
3268
3269 # returns path to the core git executable and the --git-dir parameter as list
3270 sub git_cmd {
3271         $number_of_git_cmds++;
3272         return $GIT, '--git-dir='.$git_dir;
3273 }
3274
3275 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3276 sub cmd_pipe {
3277
3278         # In order to be compatible with FCGI mode we must use POSIX
3279         # and access the STDERR_FILENO file descriptor directly
3280
3281         use POSIX qw(STDERR_FILENO dup dup2);
3282
3283         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3284         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3285         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3286         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3287         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3288         my $result = open(my $fd, "-|", @_);
3289         $dup2ok = dup2($saveerr, STDERR_FILENO);
3290         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3291         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3292
3293         return $result ? $fd : undef;
3294 }
3295
3296 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3297 sub git_cmd_pipe {
3298         return cmd_pipe git_cmd(), @_;
3299 }
3300
3301 # quote the given arguments for passing them to the shell
3302 # quote_command("command", "arg 1", "arg with ' and ! characters")
3303 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3304 # Try to avoid using this function wherever possible.
3305 sub quote_command {
3306         return join(' ',
3307                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3308 }
3309
3310 # get HEAD ref of given project as hash
3311 sub git_get_head_hash {
3312         return git_get_full_hash(shift, 'HEAD');
3313 }
3314
3315 sub git_get_full_hash {
3316         return git_get_hash(@_);
3317 }
3318
3319 sub git_get_short_hash {
3320         return git_get_hash(@_, '--short=7');
3321 }
3322
3323 sub git_get_hash {
3324         my ($project, $hash, @options) = @_;
3325         my $o_git_dir = $git_dir;
3326         my $retval = undef;
3327         $git_dir = "$projectroot/$project";
3328         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3329             '--verify', '-q', @options, $hash)) {
3330                 $retval = <$fd>;
3331                 chomp $retval if defined $retval;
3332                 close $fd;
3333         }
3334         if (defined $o_git_dir) {
3335                 $git_dir = $o_git_dir;
3336         }
3337         return $retval;
3338 }
3339
3340 # get type of given object
3341 sub git_get_type {
3342         my $hash = shift;
3343
3344         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3345         my $type = <$fd>;
3346         close $fd or return;
3347         chomp $type;
3348         return $type;
3349 }
3350
3351 # repository configuration
3352 our $config_file = '';
3353 our %config;
3354
3355 # store multiple values for single key as anonymous array reference
3356 # single values stored directly in the hash, not as [ <value> ]
3357 sub hash_set_multi {
3358         my ($hash, $key, $value) = @_;
3359
3360         if (!exists $hash->{$key}) {
3361                 $hash->{$key} = $value;
3362         } elsif (!ref $hash->{$key}) {
3363                 $hash->{$key} = [ $hash->{$key}, $value ];
3364         } else {
3365                 push @{$hash->{$key}}, $value;
3366         }
3367 }
3368
3369 # return hash of git project configuration
3370 # optionally limited to some section, e.g. 'gitweb'
3371 sub git_parse_project_config {
3372         my $section_regexp = shift;
3373         my %config;
3374
3375         local $/ = "\0";
3376
3377         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3378                 or return;
3379
3380         while (my $keyval = to_utf8(scalar <$fh>)) {
3381                 chomp $keyval;
3382                 my ($key, $value) = split(/\n/, $keyval, 2);
3383
3384                 hash_set_multi(\%config, $key, $value)
3385                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3386         }
3387         close $fh;
3388
3389         return %config;
3390 }
3391
3392 # convert config value to boolean: 'true' or 'false'
3393 # no value, number > 0, 'true' and 'yes' values are true
3394 # rest of values are treated as false (never as error)
3395 sub config_to_bool {
3396         my $val = shift;
3397
3398         return 1 if !defined $val;             # section.key
3399
3400         # strip leading and trailing whitespace
3401         $val =~ s/^\s+//;
3402         $val =~ s/\s+$//;
3403
3404         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3405                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3406 }
3407
3408 # convert config value to simple decimal number
3409 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3410 # to be multiplied by 1024, 1048576, or 1073741824
3411 sub config_to_int {
3412         my $val = shift;
3413
3414         # strip leading and trailing whitespace
3415         $val =~ s/^\s+//;
3416         $val =~ s/\s+$//;
3417
3418         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3419                 $unit = lc($unit);
3420                 # unknown unit is treated as 1
3421                 return $num * ($unit eq 'g' ? 1073741824 :
3422                                $unit eq 'm' ?    1048576 :
3423                                $unit eq 'k' ?       1024 : 1);
3424         }
3425         return $val;
3426 }
3427
3428 # convert config value to array reference, if needed
3429 sub config_to_multi {
3430         my $val = shift;
3431
3432         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3433 }
3434
3435 sub git_get_project_config {
3436         my ($key, $type) = @_;
3437
3438         return unless defined $git_dir;
3439
3440         # key sanity check
3441         return unless ($key);
3442         # only subsection, if exists, is case sensitive,
3443         # and not lowercased by 'git config -z -l'
3444         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3445                 $lo =~ s/_//g;
3446                 $key = join(".", lc($hi), $mi, lc($lo));
3447                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3448         } else {
3449                 $key = lc($key);
3450                 $key =~ s/_//g;
3451                 return if ($key =~ /\W/);
3452         }
3453         $key =~ s/^gitweb\.//;
3454
3455         # type sanity check
3456         if (defined $type) {
3457                 $type =~ s/^--//;
3458                 $type = undef
3459                         unless ($type eq 'bool' || $type eq 'int');
3460         }
3461
3462         # get config
3463         if (!defined $config_file ||
3464             $config_file ne "$git_dir/config") {
3465                 %config = git_parse_project_config('gitweb');
3466                 $config_file = "$git_dir/config";
3467         }
3468
3469         # check if config variable (key) exists
3470         return unless exists $config{"gitweb.$key"};
3471
3472         # ensure given type
3473         if (!defined $type) {
3474                 return $config{"gitweb.$key"};
3475         } elsif ($type eq 'bool') {
3476                 # backward compatibility: 'git config --bool' returns true/false
3477                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3478         } elsif ($type eq 'int') {
3479                 return config_to_int($config{"gitweb.$key"});
3480         }
3481         return $config{"gitweb.$key"};
3482 }
3483
3484 # get hash of given path at given ref
3485 sub git_get_hash_by_path {
3486         my $base = shift;
3487         my $path = shift || return undef;
3488         my $type = shift;
3489
3490         $path =~ s,/+$,,;
3491
3492         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3493                 or die_error(500, "Open git-ls-tree failed");
3494         my $line = to_utf8(scalar <$fd>);
3495         close $fd or return undef;
3496
3497         if (!defined $line) {
3498                 # there is no tree or hash given by $path at $base
3499                 return undef;
3500         }
3501
3502         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3503         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3504         if (defined $type && $type ne $2) {
3505                 # type doesn't match
3506                 return undef;
3507         }
3508         return $3;
3509 }
3510
3511 # get path of entry with given hash at given tree-ish (ref)
3512 # used to get 'from' filename for combined diff (merge commit) for renames
3513 sub git_get_path_by_hash {
3514         my $base = shift || return;
3515         my $hash = shift || return;
3516
3517         local $/ = "\0";
3518
3519         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3520                 or return undef;
3521         while (my $line = to_utf8(scalar <$fd>)) {
3522                 chomp $line;
3523
3524                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3525                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3526                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3527                         close $fd;
3528                         return $1;
3529                 }
3530         }
3531         close $fd;
3532         return undef;
3533 }
3534
3535 ## ......................................................................
3536 ## git utility functions, directly accessing git repository
3537
3538 # get the value of config variable either from file named as the variable
3539 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3540 # configuration variable in the repository config file.
3541 sub git_get_file_or_project_config {
3542         my ($path, $name) = @_;
3543
3544         $git_dir = "$projectroot/$path";
3545         open my $fd, '<', "$git_dir/$name"
3546                 or return git_get_project_config($name);
3547         my $conf = to_utf8(scalar <$fd>);
3548         close $fd;
3549         if (defined $conf) {
3550                 chomp $conf;
3551         }
3552         return $conf;
3553 }
3554
3555 sub git_get_project_description {
3556         my $path = shift;
3557         return git_get_file_or_project_config($path, 'description');
3558 }
3559
3560 sub git_get_project_category {
3561         my $path = shift;
3562         return git_get_file_or_project_config($path, 'category');
3563 }
3564
3565
3566 # supported formats:
3567 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3568 #   - if its contents is a number, use it as tag weight,
3569 #   - otherwise add a tag with weight 1
3570 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3571 #   the same value multiple times increases tag weight
3572 # * `gitweb.ctag' multi-valued repo config variable
3573 sub git_get_project_ctags {
3574         my $project = shift;
3575         my $ctags = {};
3576
3577         $git_dir = "$projectroot/$project";
3578         if (opendir my $dh, "$git_dir/ctags") {
3579                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3580                 foreach my $tagfile (@files) {
3581                         open my $ct, '<', $tagfile
3582                                 or next;
3583                         my $val = <$ct>;
3584                         chomp $val if $val;
3585                         close $ct;
3586
3587                         (my $ctag = $tagfile) =~ s#.*/##;
3588                         $ctag = to_utf8($ctag);
3589                         if ($val =~ /^\d+$/) {
3590                                 $ctags->{$ctag} = $val;
3591                         } else {
3592                                 $ctags->{$ctag} = 1;
3593                         }
3594                 }
3595                 closedir $dh;
3596
3597         } elsif (open my $fh, '<', "$git_dir/ctags") {
3598                 while (my $line = to_utf8(scalar <$fh>)) {
3599                         chomp $line;
3600                         $ctags->{$line}++ if $line;
3601                 }
3602                 close $fh;
3603
3604         } else {
3605                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3606                 foreach my $tag (@$taglist) {
3607                         $ctags->{$tag}++;
3608                 }
3609         }
3610
3611         return $ctags;
3612 }
3613
3614 # return hash, where keys are content tags ('ctags'),
3615 # and values are sum of weights of given tag in every project
3616 sub git_gather_all_ctags {
3617         my $projects = shift;
3618         my $ctags = {};
3619
3620         foreach my $p (@$projects) {
3621                 foreach my $ct (keys %{$p->{'ctags'}}) {
3622                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3623                 }
3624         }
3625
3626         return $ctags;
3627 }
3628
3629 sub git_populate_project_tagcloud {
3630         my ($ctags, $action) = @_;
3631
3632         # First, merge different-cased tags; tags vote on casing
3633         my %ctags_lc;
3634         foreach (keys %$ctags) {
3635                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3636                 if (not $ctags_lc{lc $_}->{topcount}
3637                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3638                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3639                         $ctags_lc{lc $_}->{topname} = $_;
3640                 }
3641         }
3642
3643         my $cloud;
3644         my $matched = $input_params{'ctag_filter'};
3645         if (eval { require HTML::TagCloud; 1; }) {
3646                 $cloud = HTML::TagCloud->new;
3647                 foreach my $ctag (sort keys %ctags_lc) {
3648                         # Pad the title with spaces so that the cloud looks
3649                         # less crammed.
3650                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3651                         $title =~ s/ /&#160;/g;
3652                         $title =~ s/^/&#160;/g;
3653                         $title =~ s/$/&#160;/g;
3654                         if (defined $matched && $matched eq $ctag) {
3655                                 $title = qq(<span class="match">$title</span>);
3656                         }
3657                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3658                                     $ctags_lc{$ctag}->{count});
3659                 }
3660         } else {
3661                 $cloud = {};
3662                 foreach my $ctag (keys %ctags_lc) {
3663                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3664                         if (defined $matched && $matched eq $ctag) {
3665                                 $title = qq(<span class="match">$title</span>);
3666                         }
3667                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3668                         $cloud->{$ctag}{ctag} =
3669                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3670                 }
3671         }
3672         return $cloud;
3673 }
3674
3675 sub git_show_project_tagcloud {
3676         my ($cloud, $count) = @_;
3677         if (ref $cloud eq 'HTML::TagCloud') {
3678                 return $cloud->html_and_css($count);
3679         } else {
3680                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3681                 return
3682                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3683                         join (', ', map {
3684                                 $cloud->{$_}->{'ctag'}
3685                         } splice(@tags, 0, $count)) .
3686                         '</div>';
3687         }
3688 }
3689
3690 sub git_get_project_url_list {
3691         my $path = shift;
3692
3693         $git_dir = "$projectroot/$path";
3694         open my $fd, '<', "$git_dir/cloneurl"
3695                 or return wantarray ?
3696                 @{ config_to_multi(git_get_project_config('url')) } :
3697                    config_to_multi(git_get_project_config('url'));
3698         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3699         close $fd;
3700
3701         return wantarray ? @git_project_url_list : \@git_project_url_list;
3702 }
3703
3704 sub git_get_projects_list {
3705         my $filter = shift || '';
3706         my $paranoid = shift;
3707         my @list;
3708
3709         if (-d $projects_list) {
3710                 # search in directory
3711                 my $dir = $projects_list;
3712                 # remove the trailing "/"
3713                 $dir =~ s!/+$!!;
3714                 my $pfxlen = length("$dir");
3715                 my $pfxdepth = ($dir =~ tr!/!!);
3716                 # when filtering, search only given subdirectory
3717                 if ($filter && !$paranoid) {
3718                         $dir .= "/$filter";
3719                         $dir =~ s!/+$!!;
3720                 }
3721
3722                 File::Find::find({
3723                         follow_fast => 1, # follow symbolic links
3724                         follow_skip => 2, # ignore duplicates
3725                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3726                         wanted => sub {
3727                                 # global variables
3728                                 our $project_maxdepth;
3729                                 our $projectroot;
3730                                 # skip project-list toplevel, if we get it.
3731                                 return if (m!^[/.]$!);
3732                                 # only directories can be git repositories
3733                                 return unless (-d $_);
3734                                 # don't traverse too deep (Find is super slow on os x)
3735                                 # $project_maxdepth excludes depth of $projectroot
3736                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3737                                         $File::Find::prune = 1;
3738                                         return;
3739                                 }
3740
3741                                 my $path = substr($File::Find::name, $pfxlen + 1);
3742                                 # paranoidly only filter here
3743                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3744                                         next;
3745                                 }
3746                                 # we check related file in $projectroot
3747                                 if (check_export_ok("$projectroot/$path")) {
3748                                         push @list, { path => $path };
3749                                         $File::Find::prune = 1;
3750                                 }
3751                         },
3752                 }, "$dir");
3753
3754         } elsif (-f $projects_list) {
3755                 # read from file(url-encoded):
3756                 # 'git%2Fgit.git Linus+Torvalds'
3757                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3758                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3759                 open my $fd, '<', $projects_list or return;
3760         PROJECT:
3761                 while (my $line = <$fd>) {
3762                         chomp $line;
3763                         my ($path, $owner) = split ' ', $line;
3764                         $path = unescape($path);
3765                         $owner = unescape($owner);
3766                         if (!defined $path) {
3767                                 next;
3768                         }
3769                         # if $filter is rpovided, check if $path begins with $filter
3770                         if ($filter && $path !~ m!^\Q$filter\E/!) {
3771                                 next;
3772                         }
3773                         if (check_export_ok("$projectroot/$path")) {
3774                                 my $pr = {
3775                                         path => $path
3776                                 };
3777                                 if ($owner) {
3778                                         $pr->{'owner'} = to_utf8($owner);
3779                                 }
3780                                 push @list, $pr;
3781                         }
3782                 }
3783                 close $fd;
3784         }
3785         return @list;
3786 }
3787
3788 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3789 # as side effects it sets 'forks' field to list of forks for forked projects
3790 sub filter_forks_from_projects_list {
3791         my $projects = shift;
3792
3793         my %trie; # prefix tree of directories (path components)
3794         # generate trie out of those directories that might contain forks
3795         foreach my $pr (@$projects) {
3796                 my $path = $pr->{'path'};
3797                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3798                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3799                 next unless ($path);      # skip '.git' repository: tests, git-instaweb
3800                 next unless (-d "$projectroot/$path"); # containing directory exists
3801                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3802
3803                 # add to trie
3804                 my @dirs = split('/', $path);
3805                 # walk the trie, until either runs out of components or out of trie
3806                 my $ref = \%trie;
3807                 while (scalar @dirs &&
3808                        exists($ref->{$dirs[0]})) {
3809                         $ref = $ref->{shift @dirs};
3810                 }
3811                 # create rest of trie structure from rest of components
3812                 foreach my $dir (@dirs) {
3813                         $ref = $ref->{$dir} = {};
3814                 }
3815                 # create end marker, store $pr as a data
3816                 $ref->{''} = $pr if (!exists $ref->{''});
3817         }
3818
3819         # filter out forks, by finding shortest prefix match for paths
3820         my @filtered;
3821  PROJECT:
3822         foreach my $pr (@$projects) {
3823                 # trie lookup
3824                 my $ref = \%trie;
3825         DIR:
3826                 foreach my $dir (split('/', $pr->{'path'})) {
3827                         if (exists $ref->{''}) {
3828                                 # found [shortest] prefix, is a fork - skip it
3829                                 push @{$ref->{''}{'forks'}}, $pr;
3830                                 next PROJECT;
3831                         }
3832                         if (!exists $ref->{$dir}) {
3833                                 # not in trie, cannot have prefix, not a fork
3834                                 push @filtered, $pr;
3835                                 next PROJECT;
3836                         }
3837                         # If the dir is there, we just walk one step down the trie.
3838                         $ref = $ref->{$dir};
3839                 }
3840                 # we ran out of trie
3841                 # (shouldn't happen: it's either no match, or end marker)
3842                 push @filtered, $pr;
3843         }
3844
3845         return @filtered;
3846 }
3847
3848 # note: fill_project_list_info must be run first,
3849 # for 'descr_long' and 'ctags' to be filled
3850 sub search_projects_list {
3851         my ($projlist, %opts) = @_;
3852         my $tagfilter  = $opts{'tagfilter'};
3853         my $search_re = $opts{'search_regexp'};
3854
3855         return @$projlist
3856                 unless ($tagfilter || $search_re);
3857
3858         # searching projects require filling to be run before it;
3859         fill_project_list_info($projlist,
3860                                $tagfilter  ? 'ctags' : (),
3861                                $search_re ? ('path', 'descr') : ());
3862         my @projects;
3863  PROJECT:
3864         foreach my $pr (@$projlist) {
3865
3866                 if ($tagfilter) {
3867                         next unless ref($pr->{'ctags'}) eq 'HASH';
3868                         next unless
3869                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3870                 }
3871
3872                 if ($search_re) {
3873                         my $path = $pr->{'path'};
3874                         $path =~ s/\.git$//; # should not be included in search
3875                         next unless
3876                                 $path =~ /$search_re/ ||
3877                                 $pr->{'descr_long'} =~ /$search_re/;
3878                 }
3879
3880                 push @projects, $pr;
3881         }
3882
3883         return @projects;
3884 }
3885
3886 our $gitweb_project_owner = undef;
3887 sub git_get_project_list_from_file {
3888
3889         return if (defined $gitweb_project_owner);
3890
3891         $gitweb_project_owner = {};
3892         # read from file (url-encoded):
3893         # 'git%2Fgit.git Linus+Torvalds'
3894         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3895         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3896         if (-f $projects_list) {
3897                 open(my $fd, '<', $projects_list);
3898                 while (my $line = <$fd>) {
3899                         chomp $line;
3900                         my ($pr, $ow) = split ' ', $line;
3901                         $pr = unescape($pr);
3902                         $ow = unescape($ow);
3903                         $gitweb_project_owner->{$pr} = to_utf8($ow);
3904                 }
3905                 close $fd;
3906         }
3907 }
3908
3909 sub git_get_project_owner {
3910         my $proj = shift;
3911         my $owner;
3912
3913         return undef unless $proj;
3914         $git_dir = "$projectroot/$proj";
3915
3916         if (defined $project && $proj eq $project) {
3917                 $owner = git_get_project_config('owner');
3918         }
3919         if (!defined $owner && !defined $gitweb_project_owner) {
3920                 git_get_project_list_from_file();
3921         }
3922         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
3923                 $owner = $gitweb_project_owner->{$proj};
3924         }
3925         if (!defined $owner && (!defined $project || $proj ne $project)) {
3926                 $owner = git_get_project_config('owner');
3927         }
3928         if (!defined $owner) {
3929                 $owner = get_file_owner("$git_dir");
3930         }
3931
3932         return $owner;
3933 }
3934
3935 sub parse_activity_date {
3936         my $dstr = shift;
3937
3938         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
3939                 # Unix timestamp
3940                 return 0 + $1;
3941         }
3942         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
3943                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
3944                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
3945                 defined($z) && $z ne '' or $z = 'Z';
3946                 $z =~ s/://;
3947                 substr($z,1,0) = '0' if length($z) == 4;
3948                 my $off = 0;
3949                 if (uc($z) ne 'Z') {
3950                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
3951                         $off = -$off if substr($z,0,1) eq '-';
3952                 }
3953                 return $seconds - $off;
3954         }
3955         return undef;
3956 }
3957
3958 # If $quick is true only look at $lastactivity_file
3959 sub git_get_last_activity {
3960         my ($path, $quick) = @_;
3961         my $fd;
3962
3963         $git_dir = "$projectroot/$path";
3964         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
3965                 my $activity = <$fd>;
3966                 close $fd;
3967                 return (undef) unless defined $activity;
3968                 chomp $activity;
3969                 return (undef) if $activity eq '';
3970                 if (my $timestamp = parse_activity_date($activity)) {
3971                         return ($timestamp);
3972                 }
3973         }
3974         return (undef) if $quick;
3975         defined($fd = git_cmd_pipe 'for-each-ref',
3976              '--format=%(committer)',
3977              '--sort=-committerdate',
3978              '--count=1',
3979              map { "refs/$_" } get_branch_refs ()) or return;
3980         my $most_recent = <$fd>;
3981         close $fd or return (undef);
3982         if (defined $most_recent &&
3983             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
3984                 my $timestamp = $1;
3985                 return ($timestamp);
3986         }
3987         return (undef);
3988 }
3989
3990 # Implementation note: when a single remote is wanted, we cannot use 'git
3991 # remote show -n' because that command always work (assuming it's a remote URL
3992 # if it's not defined), and we cannot use 'git remote show' because that would
3993 # try to make a network roundtrip. So the only way to find if that particular
3994 # remote is defined is to walk the list provided by 'git remote -v' and stop if
3995 # and when we find what we want.
3996 sub git_get_remotes_list {
3997         my $wanted = shift;
3998         my %remotes = ();
3999
4000         my $fd = git_cmd_pipe 'remote', '-v';
4001         return unless $fd;
4002         while (my $remote = to_utf8(scalar <$fd>)) {
4003                 chomp $remote;
4004                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4005                 next if $wanted and not $remote eq $wanted;
4006                 my ($url, $key) = ($1, $2);
4007
4008                 $remotes{$remote} ||= { 'heads' => [] };
4009                 $remotes{$remote}{$key} = $url;
4010         }
4011         close $fd or return;
4012         return wantarray ? %remotes : \%remotes;
4013 }
4014
4015 # Takes a hash of remotes as first parameter and fills it by adding the
4016 # available remote heads for each of the indicated remotes.
4017 sub fill_remote_heads {
4018         my $remotes = shift;
4019         my @heads = map { "remotes/$_" } keys %$remotes;
4020         my @remoteheads = git_get_heads_list(undef, @heads);
4021         foreach my $remote (keys %$remotes) {
4022                 $remotes->{$remote}{'heads'} = [ grep {
4023                         $_->{'name'} =~ s!^$remote/!!
4024                         } @remoteheads ];
4025         }
4026 }
4027
4028 sub git_get_references {
4029         my $type = shift || "";
4030         my %refs;
4031         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4032         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4033         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4034                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4035                 or return;
4036
4037         while (my $line = to_utf8(scalar <$fd>)) {
4038                 chomp $line;
4039                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4040                         if (defined $refs{$1}) {
4041                                 push @{$refs{$1}}, $2;
4042                         } else {
4043                                 $refs{$1} = [ $2 ];
4044                         }
4045                 }
4046         }
4047         close $fd or return;
4048         return \%refs;
4049 }
4050
4051 sub git_get_rev_name_tags {
4052         my $hash = shift || return undef;
4053
4054         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4055                 or return;
4056         my $name_rev = to_utf8(scalar <$fd>);
4057         close $fd;
4058
4059         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4060                 return $1;
4061         } else {
4062                 # catches also '$hash undefined' output
4063                 return undef;
4064         }
4065 }
4066
4067 ## ----------------------------------------------------------------------
4068 ## parse to hash functions
4069
4070 sub parse_date {
4071         my $epoch = shift;
4072         my $tz = shift || "-0000";
4073
4074         my %date;
4075         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4076         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4077         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4078         $date{'hour'} = $hour;
4079         $date{'minute'} = $min;
4080         $date{'mday'} = $mday;
4081         $date{'day'} = $days[$wday];
4082         $date{'month'} = $months[$mon];
4083         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4084                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4085         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4086                              $mday, $months[$mon], $hour ,$min;
4087         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4088                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4089
4090         my ($tz_sign, $tz_hour, $tz_min) =
4091                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4092         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4093         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4094         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4095         $date{'hour_local'} = $hour;
4096         $date{'minute_local'} = $min;
4097         $date{'mday_local'} = $mday;
4098         $date{'tz_local'} = $tz;
4099         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4100                                   1900+$year, $mon+1, $mday,
4101                                   $hour, $min, $sec, $tz);
4102         return %date;
4103 }
4104
4105 sub parse_file_date {
4106         my $file = shift;
4107         my $mtime = (stat("$projectroot/$project/$file"))[9];
4108         return () unless defined $mtime;
4109         my $tzoffset = timegm((localtime($mtime))[0..5]) - $mtime;
4110         my $tzstring = '+';
4111         if ($tzoffset <= 0) {
4112                 $tzstring = '-';
4113                 $tzoffset *= -1;
4114         }
4115         $tzoffset = int($tzoffset/60);
4116         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
4117         return parse_date($mtime, $tzstring);
4118 }
4119
4120 sub parse_tag {
4121         my $tag_id = shift;
4122         my %tag;
4123         my @comment;
4124
4125         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4126         $tag{'id'} = $tag_id;
4127         while (my $line = to_utf8(scalar <$fd>)) {
4128                 chomp $line;
4129                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4130                         $tag{'object'} = $1;
4131                 } elsif ($line =~ m/^type (.+)$/) {
4132                         $tag{'type'} = $1;
4133                 } elsif ($line =~ m/^tag (.+)$/) {
4134                         $tag{'name'} = $1;
4135                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4136                         $tag{'author'} = $1;
4137                         $tag{'author_epoch'} = $2;
4138                         $tag{'author_tz'} = $3;
4139                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4140                                 $tag{'author_name'}  = $1;
4141                                 $tag{'author_email'} = $2;
4142                         } else {
4143                                 $tag{'author_name'} = $tag{'author'};
4144                         }
4145                 } elsif ($line =~ m/--BEGIN/) {
4146                         push @comment, $line;
4147                         last;
4148                 } elsif ($line eq "") {
4149                         last;
4150                 }
4151         }
4152         push @comment, map(to_utf8($_), <$fd>);
4153         $tag{'comment'} = \@comment;
4154         close $fd or return;
4155         if (!defined $tag{'name'}) {
4156                 return
4157         };
4158         return %tag
4159 }
4160
4161 sub parse_commit_text {
4162         my ($commit_text, $withparents) = @_;
4163         my @commit_lines = split '\n', $commit_text;
4164         my %co;
4165
4166         pop @commit_lines; # Remove '\0'
4167
4168         if (! @commit_lines) {
4169                 return;
4170         }
4171
4172         my $header = shift @commit_lines;
4173         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4174                 return;
4175         }
4176         ($co{'id'}, my @parents) = split ' ', $header;
4177         while (my $line = shift @commit_lines) {
4178                 last if $line eq "\n";
4179                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4180                         $co{'tree'} = $1;
4181                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4182                         push @parents, $1;
4183                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4184                         $co{'author'} = to_utf8($1);
4185                         $co{'author_epoch'} = $2;
4186                         $co{'author_tz'} = $3;
4187                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4188                                 $co{'author_name'}  = $1;
4189                                 $co{'author_email'} = $2;
4190                         } else {
4191                                 $co{'author_name'} = $co{'author'};
4192                         }
4193                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4194                         $co{'committer'} = to_utf8($1);
4195                         $co{'committer_epoch'} = $2;
4196                         $co{'committer_tz'} = $3;
4197                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4198                                 $co{'committer_name'}  = $1;
4199                                 $co{'committer_email'} = $2;
4200                         } else {
4201                                 $co{'committer_name'} = $co{'committer'};
4202                         }
4203                 }
4204         }
4205         if (!defined $co{'tree'}) {
4206                 return;
4207         };
4208         $co{'parents'} = \@parents;
4209         $co{'parent'} = $parents[0];
4210
4211         @commit_lines = map to_utf8($_), @commit_lines;
4212         foreach my $title (@commit_lines) {
4213                 $title =~ s/^    //;
4214                 if ($title ne "") {
4215                         $co{'title'} = chop_str($title, 80, 5);
4216                         # remove leading stuff of merges to make the interesting part visible
4217                         if (length($title) > 50) {
4218                                 $title =~ s/^Automatic //;
4219                                 $title =~ s/^merge (of|with) /Merge ... /i;
4220                                 if (length($title) > 50) {
4221                                         $title =~ s/(http|rsync):\/\///;
4222                                 }
4223                                 if (length($title) > 50) {
4224                                         $title =~ s/(master|www|rsync)\.//;
4225                                 }
4226                                 if (length($title) > 50) {
4227                                         $title =~ s/kernel.org:?//;
4228                                 }
4229                                 if (length($title) > 50) {
4230                                         $title =~ s/\/pub\/scm//;
4231                                 }
4232                         }
4233                         $co{'title_short'} = chop_str($title, 50, 5);
4234                         last;
4235                 }
4236         }
4237         if (! defined $co{'title'} || $co{'title'} eq "") {
4238                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4239         }
4240         # remove added spaces
4241         foreach my $line (@commit_lines) {
4242                 $line =~ s/^    //;
4243         }
4244         $co{'comment'} = \@commit_lines;
4245
4246         my $age_epoch = $co{'committer_epoch'};
4247         $co{'age_epoch'} = $age_epoch;
4248         my $time_now = time;
4249         $co{'age_string'} = age_string($age_epoch, $time_now);
4250         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4251         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4252         return %co;
4253 }
4254
4255 sub parse_commit {
4256         my ($commit_id) = @_;
4257         my %co;
4258
4259         local $/ = "\0";
4260
4261         defined(my $fd = git_cmd_pipe "rev-list",
4262                 "--parents",
4263                 "--header",
4264                 "--max-count=1",
4265                 $commit_id,
4266                 "--")
4267                 or die_error(500, "Open git-rev-list failed");
4268         %co = parse_commit_text(<$fd>, 1);
4269         close $fd;
4270
4271         return %co;
4272 }
4273
4274 sub parse_commits {
4275         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4276         my @cos;
4277
4278         $maxcount ||= 1;
4279         $skip ||= 0;
4280
4281         local $/ = "\0";
4282
4283         defined(my $fd = git_cmd_pipe "rev-list",
4284                 "--header",
4285                 @args,
4286                 ("--max-count=" . $maxcount),
4287                 ("--skip=" . $skip),
4288                 @extra_options,
4289                 $commit_id,
4290                 "--",
4291                 ($filename ? ($filename) : ()))
4292                 or die_error(500, "Open git-rev-list failed");
4293         while (my $line = <$fd>) {
4294                 my %co = parse_commit_text($line);
4295                 push @cos, \%co;
4296         }
4297         close $fd;
4298
4299         return wantarray ? @cos : \@cos;
4300 }
4301
4302 # parse line of git-diff-tree "raw" output
4303 sub parse_difftree_raw_line {
4304         my $line = shift;
4305         my %res;
4306
4307         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4308         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4309         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4310                 $res{'from_mode'} = $1;
4311                 $res{'to_mode'} = $2;
4312                 $res{'from_id'} = $3;
4313                 $res{'to_id'} = $4;
4314                 $res{'status'} = $5;
4315                 $res{'similarity'} = $6;
4316                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4317                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4318                 } else {
4319                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4320                 }
4321         }
4322         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4323         # combined diff (for merge commit)
4324         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4325                 $res{'nparents'}  = length($1);
4326                 $res{'from_mode'} = [ split(' ', $2) ];
4327                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4328                 $res{'from_id'} = [ split(' ', $3) ];
4329                 $res{'to_id'} = pop @{$res{'from_id'}};
4330                 $res{'status'} = [ split('', $4) ];
4331                 $res{'to_file'} = unquote($5);
4332         }
4333         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4334         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4335                 $res{'commit'} = $1;
4336         }
4337
4338         return wantarray ? %res : \%res;
4339 }
4340
4341 # wrapper: return parsed line of git-diff-tree "raw" output
4342 # (the argument might be raw line, or parsed info)
4343 sub parsed_difftree_line {
4344         my $line_or_ref = shift;
4345
4346         if (ref($line_or_ref) eq "HASH") {
4347                 # pre-parsed (or generated by hand)
4348                 return $line_or_ref;
4349         } else {
4350                 return parse_difftree_raw_line($line_or_ref);
4351         }
4352 }
4353
4354 # parse line of git-ls-tree output
4355 sub parse_ls_tree_line {
4356         my $line = shift;
4357         my %opts = @_;
4358         my %res;
4359
4360         if ($opts{'-l'}) {
4361                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4362                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4363
4364                 $res{'mode'} = $1;
4365                 $res{'type'} = $2;
4366                 $res{'hash'} = $3;
4367                 $res{'size'} = $4;
4368                 if ($opts{'-z'}) {
4369                         $res{'name'} = $5;
4370                 } else {
4371                         $res{'name'} = unquote($5);
4372                 }
4373         } else {
4374                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4375                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4376
4377                 $res{'mode'} = $1;
4378                 $res{'type'} = $2;
4379                 $res{'hash'} = $3;
4380                 if ($opts{'-z'}) {
4381                         $res{'name'} = $4;
4382                 } else {
4383                         $res{'name'} = unquote($4);
4384                 }
4385         }
4386
4387         return wantarray ? %res : \%res;
4388 }
4389
4390 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4391 sub parse_from_to_diffinfo {
4392         my ($diffinfo, $from, $to, @parents) = @_;
4393
4394         if ($diffinfo->{'nparents'}) {
4395                 # combined diff
4396                 $from->{'file'} = [];
4397                 $from->{'href'} = [];
4398                 fill_from_file_info($diffinfo, @parents)
4399                         unless exists $diffinfo->{'from_file'};
4400                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4401                         $from->{'file'}[$i] =
4402                                 defined $diffinfo->{'from_file'}[$i] ?
4403                                         $diffinfo->{'from_file'}[$i] :
4404                                         $diffinfo->{'to_file'};
4405                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4406                                 $from->{'href'}[$i] = href(action=>"blob",
4407                                                            hash_base=>$parents[$i],
4408                                                            hash=>$diffinfo->{'from_id'}[$i],
4409                                                            file_name=>$from->{'file'}[$i]);
4410                         } else {
4411                                 $from->{'href'}[$i] = undef;
4412                         }
4413                 }
4414         } else {
4415                 # ordinary (not combined) diff
4416                 $from->{'file'} = $diffinfo->{'from_file'};
4417                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4418                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4419                                                hash=>$diffinfo->{'from_id'},
4420                                                file_name=>$from->{'file'});
4421                 } else {
4422                         delete $from->{'href'};
4423                 }
4424         }
4425
4426         $to->{'file'} = $diffinfo->{'to_file'};
4427         if (!is_deleted($diffinfo)) { # file exists in result
4428                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4429                                      hash=>$diffinfo->{'to_id'},
4430                                      file_name=>$to->{'file'});
4431         } else {
4432                 delete $to->{'href'};
4433         }
4434 }
4435
4436 ## ......................................................................
4437 ## parse to array of hashes functions
4438
4439 sub git_get_heads_list {
4440         my ($limit, @classes) = @_;
4441         @classes = get_branch_refs() unless @classes;
4442         my @patterns = map { "refs/$_" } @classes;
4443         my @headslist;
4444
4445         defined(my $fd = git_cmd_pipe 'for-each-ref',
4446                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4447                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4448                 @patterns)
4449                 or return;
4450         while (my $line = to_utf8(scalar <$fd>)) {
4451                 my %ref_item;
4452
4453                 chomp $line;
4454                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4455                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4456                 my ($committer, $epoch, $tz) =
4457                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4458                 $ref_item{'fullname'}  = $name;
4459                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4460                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4461                 $ref_item{'name'} = $name;
4462                 # for refs neither in 'heads' nor 'remotes' we want to
4463                 # show their ref dir
4464                 my $ref_dir = (defined $1) ? $1 : '';
4465                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4466                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4467                 }
4468
4469                 $ref_item{'id'}    = $hash;
4470                 $ref_item{'title'} = $title || '(no commit message)';
4471                 $ref_item{'epoch'} = $epoch;
4472                 if ($epoch) {
4473                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4474                 } else {
4475                         $ref_item{'age'} = "unknown";
4476                 }
4477
4478                 push @headslist, \%ref_item;
4479         }
4480         close $fd;
4481
4482         return wantarray ? @headslist : \@headslist;
4483 }
4484
4485 sub git_get_tags_list {
4486         my $limit = shift;
4487         my @tagslist;
4488         my $all = shift || 0;
4489         my $order = shift || $default_refs_order;
4490         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4491
4492         defined(my $fd = git_cmd_pipe 'for-each-ref',
4493                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4494                 '--format=%(objectname) %(objecttype) %(refname) '.
4495                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4496                 ($all ? 'refs' : 'refs/tags'))
4497                 or return;
4498         while (my $line = to_utf8(scalar <$fd>)) {
4499                 my %ref_item;
4500
4501                 chomp $line;
4502                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4503                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4504                 my ($creator, $epoch, $tz) =
4505                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4506                 $ref_item{'fullname'} = $name;
4507                 $name =~ s!^refs/!! if $all;
4508                 $name =~ s!^refs/tags/!! unless $all;
4509
4510                 $ref_item{'type'} = $type;
4511                 $ref_item{'id'} = $id;
4512                 $ref_item{'name'} = $name;
4513                 if ($type eq "tag") {
4514                         $ref_item{'subject'} = $title;
4515                         $ref_item{'reftype'} = $reftype;
4516                         $ref_item{'refid'}   = $refid;
4517                 } else {
4518                         $ref_item{'reftype'} = $type;
4519                         $ref_item{'refid'}   = $id;
4520                 }
4521
4522                 if ($type eq "tag" || $type eq "commit") {
4523                         $ref_item{'epoch'} = $epoch;
4524                         if ($epoch) {
4525                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4526                         } else {
4527                                 $ref_item{'age'} = "unknown";
4528                         }
4529                 }
4530
4531                 push @tagslist, \%ref_item;
4532         }
4533         close $fd;
4534
4535         return wantarray ? @tagslist : \@tagslist;
4536 }
4537
4538 ## ----------------------------------------------------------------------
4539 ## filesystem-related functions
4540
4541 sub get_file_owner {
4542         my $path = shift;
4543
4544         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4545         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4546         if (!defined $gcos) {
4547                 return undef;
4548         }
4549         my $owner = $gcos;
4550         $owner =~ s/[,;].*$//;
4551         return to_utf8($owner);
4552 }
4553
4554 # assume that file exists
4555 sub insert_file {
4556         my $filename = shift;
4557
4558         open my $fd, '<', $filename;
4559         while (<$fd>) {
4560                 print to_utf8($_);
4561         }
4562         close $fd;
4563 }
4564
4565 ## ......................................................................
4566 ## mimetype related functions
4567
4568 sub mimetype_guess_file {
4569         my $filename = shift;
4570         my $mimemap = shift;
4571         my $rawmode = shift;
4572         -r $mimemap or return undef;
4573
4574         my %mimemap;
4575         open(my $mh, '<', $mimemap) or return undef;
4576         while (<$mh>) {
4577                 next if m/^#/; # skip comments
4578                 my ($mimetype, @exts) = split(/\s+/);
4579                 foreach my $ext (@exts) {
4580                         $mimemap{$ext} = $mimetype;
4581                 }
4582         }
4583         close($mh);
4584
4585         my ($ext, $ans);
4586         $ext = $1 if $filename =~ /\.([^.]*)$/;
4587         $ans = $mimemap{$ext} if $ext;
4588         if (defined $ans) {
4589                 my $l = lc($ans);
4590                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4591                 if (!$rawmode) {
4592                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4593                                              $l eq 'image/svg+xml' ||
4594                                              $l eq 'application/xml-dtd' ||
4595                                              $l eq 'application/xml-external-parsed-entity';
4596                 }
4597         }
4598         return $ans;
4599 }
4600
4601 sub mimetype_guess {
4602         my $filename = shift;
4603         my $rawmode = shift;
4604         my $mime;
4605         $filename =~ /\./ or return undef;
4606
4607         if ($mimetypes_file) {
4608                 my $file = $mimetypes_file;
4609                 if ($file !~ m!^/!) { # if it is relative path
4610                         # it is relative to project
4611                         $file = "$projectroot/$project/$file";
4612                 }
4613                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4614         }
4615         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4616         return $mime;
4617 }
4618
4619 sub blob_mimetype {
4620         my $fd = shift;
4621         my $filename = shift;
4622         my $rawmode = shift;
4623         my $mime;
4624
4625         # The -T/-B file operators produce the wrong result unless a perlio
4626         # layer is present when the file handle is a pipe that delivers less
4627         # than 512 bytes of data before reaching EOF.
4628         #
4629         # If we are running in a Perl that uses the stdio layer rather than the
4630         # unix+perlio layers we will end up adding a perlio layer on top of the
4631         # stdio layer and get a second level of buffering.  This is harmless
4632         # and it makes the -T/-B file operators work properly in all cases.
4633
4634         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4635                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4636
4637         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4638
4639         if (!$mime && $filename) {
4640                 if ($filename =~ m/\.html?$/i) {
4641                         $mime = 'text/html';
4642                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4643                         $mime = 'text/html';
4644                 } elsif ($filename =~ m/\.te?xt?$/i) {
4645                         $mime = 'text/plain';
4646                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4647                         $mime = 'text/plain';
4648                 } elsif ($filename =~ m/\.png$/i) {
4649                         $mime = 'image/png';
4650                 } elsif ($filename =~ m/\.gif$/i) {
4651                         $mime = 'image/gif';
4652                 } elsif ($filename =~ m/\.jpe?g$/i) {
4653                         $mime = 'image/jpeg';
4654                 } elsif ($filename =~ m/\.svgz?$/i) {
4655                         $mime = 'image/svg+xml';
4656                 }
4657         }
4658
4659         # just in case
4660         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4661
4662         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4663
4664         return $mime;
4665 }
4666
4667 sub is_ascii {
4668         use bytes;
4669         my $data = shift;
4670         return scalar($data =~ /^[\x00-\x7f]*$/);
4671 }
4672
4673 sub is_valid_utf8 {
4674         my $data = shift;
4675         return utf8::decode($data);
4676 }
4677
4678 sub extract_html_charset {
4679         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4680         my $head = $1;
4681         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4682         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) {
4683                 my %kv = (lc($1) => $3, lc($4) => $6);
4684                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4685                 return $1 if $he && $c && $he eq 'content-type' &&
4686                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4687         }
4688         return undef;
4689 }
4690
4691 sub blob_contenttype {
4692         my ($fd, $file_name, $type) = @_;
4693
4694         $type ||= blob_mimetype($fd, $file_name, 1);
4695         return $type unless $type =~ m!^text/.+!i;
4696         my ($leader, $charset, $htmlcharset);
4697         if ($fd && read($fd, $leader, 32768)) {{
4698                 $charset='US-ASCII' if is_ascii($leader);
4699                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4700                 $charset='ISO-8859-1' unless $charset;
4701                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4702                 if ($htmlcharset && $charset ne 'US-ASCII') {
4703                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4704                 }
4705         }}
4706         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4707         my $defcharset = $default_text_plain_charset || '';
4708         $defcharset =~ s/^\s+//;
4709         $defcharset =~ s/\s+$//;
4710         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4711         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4712 }
4713
4714 # peek the first upto 128 bytes off a file handle
4715 sub peek128bytes {
4716         my $fd = shift;
4717
4718         use IO::Handle;
4719         use bytes;
4720
4721         my $prefix128;
4722         return '' unless $fd && read($fd, $prefix128, 128);
4723
4724         # In the general case, we're guaranteed only to be able to ungetc one
4725         # character (provided, of course, we actually got a character first).
4726         #
4727         # However, we know:
4728         #
4729         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4730         #    already been called at least once on the file handle before us
4731         #
4732         # 2) we have an $fd positioned at the start of the input stream and
4733         #    therefore know we were positioned at a buffer boundary before
4734         #    reading the initial upto 128 bytes
4735         #
4736         # 3) the buffer size is at least 512 bytes
4737         #
4738         # 4) we are careful to only unget raw bytes
4739         #
4740         # 5) we are attempting to unget exactly the same number of bytes we got
4741         #
4742         # Given the above conditions we will ALWAYS be able to safely unget
4743         # the $prefix128 value we just got.
4744         #
4745         # In fact, we could read up to 511 bytes and still be sure.
4746         # (Reading 512 might pop us into the next internal buffer, but probably
4747         # not since that could break the always able to unget at least the one
4748         # you just got guarantee.)
4749
4750         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4751
4752         return $prefix128;
4753 }
4754
4755 # guess file syntax for syntax highlighting; return undef if no highlighting
4756 # the name of syntax can (in the future) depend on syntax highlighter used
4757 sub guess_file_syntax {
4758         my ($fd, $mimetype, $file_name) = @_;
4759         return undef unless $fd && defined $file_name &&
4760                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4761         my $basename = basename($file_name, '.in');
4762         return $highlight_basename{$basename}
4763                 if exists $highlight_basename{$basename};
4764
4765         # Peek to see if there's a shebang or xml line.
4766         # We always operate on bytes when testing this.
4767         {
4768                 use bytes;
4769                 my $shebang = peek128bytes($fd);
4770                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4771                         foreach my $key (keys %highlight_shebang) {
4772                                 my $ar = ref($highlight_shebang{$key}) ?
4773                                         $highlight_shebang{$key} :
4774                                         [$highlight_shebang{key}];
4775                                 map {return $key if $shebang =~ /$_/} @$ar;
4776                         }
4777                 }
4778                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4779         }
4780
4781         $basename =~ /\.([^.]*)$/;
4782         my $ext = $1 or return undef;
4783         return $highlight_ext{$ext}
4784                 if exists $highlight_ext{$ext};
4785
4786         return undef;
4787 }
4788
4789 # run highlighter and return FD of its output,
4790 # or return original FD if no highlighting
4791 sub run_highlighter {
4792         my ($fd, $syntax) = @_;
4793         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4794
4795         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4796                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4797                 quote_command($highlight_bin).
4798                 " --replace-tabs=8 --fragment --syntax $syntax")
4799                 or die_error(500, "Couldn't open file or run syntax highlighter");
4800         if (eof $hifd) {
4801                 # just in case, should not happen as we tested !eof($fd) above
4802                 return $fd if close($hifd);
4803
4804                 # should not happen
4805                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4806
4807                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4808                 # instead of dying horribly on this, just skip the highlighting
4809                 # but do output a message about it to STDERR that will end up in the log
4810                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4811                         sprintf("child exit status 0x%x\n", $?);
4812                 return $fd
4813         }
4814         close $fd;
4815         return ($hifd, 1);
4816 }
4817
4818 ## ======================================================================
4819 ## functions printing HTML: header, footer, error page
4820
4821 sub get_page_title {
4822         my $title = to_utf8($site_name);
4823
4824         unless (defined $project) {
4825                 if (defined $project_filter) {
4826                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4827                 }
4828                 return $title;
4829         }
4830         $title .= " - " . to_utf8($project);
4831
4832         return $title unless (defined $action);
4833         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4834         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4835
4836         return $title unless (defined $file_name);
4837         $title .= " - " . esc_path($file_name);
4838         if ($action eq "tree" && $file_name !~ m|/$|) {
4839                 $title .= "/";
4840         }
4841
4842         return $title;
4843 }
4844
4845 sub get_content_type_html {
4846         # We do not ever emit application/xhtml+xml since that gives us
4847         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4848         # strict, which is troublesome for example when showing user-supplied
4849         # README.html files.
4850         return 'text/html';
4851 }
4852
4853 sub print_feed_meta {
4854         if (defined $project) {
4855                 my %href_params = get_feed_info();
4856                 if (!exists $href_params{'-title'}) {
4857                         $href_params{'-title'} = 'log';
4858                 }
4859
4860                 foreach my $format (qw(RSS Atom)) {
4861                         my $type = lc($format);
4862                         my %link_attr = (
4863                                 '-rel' => 'alternate',
4864                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4865                                 '-type' => "application/$type+xml"
4866                         );
4867
4868                         $href_params{'extra_options'} = undef;
4869                         $href_params{'action'} = $type;
4870                         $link_attr{'-href'} = href(%href_params);
4871                         print "<link ".
4872                               "rel=\"$link_attr{'-rel'}\" ".
4873                               "title=\"$link_attr{'-title'}\" ".
4874                               "href=\"$link_attr{'-href'}\" ".
4875                               "type=\"$link_attr{'-type'}\" ".
4876                               "/>\n";
4877
4878                         $href_params{'extra_options'} = '--no-merges';
4879                         $link_attr{'-href'} = href(%href_params);
4880                         $link_attr{'-title'} .= ' (no merges)';
4881                         print "<link ".
4882                               "rel=\"$link_attr{'-rel'}\" ".
4883                               "title=\"$link_attr{'-title'}\" ".
4884                               "href=\"$link_attr{'-href'}\" ".
4885                               "type=\"$link_attr{'-type'}\" ".
4886                               "/>\n";
4887                 }
4888
4889         } else {
4890                 printf('<link rel="alternate" title="%s projects list" '.
4891                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4892                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4893                 printf('<link rel="alternate" title="%s projects feeds" '.
4894                        'href="%s" type="text/x-opml" />'."\n",
4895                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4896         }
4897 }
4898
4899 sub print_header_links {
4900         my $status = shift;
4901
4902         # print out each stylesheet that exist, providing backwards capability
4903         # for those people who defined $stylesheet in a config file
4904         if (defined $stylesheet) {
4905                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4906         } else {
4907                 foreach my $stylesheet (@stylesheets) {
4908                         next unless $stylesheet;
4909                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4910                 }
4911         }
4912         print_feed_meta()
4913                 if ($status eq '200 OK');
4914         if (defined $favicon) {
4915                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4916         }
4917 }
4918
4919 sub print_nav_breadcrumbs_path {
4920         my $dirprefix = undef;
4921         while (my $part = shift) {
4922                 $dirprefix .= "/" if defined $dirprefix;
4923                 $dirprefix .= $part;
4924                 print $cgi->a({-href => href(project => undef,
4925                                              project_filter => $dirprefix,
4926                                              action => "project_list")},
4927                               esc_html($part)) . " / ";
4928         }
4929 }
4930
4931 sub print_nav_breadcrumbs {
4932         my %opts = @_;
4933
4934         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4935                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4936         }
4937         if (defined $project) {
4938                 my @dirname = split '/', $project;
4939                 my $projectbasename = pop @dirname;
4940                 print_nav_breadcrumbs_path(@dirname);
4941                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4942                 if (defined $action) {
4943                         my $action_print = $action ;
4944                         $action_print = 'blame' if $action_print eq 'blame_incremental';
4945                         if (defined $opts{-action_extra}) {
4946                                 $action_print = $cgi->a({-href => href(action=>$action)},
4947                                         $action);
4948                         }
4949                         print " / $action_print";
4950                 }
4951                 if (defined $opts{-action_extra}) {
4952                         print " / $opts{-action_extra}";
4953                 }
4954                 print "\n";
4955         } elsif (defined $project_filter) {
4956                 print_nav_breadcrumbs_path(split '/', $project_filter);
4957         }
4958 }
4959
4960 sub print_search_form {
4961         if (!defined $searchtext) {
4962                 $searchtext = "";
4963         }
4964         my $search_hash;
4965         if (defined $hash_base) {
4966                 $search_hash = $hash_base;
4967         } elsif (defined $hash) {
4968                 $search_hash = $hash;
4969         } else {
4970                 $search_hash = "HEAD";
4971         }
4972         # We can't use href() here because we need to encode the
4973         # URL parameters into the form, not into the action link.
4974         my $action = $my_uri;
4975         my $use_pathinfo = gitweb_check_feature('pathinfo');
4976         if ($use_pathinfo) {
4977                 # See notes about doubled / in href()
4978                 $action =~ s,/$,,;
4979                 $action .= "/".esc_path_info($project);
4980         }
4981         print $cgi->start_form(-method => "get", -action => $action) .
4982               "<div class=\"search\">\n" .
4983               (!$use_pathinfo &&
4984               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
4985               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
4986               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
4987               $cgi->popup_menu(-name => 'st', -default => 'commit',
4988                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
4989               " " . $cgi->a({-href => href(action=>"search_help"),
4990                              -title => "search help" }, "?") . " search:\n",
4991               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
4992               "<span title=\"Extended regular expression\">" .
4993               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
4994                              -checked => $search_use_regexp) .
4995               "</span>" .
4996               "</div>" .
4997               $cgi->end_form() . "\n";
4998 }
4999
5000 sub git_header_html {
5001         my $status = shift || "200 OK";
5002         my $expires = shift;
5003         my %opts = @_;
5004
5005         my $title = get_page_title();
5006         my $content_type = get_content_type_html();
5007         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5008                            -status=> $status, -expires => $expires)
5009                 unless ($opts{'-no_http_header'});
5010         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5011         print <<EOF;
5012 <?xml version="1.0" encoding="utf-8"?>
5013 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5014 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5015 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5016 <!-- git core binaries version $git_version -->
5017 <head>
5018 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5019 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5020 <meta name="robots" content="index, nofollow"/>
5021 <title>$title</title>
5022 <script type="text/javascript">/* <![CDATA[ */
5023 function fixBlameLinks() {
5024         var allLinks = document.getElementsByTagName("a");
5025         for (var i = 0; i < allLinks.length; i++) {
5026                 var link = allLinks.item(i);
5027                 if (link.className == 'blamelink')
5028                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5029         }
5030 }
5031 /* ]]> */</script>
5032 EOF
5033         # the stylesheet, favicon etc urls won't work correctly with path_info
5034         # unless we set the appropriate base URL
5035         if ($ENV{'PATH_INFO'}) {
5036                 print "<base href=\"".esc_url($base_url)."\" />\n";
5037         }
5038         print_header_links($status);
5039
5040         if (defined $site_html_head_string) {
5041                 print to_utf8($site_html_head_string);
5042         }
5043
5044         print "</head>\n" .
5045               "<body>\n";
5046
5047         if (defined $site_header && -f $site_header) {
5048                 insert_file($site_header);
5049         }
5050
5051         print "<div class=\"page_header\">\n";
5052         if (defined $logo) {
5053                 print $cgi->a({-href => esc_url($logo_url),
5054                                -title => $logo_label},
5055                               $cgi->img({-src => esc_url($logo),
5056                                          -width => 72, -height => 27,
5057                                          -alt => "git",
5058                                          -class => "logo"}));
5059         }
5060         print_nav_breadcrumbs(%opts);
5061         print "</div>\n";
5062
5063         my $have_search = gitweb_check_feature('search');
5064         if (defined $project && $have_search) {
5065                 print_search_form();
5066         }
5067 }
5068
5069 sub compute_timed_interval {
5070         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5071         return tv_interval($t0, [ gettimeofday() ]);
5072 }
5073
5074 sub compute_commands_count {
5075         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5076         my $s = $number_of_git_cmds == 1 ? '' : 's';
5077         return '<span id="generating_cmd">'.
5078                 $number_of_git_cmds.
5079                 "</span> git command$s";
5080 }
5081
5082 sub git_footer_html {
5083         my $feed_class = 'rss_logo';
5084
5085         print "<div class=\"page_footer\">\n";
5086         if (defined $project) {
5087                 my $descr = git_get_project_description($project);
5088                 if (defined $descr) {
5089                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5090                 }
5091
5092                 my %href_params = get_feed_info();
5093                 if (!%href_params) {
5094                         $feed_class .= ' generic';
5095                 }
5096                 $href_params{'-title'} ||= 'log';
5097
5098                 foreach my $format (qw(RSS Atom)) {
5099                         $href_params{'action'} = lc($format);
5100                         print $cgi->a({-href => href(%href_params),
5101                                       -title => "$href_params{'-title'} $format feed",
5102                                       -class => $feed_class}, $format)."\n";
5103                 }
5104
5105         } else {
5106                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5107                                              project_filter => $project_filter),
5108                               -class => $feed_class}, "OPML") . " ";
5109                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5110                                              project_filter => $project_filter),
5111                               -class => $feed_class}, "TXT") . "\n";
5112         }
5113         print "</div>\n"; # class="page_footer"
5114
5115         if (defined $t0 && gitweb_check_feature('timed')) {
5116                 print "<div id=\"generating_info\">\n";
5117                 print 'This page took '.
5118                       '<span id="generating_time" class="time_span">'.
5119                       compute_timed_interval().
5120                       ' seconds </span>'.
5121                       ' and '.
5122                       compute_commands_count().
5123                       " to generate.\n";
5124                 print "</div>\n"; # class="page_footer"
5125         }
5126
5127         if (defined $site_footer && -f $site_footer) {
5128                 insert_file($site_footer);
5129         }
5130
5131         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5132         if (defined $action &&
5133             $action eq 'blame_incremental') {
5134                 print qq!<script type="text/javascript">\n!.
5135                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5136                       qq!           "!. href() .qq!");\n!.
5137                       qq!</script>\n!;
5138         } else {
5139                 my ($jstimezone, $tz_cookie, $datetime_class) =
5140                         gitweb_get_feature('javascript-timezone');
5141
5142                 print qq!<script type="text/javascript">\n!.
5143                       qq!window.onload = function () {\n!;
5144                 if (gitweb_check_feature('blame_incremental')) {
5145                         print qq!       fixBlameLinks();\n!;
5146                 }
5147                 if (gitweb_check_feature('javascript-actions')) {
5148                         print qq!       fixLinks();\n!;
5149                 }
5150                 if ($jstimezone && $tz_cookie && $datetime_class) {
5151                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5152                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5153                 }
5154                 print qq!};\n!.
5155                       qq!</script>\n!;
5156         }
5157
5158         print "</body>\n" .
5159               "</html>";
5160 }
5161
5162 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5163 # Example: die_error(404, 'Hash not found')
5164 # By convention, use the following status codes (as defined in RFC 2616):
5165 # 400: Invalid or missing CGI parameters, or
5166 #      requested object exists but has wrong type.
5167 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5168 #      this server or project.
5169 # 404: Requested object/revision/project doesn't exist.
5170 # 500: The server isn't configured properly, or
5171 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5172 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5173 # 503: The server is currently unavailable (because it is overloaded,
5174 #      or down for maintenance).  Generally, this is a temporary state.
5175 sub die_error {
5176         my $status = shift || 500;
5177         my $error = esc_html(shift) || "Internal Server Error";
5178         my $extra = shift;
5179         my %opts = @_;
5180
5181         my %http_responses = (
5182                 400 => '400 Bad Request',
5183                 403 => '403 Forbidden',
5184                 404 => '404 Not Found',
5185                 500 => '500 Internal Server Error',
5186                 503 => '503 Service Unavailable',
5187         );
5188         git_header_html($http_responses{$status}, undef, %opts);
5189         print <<EOF;
5190 <div class="page_body">
5191 <br /><br />
5192 $status - $error
5193 <br />
5194 EOF
5195         if (defined $extra) {
5196                 print "<hr />\n" .
5197                       "$extra\n";
5198         }
5199         print "</div>\n";
5200
5201         git_footer_html();
5202         goto DONE_GITWEB
5203                 unless ($opts{'-error_handler'});
5204 }
5205
5206 ## ----------------------------------------------------------------------
5207 ## functions printing or outputting HTML: navigation
5208
5209 sub git_print_page_nav {
5210         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5211         $extra = '' if !defined $extra; # pager or formats
5212
5213         my @navs = qw(summary log commit commitdiff tree refs);
5214         if ($suppress) {
5215                 @navs = grep { $_ ne $suppress } @navs;
5216         }
5217
5218         my %arg = map { $_ => {action=>$_} } @navs;
5219         if (defined $head) {
5220                 for (qw(commit commitdiff)) {
5221                         $arg{$_}{'hash'} = $head;
5222                 }
5223                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5224                         $arg{'log'}{'hash'} = $head;
5225                 }
5226         }
5227
5228         $arg{'log'}{'action'} = 'shortlog';
5229         if ($current eq 'log') {
5230                 $current = 'shortlog';
5231         } elsif ($current eq 'shortlog') {
5232                 $current = 'log';
5233         }
5234         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5235         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5236
5237         my @actions = gitweb_get_feature('actions');
5238         my $escname = $project;
5239         $escname =~ s/[+]/%2B/g;
5240         my %repl = (
5241                 '%' => '%',
5242                 'n' => $project,         # project name
5243                 'f' => $git_dir,         # project path within filesystem
5244                 'h' => $treehead || '',  # current hash ('h' parameter)
5245                 'b' => $treebase || '',  # hash base ('hb' parameter)
5246                 'e' => $escname,         # project name with '+' escaped
5247         );
5248         while (@actions) {
5249                 my ($label, $link, $pos) = splice(@actions,0,3);
5250                 # insert
5251                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5252                 # munch munch
5253                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5254                 $arg{$label}{'_href'} = $link;
5255         }
5256
5257         print "<div class=\"page_nav\">\n" .
5258                 (join " | ",
5259                  map { $_ eq $current ?
5260                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
5261                  } @navs);
5262         print "<br/>\n$extra<br/>\n" .
5263               "</div>\n";
5264 }
5265
5266 # returns a submenu for the nagivation of the refs views (tags, heads,
5267 # remotes) with the current view disabled and the remotes view only
5268 # available if the feature is enabled
5269 sub format_ref_views {
5270         my ($current) = @_;
5271         my @ref_views = qw{tags heads};
5272         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5273         return join " | ", map {
5274                 $_ eq $current ? $_ :
5275                 $cgi->a({-href => href(action=>$_)}, $_)
5276         } @ref_views
5277 }
5278
5279 sub format_paging_nav {
5280         my ($action, $page, $has_next_link) = @_;
5281         my $paging_nav;
5282
5283
5284         if ($page > 0) {
5285                 $paging_nav .=
5286                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
5287                         " &#183; " .
5288                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5289                                  -accesskey => "p", -title => "Alt-p"}, "prev");
5290         } else {
5291                 $paging_nav .= "first &#183; prev";
5292         }
5293
5294         if ($has_next_link) {
5295                 $paging_nav .= " &#183; " .
5296                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5297                                  -accesskey => "n", -title => "Alt-n"}, "next");
5298         } else {
5299                 $paging_nav .= " &#183; next";
5300         }
5301
5302         return $paging_nav;
5303 }
5304
5305 sub format_log_nav {
5306         my ($action, $page, $has_next_link) = @_;
5307         my $paging_nav;
5308
5309         if ($action eq 'shortlog') {
5310                 $paging_nav .= 'shortlog';
5311         } else {
5312                 $paging_nav .= $cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog');
5313         }
5314         $paging_nav .= ' | ';
5315         if ($action eq 'log') {
5316                 $paging_nav .= 'fulllog';
5317         } else {
5318                 $paging_nav .= $cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog');
5319         }
5320
5321         $paging_nav .= " | " . format_paging_nav($action, $page, $has_next_link);
5322         return $paging_nav;
5323 }
5324
5325 ## ......................................................................
5326 ## functions printing or outputting HTML: div
5327
5328 sub git_print_header_div {
5329         my ($action, $title, $hash, $hash_base, $extra) = @_;
5330         my %args = ();
5331         defined $extra or $extra = '';
5332
5333         $args{'action'} = $action;
5334         $args{'hash'} = $hash if $hash;
5335         $args{'hash_base'} = $hash_base if $hash_base;
5336
5337         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5338                             $title ? $title : $action);
5339         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5340         print "<div class=\"header\">\n" . '<span class="title">' .
5341               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5342 }
5343
5344 sub format_repo_url {
5345         my ($name, $url) = @_;
5346         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5347 }
5348
5349 # Group output by placing it in a DIV element and adding a header.
5350 # Options for start_div() can be provided by passing a hash reference as the
5351 # first parameter to the function.
5352 # Options to git_print_header_div() can be provided by passing an array
5353 # reference. This must follow the options to start_div if they are present.
5354 # The content can be a scalar, which is output as-is, a scalar reference, which
5355 # is output after html escaping, an IO handle passed either as *handle or
5356 # *handle{IO}, or a function reference. In the latter case all following
5357 # parameters will be taken as argument to the content function call.
5358 sub git_print_section {
5359         my ($div_args, $header_args, $content);
5360         my $arg = shift;
5361         if (ref($arg) eq 'HASH') {
5362                 $div_args = $arg;
5363                 $arg = shift;
5364         }
5365         if (ref($arg) eq 'ARRAY') {
5366                 $header_args = $arg;
5367                 $arg = shift;
5368         }
5369         $content = $arg;
5370
5371         print $cgi->start_div($div_args);
5372         git_print_header_div(@$header_args);
5373
5374         if (ref($content) eq 'CODE') {
5375                 $content->(@_);
5376         } elsif (ref($content) eq 'SCALAR') {
5377                 print esc_html($$content);
5378         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5379                 while (<$content>) {
5380                         print to_utf8($_);
5381                 }
5382         } elsif (!ref($content) && defined($content)) {
5383                 print $content;
5384         }
5385
5386         print $cgi->end_div;
5387 }
5388
5389 sub format_timestamp_html {
5390         my $date = shift;
5391         my $useatnight = shift;
5392         defined($useatnight) or $useatnight = 1;
5393         my $strtime = $date->{'rfc2822'};
5394
5395         my (undef, undef, $datetime_class) =
5396                 gitweb_get_feature('javascript-timezone');
5397         if ($datetime_class) {
5398                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5399         }
5400
5401         my $localtime_format = '(%d %02d:%02d %s)';
5402         if ($useatnight && $date->{'hour_local'} < 6) {
5403                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5404         }
5405         $strtime .= ' ' .
5406                     sprintf($localtime_format, $date->{'mday_local'},
5407                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5408
5409         return $strtime;
5410 }
5411
5412 sub format_lastrefresh_row {
5413         return "<?gitweb format_lastrefresh_row?>" if $cache_mode_active;
5414         my %rd = parse_file_date('.last_refresh');
5415         if (defined $rd{'rfc2822'}) {
5416                 return "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
5417                        "<td>".format_timestamp_html(\%rd,0)."</td></tr>";
5418         }
5419         return "";
5420 }
5421
5422 # Outputs the author name and date in long form
5423 sub git_print_authorship {
5424         my $co = shift;
5425         my %opts = @_;
5426         my $tag = $opts{-tag} || 'div';
5427         my $author = $co->{'author_name'};
5428
5429         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5430         print "<$tag class=\"author_date\">" .
5431               format_search_author($author, "author", esc_html($author)) .
5432               " [".format_timestamp_html(\%ad)."]".
5433               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5434               "</$tag>\n";
5435 }
5436
5437 # Outputs table rows containing the full author or committer information,
5438 # in the format expected for 'commit' view (& similar).
5439 # Parameters are a commit hash reference, followed by the list of people
5440 # to output information for. If the list is empty it defaults to both
5441 # author and committer.
5442 sub git_print_authorship_rows {
5443         my $co = shift;
5444         # too bad we can't use @people = @_ || ('author', 'committer')
5445         my @people = @_;
5446         @people = ('author', 'committer') unless @people;
5447         foreach my $who (@people) {
5448                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5449                 print "<tr><td>$who</td><td>" .
5450                       format_search_author($co->{"${who}_name"}, $who,
5451                                            esc_html($co->{"${who}_name"})) . " " .
5452                       format_search_author($co->{"${who}_email"}, $who,
5453                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5454                       "</td><td rowspan=\"2\">" .
5455                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5456                       "</td></tr>\n" .
5457                       "<tr>" .
5458                       "<td></td><td>" .
5459                       format_timestamp_html(\%wd) .
5460                       "</td>" .
5461                       "</tr>\n";
5462         }
5463 }
5464
5465 sub git_print_page_path {
5466         my $name = shift;
5467         my $type = shift;
5468         my $hb = shift;
5469
5470
5471         print "<div class=\"page_path\">";
5472         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5473                       -title => 'tree root'}, to_utf8("[$project]"));
5474         print " / ";
5475         if (defined $name) {
5476                 my @dirname = split '/', $name;
5477                 my $basename = pop @dirname;
5478                 my $fullname = '';
5479
5480                 foreach my $dir (@dirname) {
5481                         $fullname .= ($fullname ? '/' : '') . $dir;
5482                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5483                                                      hash_base=>$hb),
5484                                       -title => $fullname}, esc_path($dir));
5485                         print " / ";
5486                 }
5487                 if (defined $type && $type eq 'blob') {
5488                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5489                                                      hash_base=>$hb),
5490                                       -title => $name}, esc_path($basename));
5491                 } elsif (defined $type && $type eq 'tree') {
5492                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5493                                                      hash_base=>$hb),
5494                                       -title => $name}, esc_path($basename));
5495                         print " / ";
5496                 } else {
5497                         print esc_path($basename);
5498                 }
5499         }
5500         print "<br/></div>\n";
5501 }
5502
5503 sub git_print_log {
5504         my $log = shift;
5505         my %opts = @_;
5506
5507         if ($opts{'-remove_title'}) {
5508                 # remove title, i.e. first line of log
5509                 shift @$log;
5510         }
5511         # remove leading empty lines
5512         while (defined $log->[0] && $log->[0] eq "") {
5513                 shift @$log;
5514         }
5515
5516         # print log
5517         my $skip_blank_line = 0;
5518         foreach my $line (@$log) {
5519                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5520                         if (! $opts{'-remove_signoff'}) {
5521                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5522                                 $skip_blank_line = 1;
5523                         }
5524                         next;
5525                 }
5526
5527                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5528                         if (! $opts{'-remove_signoff'}) {
5529                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5530                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5531                                         "</span><br/>\n";
5532                                 $skip_blank_line = 1;
5533                         }
5534                         next;
5535                 }
5536
5537                 # print only one empty line
5538                 # do not print empty line after signoff
5539                 if ($line eq "") {
5540                         next if ($skip_blank_line);
5541                         $skip_blank_line = 1;
5542                 } else {
5543                         $skip_blank_line = 0;
5544                 }
5545
5546                 print format_log_line_html($line) . "<br/>\n";
5547         }
5548
5549         if ($opts{'-final_empty_line'}) {
5550                 # end with single empty line
5551                 print "<br/>\n" unless $skip_blank_line;
5552         }
5553 }
5554
5555 # return link target (what link points to)
5556 sub git_get_link_target {
5557         my $hash = shift;
5558         my $link_target;
5559
5560         # read link
5561         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5562                 or return;
5563         {
5564                 local $/ = undef;
5565                 $link_target = to_utf8(scalar <$fd>);
5566         }
5567         close $fd
5568                 or return;
5569
5570         return $link_target;
5571 }
5572
5573 # given link target, and the directory (basedir) the link is in,
5574 # return target of link relative to top directory (top tree);
5575 # return undef if it is not possible (including absolute links).
5576 sub normalize_link_target {
5577         my ($link_target, $basedir) = @_;
5578
5579         # absolute symlinks (beginning with '/') cannot be normalized
5580         return if (substr($link_target, 0, 1) eq '/');
5581
5582         # normalize link target to path from top (root) tree (dir)
5583         my $path;
5584         if ($basedir) {
5585                 $path = $basedir . '/' . $link_target;
5586         } else {
5587                 # we are in top (root) tree (dir)
5588                 $path = $link_target;
5589         }
5590
5591         # remove //, /./, and /../
5592         my @path_parts;
5593         foreach my $part (split('/', $path)) {
5594                 # discard '.' and ''
5595                 next if (!$part || $part eq '.');
5596                 # handle '..'
5597                 if ($part eq '..') {
5598                         if (@path_parts) {
5599                                 pop @path_parts;
5600                         } else {
5601                                 # link leads outside repository (outside top dir)
5602                                 return;
5603                         }
5604                 } else {
5605                         push @path_parts, $part;
5606                 }
5607         }
5608         $path = join('/', @path_parts);
5609
5610         return $path;
5611 }
5612
5613 # print tree entry (row of git_tree), but without encompassing <tr> element
5614 sub git_print_tree_entry {
5615         my ($t, $basedir, $hash_base, $have_blame) = @_;
5616
5617         my %base_key = ();
5618         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5619
5620         # The format of a table row is: mode list link.  Where mode is
5621         # the mode of the entry, list is the name of the entry, an href,
5622         # and link is the action links of the entry.
5623
5624         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5625         if (exists $t->{'size'}) {
5626                 print "<td class=\"size\">$t->{'size'}</td>\n";
5627         }
5628         if ($t->{'type'} eq "blob") {
5629                 print "<td class=\"list\">" .
5630                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5631                                                file_name=>"$basedir$t->{'name'}", %base_key),
5632                                 -class => "list"}, esc_path($t->{'name'}));
5633                 if (S_ISLNK(oct $t->{'mode'})) {
5634                         my $link_target = git_get_link_target($t->{'hash'});
5635                         if ($link_target) {
5636                                 my $norm_target = normalize_link_target($link_target, $basedir);
5637                                 if (defined $norm_target) {
5638                                         print " -> " .
5639                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5640                                                                      file_name=>$norm_target),
5641                                                        -title => $norm_target}, esc_path($link_target));
5642                                 } else {
5643                                         print " -> " . esc_path($link_target);
5644                                 }
5645                         }
5646                 }
5647                 print "</td>\n";
5648                 print "<td class=\"link\">";
5649                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5650                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5651                               "blob");
5652                 if ($have_blame) {
5653                         print " | " .
5654                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5655                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5656                                       -class => "blamelink"},
5657                                       "blame");
5658                 }
5659                 if (defined $hash_base) {
5660                         print " | " .
5661                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5662                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5663                                       "history");
5664                 }
5665                 print " | " .
5666                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5667                                                file_name=>"$basedir$t->{'name'}")},
5668                                 "raw");
5669                 print "</td>\n";
5670
5671         } elsif ($t->{'type'} eq "tree") {
5672                 print "<td class=\"list\">";
5673                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5674                                              file_name=>"$basedir$t->{'name'}",
5675                                              %base_key)},
5676                               esc_path($t->{'name'}));
5677                 print "</td>\n";
5678                 print "<td class=\"link\">";
5679                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5680                                              file_name=>"$basedir$t->{'name'}",
5681                                              %base_key)},
5682                               "tree");
5683                 if (defined $hash_base) {
5684                         print " | " .
5685                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5686                                                      file_name=>"$basedir$t->{'name'}")},
5687                                       "history");
5688                 }
5689                 print "</td>\n";
5690         } else {
5691                 # unknown object: we can only present history for it
5692                 # (this includes 'commit' object, i.e. submodule support)
5693                 print "<td class=\"list\">" .
5694                       esc_path($t->{'name'}) .
5695                       "</td>\n";
5696                 print "<td class=\"link\">";
5697                 if (defined $hash_base) {
5698                         print $cgi->a({-href => href(action=>"history",
5699                                                      hash_base=>$hash_base,
5700                                                      file_name=>"$basedir$t->{'name'}")},
5701                                       "history");
5702                 }
5703                 print "</td>\n";
5704         }
5705 }
5706
5707 ## ......................................................................
5708 ## functions printing large fragments of HTML
5709
5710 # get pre-image filenames for merge (combined) diff
5711 sub fill_from_file_info {
5712         my ($diff, @parents) = @_;
5713
5714         $diff->{'from_file'} = [ ];
5715         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5716         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5717                 if ($diff->{'status'}[$i] eq 'R' ||
5718                     $diff->{'status'}[$i] eq 'C') {
5719                         $diff->{'from_file'}[$i] =
5720                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5721                 }
5722         }
5723
5724         return $diff;
5725 }
5726
5727 # is current raw difftree line of file deletion
5728 sub is_deleted {
5729         my $diffinfo = shift;
5730
5731         return $diffinfo->{'to_id'} eq ('0' x 40);
5732 }
5733
5734 # does patch correspond to [previous] difftree raw line
5735 # $diffinfo  - hashref of parsed raw diff format
5736 # $patchinfo - hashref of parsed patch diff format
5737 #              (the same keys as in $diffinfo)
5738 sub is_patch_split {
5739         my ($diffinfo, $patchinfo) = @_;
5740
5741         return defined $diffinfo && defined $patchinfo
5742                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5743 }
5744
5745
5746 sub git_difftree_body {
5747         my ($difftree, $hash, @parents) = @_;
5748         my ($parent) = $parents[0];
5749         my $have_blame = gitweb_check_feature('blame');
5750         print "<div class=\"list_head\">\n";
5751         if ($#{$difftree} > 10) {
5752                 print(($#{$difftree} + 1) . " files changed:\n");
5753         }
5754         print "</div>\n";
5755
5756         print "<table class=\"" .
5757               (@parents > 1 ? "combined " : "") .
5758               "diff_tree\">\n";
5759
5760         # header only for combined diff in 'commitdiff' view
5761         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5762         if ($has_header) {
5763                 # table header
5764                 print "<thead><tr>\n" .
5765                        "<th></th><th></th>\n"; # filename, patchN link
5766                 for (my $i = 0; $i < @parents; $i++) {
5767                         my $par = $parents[$i];
5768                         print "<th>" .
5769                               $cgi->a({-href => href(action=>"commitdiff",
5770                                                      hash=>$hash, hash_parent=>$par),
5771                                        -title => 'commitdiff to parent number ' .
5772                                                   ($i+1) . ': ' . substr($par,0,7)},
5773                                       $i+1) .
5774                               "&#160;</th>\n";
5775                 }
5776                 print "</tr></thead>\n<tbody>\n";
5777         }
5778
5779         my $alternate = 1;
5780         my $patchno = 0;
5781         foreach my $line (@{$difftree}) {
5782                 my $diff = parsed_difftree_line($line);
5783
5784                 if ($alternate) {
5785                         print "<tr class=\"dark\">\n";
5786                 } else {
5787                         print "<tr class=\"light\">\n";
5788                 }
5789                 $alternate ^= 1;
5790
5791                 if (exists $diff->{'nparents'}) { # combined diff
5792
5793                         fill_from_file_info($diff, @parents)
5794                                 unless exists $diff->{'from_file'};
5795
5796                         if (!is_deleted($diff)) {
5797                                 # file exists in the result (child) commit
5798                                 print "<td>" .
5799                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5800                                                              file_name=>$diff->{'to_file'},
5801                                                              hash_base=>$hash),
5802                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5803                                       "</td>\n";
5804                         } else {
5805                                 print "<td>" .
5806                                       esc_path($diff->{'to_file'}) .
5807                                       "</td>\n";
5808                         }
5809
5810                         if ($action eq 'commitdiff') {
5811                                 # link to patch
5812                                 $patchno++;
5813                                 print "<td class=\"link\">" .
5814                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5815                                               "patch") .
5816                                       " | " .
5817                                       "</td>\n";
5818                         }
5819
5820                         my $has_history = 0;
5821                         my $not_deleted = 0;
5822                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5823                                 my $hash_parent = $parents[$i];
5824                                 my $from_hash = $diff->{'from_id'}[$i];
5825                                 my $from_path = $diff->{'from_file'}[$i];
5826                                 my $status = $diff->{'status'}[$i];
5827
5828                                 $has_history ||= ($status ne 'A');
5829                                 $not_deleted ||= ($status ne 'D');
5830
5831                                 if ($status eq 'A') {
5832                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
5833                                 } elsif ($status eq 'D') {
5834                                         print "<td class=\"link\">" .
5835                                               $cgi->a({-href => href(action=>"blob",
5836                                                                      hash_base=>$hash,
5837                                                                      hash=>$from_hash,
5838                                                                      file_name=>$from_path)},
5839                                                       "blob" . ($i+1)) .
5840                                               " | </td>\n";
5841                                 } else {
5842                                         if ($diff->{'to_id'} eq $from_hash) {
5843                                                 print "<td class=\"link nochange\">";
5844                                         } else {
5845                                                 print "<td class=\"link\">";
5846                                         }
5847                                         print $cgi->a({-href => href(action=>"blobdiff",
5848                                                                      hash=>$diff->{'to_id'},
5849                                                                      hash_parent=>$from_hash,
5850                                                                      hash_base=>$hash,
5851                                                                      hash_parent_base=>$hash_parent,
5852                                                                      file_name=>$diff->{'to_file'},
5853                                                                      file_parent=>$from_path)},
5854                                                       "diff" . ($i+1)) .
5855                                               " | </td>\n";
5856                                 }
5857                         }
5858
5859                         print "<td class=\"link\">";
5860                         if ($not_deleted) {
5861                                 print $cgi->a({-href => href(action=>"blob",
5862                                                              hash=>$diff->{'to_id'},
5863                                                              file_name=>$diff->{'to_file'},
5864                                                              hash_base=>$hash)},
5865                                               "blob");
5866                                 print " | " if ($has_history);
5867                         }
5868                         if ($has_history) {
5869                                 print $cgi->a({-href => href(action=>"history",
5870                                                              file_name=>$diff->{'to_file'},
5871                                                              hash_base=>$hash)},
5872                                               "history");
5873                         }
5874                         print "</td>\n";
5875
5876                         print "</tr>\n";
5877                         next; # instead of 'else' clause, to avoid extra indent
5878                 }
5879                 # else ordinary diff
5880
5881                 my ($to_mode_oct, $to_mode_str, $to_file_type);
5882                 my ($from_mode_oct, $from_mode_str, $from_file_type);
5883                 if ($diff->{'to_mode'} ne ('0' x 6)) {
5884                         $to_mode_oct = oct $diff->{'to_mode'};
5885                         if (S_ISREG($to_mode_oct)) { # only for regular file
5886                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
5887                         }
5888                         $to_file_type = file_type($diff->{'to_mode'});
5889                 }
5890                 if ($diff->{'from_mode'} ne ('0' x 6)) {
5891                         $from_mode_oct = oct $diff->{'from_mode'};
5892                         if (S_ISREG($from_mode_oct)) { # only for regular file
5893                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
5894                         }
5895                         $from_file_type = file_type($diff->{'from_mode'});
5896                 }
5897
5898                 if ($diff->{'status'} eq "A") { # created
5899                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
5900                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
5901                         $mode_chng   .= "]</span>";
5902                         print "<td>";
5903                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5904                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5905                                       -class => "list"}, esc_path($diff->{'file'}));
5906                         print "</td>\n";
5907                         print "<td>$mode_chng</td>\n";
5908                         print "<td class=\"link\">";
5909                         if ($action eq 'commitdiff') {
5910                                 # link to patch
5911                                 $patchno++;
5912                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5913                                               "patch") .
5914                                       " | ";
5915                         }
5916                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5917                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5918                                       "blob");
5919                         print "</td>\n";
5920
5921                 } elsif ($diff->{'status'} eq "D") { # deleted
5922                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5923                         print "<td>";
5924                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5925                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
5926                                        -class => "list"}, esc_path($diff->{'file'}));
5927                         print "</td>\n";
5928                         print "<td>$mode_chng</td>\n";
5929                         print "<td class=\"link\">";
5930                         if ($action eq 'commitdiff') {
5931                                 # link to patch
5932                                 $patchno++;
5933                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5934                                               "patch") .
5935                                       " | ";
5936                         }
5937                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5938                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
5939                                       "blob") . " | ";
5940                         if ($have_blame) {
5941                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5942                                                              file_name=>$diff->{'file'}),
5943                                               -class => "blamelink"},
5944                                               "blame") . " | ";
5945                         }
5946                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5947                                                      file_name=>$diff->{'file'})},
5948                                       "history");
5949                         print "</td>\n";
5950
5951                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5952                         my $mode_chnge = "";
5953                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5954                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5955                                 if ($from_file_type ne $to_file_type) {
5956                                         $mode_chnge .= " from $from_file_type to $to_file_type";
5957                                 }
5958                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
5959                                         if ($from_mode_str && $to_mode_str) {
5960                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
5961                                         } elsif ($to_mode_str) {
5962                                                 $mode_chnge .= " mode: $to_mode_str";
5963                                         }
5964                                 }
5965                                 $mode_chnge .= "]</span>\n";
5966                         }
5967                         print "<td>";
5968                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5969                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5970                                       -class => "list"}, esc_path($diff->{'file'}));
5971                         print "</td>\n";
5972                         print "<td>$mode_chnge</td>\n";
5973                         print "<td class=\"link\">";
5974                         if ($action eq 'commitdiff') {
5975                                 # link to patch
5976                                 $patchno++;
5977                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5978                                               "patch") .
5979                                       " | ";
5980                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5981                                 # "commit" view and modified file (not onlu mode changed)
5982                                 print $cgi->a({-href => href(action=>"blobdiff",
5983                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5984                                                              hash_base=>$hash, hash_parent_base=>$parent,
5985                                                              file_name=>$diff->{'file'})},
5986                                               "diff") .
5987                                       " | ";
5988                         }
5989                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5990                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5991                                        "blob") . " | ";
5992                         if ($have_blame) {
5993                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5994                                                              file_name=>$diff->{'file'}),
5995                                               -class => "blamelink"},
5996                                               "blame") . " | ";
5997                         }
5998                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5999                                                      file_name=>$diff->{'file'})},
6000                                       "history");
6001                         print "</td>\n";
6002
6003                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6004                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6005                         my $nstatus = $status_name{$diff->{'status'}};
6006                         my $mode_chng = "";
6007                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6008                                 # mode also for directories, so we cannot use $to_mode_str
6009                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6010                         }
6011                         print "<td>" .
6012                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6013                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6014                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6015                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6016                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6017                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6018                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6019                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6020                               "<td class=\"link\">";
6021                         if ($action eq 'commitdiff') {
6022                                 # link to patch
6023                                 $patchno++;
6024                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6025                                               "patch") .
6026                                       " | ";
6027                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6028                                 # "commit" view and modified file (not only pure rename or copy)
6029                                 print $cgi->a({-href => href(action=>"blobdiff",
6030                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6031                                                              hash_base=>$hash, hash_parent_base=>$parent,
6032                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6033                                               "diff") .
6034                                       " | ";
6035                         }
6036                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6037                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6038                                       "blob") . " | ";
6039                         if ($have_blame) {
6040                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6041                                                              file_name=>$diff->{'to_file'}),
6042                                               -class => "blamelink"},
6043                                               "blame") . " | ";
6044                         }
6045                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6046                                                     file_name=>$diff->{'to_file'})},
6047                                       "history");
6048                         print "</td>\n";
6049
6050                 } # we should not encounter Unmerged (U) or Unknown (X) status
6051                 print "</tr>\n";
6052         }
6053         print "</tbody>" if $has_header;
6054         print "</table>\n";
6055 }
6056
6057 # Print context lines and then rem/add lines in a side-by-side manner.
6058 sub print_sidebyside_diff_lines {
6059         my ($ctx, $rem, $add) = @_;
6060
6061         # print context block before add/rem block
6062         if (@$ctx) {
6063                 print join '',
6064                         '<div class="chunk_block ctx">',
6065                                 '<div class="old">',
6066                                 @$ctx,
6067                                 '</div>',
6068                                 '<div class="new">',
6069                                 @$ctx,
6070                                 '</div>',
6071                         '</div>';
6072         }
6073
6074         if (!@$add) {
6075                 # pure removal
6076                 print join '',
6077                         '<div class="chunk_block rem">',
6078                                 '<div class="old">',
6079                                 @$rem,
6080                                 '</div>',
6081                         '</div>';
6082         } elsif (!@$rem) {
6083                 # pure addition
6084                 print join '',
6085                         '<div class="chunk_block add">',
6086                                 '<div class="new">',
6087                                 @$add,
6088                                 '</div>',
6089                         '</div>';
6090         } else {
6091                 print join '',
6092                         '<div class="chunk_block chg">',
6093                                 '<div class="old">',
6094                                 @$rem,
6095                                 '</div>',
6096                                 '<div class="new">',
6097                                 @$add,
6098                                 '</div>',
6099                         '</div>';
6100         }
6101 }
6102
6103 # Print context lines and then rem/add lines in inline manner.
6104 sub print_inline_diff_lines {
6105         my ($ctx, $rem, $add) = @_;
6106
6107         print @$ctx, @$rem, @$add;
6108 }
6109
6110 # Format removed and added line, mark changed part and HTML-format them.
6111 # Implementation is based on contrib/diff-highlight
6112 sub format_rem_add_lines_pair {
6113         my ($rem, $add, $num_parents) = @_;
6114
6115         # We need to untabify lines before split()'ing them;
6116         # otherwise offsets would be invalid.
6117         chomp $rem;
6118         chomp $add;
6119         $rem = untabify($rem);
6120         $add = untabify($add);
6121
6122         my @rem = split(//, $rem);
6123         my @add = split(//, $add);
6124         my ($esc_rem, $esc_add);
6125         # Ignore leading +/- characters for each parent.
6126         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6127         my ($prefix_has_nonspace, $suffix_has_nonspace);
6128
6129         my $shorter = (@rem < @add) ? @rem : @add;
6130         while ($prefix_len < $shorter) {
6131                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6132
6133                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6134                 $prefix_len++;
6135         }
6136
6137         while ($prefix_len + $suffix_len < $shorter) {
6138                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6139
6140                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6141                 $suffix_len++;
6142         }
6143
6144         # Mark lines that are different from each other, but have some common
6145         # part that isn't whitespace.  If lines are completely different, don't
6146         # mark them because that would make output unreadable, especially if
6147         # diff consists of multiple lines.
6148         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6149                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6150                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6151                 $esc_add = esc_html_hl_regions($add, 'marked',
6152                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6153         } else {
6154                 $esc_rem = esc_html($rem, -nbsp=>1);
6155                 $esc_add = esc_html($add, -nbsp=>1);
6156         }
6157
6158         return format_diff_line(\$esc_rem, 'rem'),
6159                format_diff_line(\$esc_add, 'add');
6160 }
6161
6162 # HTML-format diff context, removed and added lines.
6163 sub format_ctx_rem_add_lines {
6164         my ($ctx, $rem, $add, $num_parents) = @_;
6165         my (@new_ctx, @new_rem, @new_add);
6166         my $can_highlight = 0;
6167         my $is_combined = ($num_parents > 1);
6168
6169         # Highlight if every removed line has a corresponding added line.
6170         if (@$add > 0 && @$add == @$rem) {
6171                 $can_highlight = 1;
6172
6173                 # Highlight lines in combined diff only if the chunk contains
6174                 # diff between the same version, e.g.
6175                 #
6176                 #    - a
6177                 #   -  b
6178                 #    + c
6179                 #   +  d
6180                 #
6181                 # Otherwise the highlightling would be confusing.
6182                 if ($is_combined) {
6183                         for (my $i = 0; $i < @$add; $i++) {
6184                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6185                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6186
6187                                 $prefix_rem =~ s/-/+/g;
6188
6189                                 if ($prefix_rem ne $prefix_add) {
6190                                         $can_highlight = 0;
6191                                         last;
6192                                 }
6193                         }
6194                 }
6195         }
6196
6197         if ($can_highlight) {
6198                 for (my $i = 0; $i < @$add; $i++) {
6199                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6200                                 $rem->[$i], $add->[$i], $num_parents);
6201                         push @new_rem, $line_rem;
6202                         push @new_add, $line_add;
6203                 }
6204         } else {
6205                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6206                 @new_add = map { format_diff_line($_, 'add') } @$add;
6207         }
6208
6209         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6210
6211         return (\@new_ctx, \@new_rem, \@new_add);
6212 }
6213
6214 # Print context lines and then rem/add lines.
6215 sub print_diff_lines {
6216         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6217         my $is_combined = $num_parents > 1;
6218
6219         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6220                 $num_parents);
6221
6222         if ($diff_style eq 'sidebyside' && !$is_combined) {
6223                 print_sidebyside_diff_lines($ctx, $rem, $add);
6224         } else {
6225                 # default 'inline' style and unknown styles
6226                 print_inline_diff_lines($ctx, $rem, $add);
6227         }
6228 }
6229
6230 sub print_diff_chunk {
6231         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6232         my (@ctx, @rem, @add);
6233
6234         # The class of the previous line.
6235         my $prev_class = '';
6236
6237         return unless @chunk;
6238
6239         # incomplete last line might be among removed or added lines,
6240         # or both, or among context lines: find which
6241         for (my $i = 1; $i < @chunk; $i++) {
6242                 if ($chunk[$i][0] eq 'incomplete') {
6243                         $chunk[$i][0] = $chunk[$i-1][0];
6244                 }
6245         }
6246
6247         # guardian
6248         push @chunk, ["", ""];
6249
6250         foreach my $line_info (@chunk) {
6251                 my ($class, $line) = @$line_info;
6252
6253                 # print chunk headers
6254                 if ($class && $class eq 'chunk_header') {
6255                         print format_diff_line($line, $class, $from, $to);
6256                         next;
6257                 }
6258
6259                 ## print from accumulator when have some add/rem lines or end
6260                 # of chunk (flush context lines), or when have add and rem
6261                 # lines and new block is reached (otherwise add/rem lines could
6262                 # be reordered)
6263                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6264                     (@rem && @add && $class ne $prev_class)) {
6265                         print_diff_lines(\@ctx, \@rem, \@add,
6266                                          $diff_style, $num_parents);
6267                         @ctx = @rem = @add = ();
6268                 }
6269
6270                 ## adding lines to accumulator
6271                 # guardian value
6272                 last unless $line;
6273                 # rem, add or change
6274                 if ($class eq 'rem') {
6275                         push @rem, $line;
6276                 } elsif ($class eq 'add') {
6277                         push @add, $line;
6278                 }
6279                 # context line
6280                 if ($class eq 'ctx') {
6281                         push @ctx, $line;
6282                 }
6283
6284                 $prev_class = $class;
6285         }
6286 }
6287
6288 sub git_patchset_body {
6289         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6290         my ($hash_parent) = $hash_parents[0];
6291
6292         my $is_combined = (@hash_parents > 1);
6293         my $patch_idx = 0;
6294         my $patch_number = 0;
6295         my $patch_line;
6296         my $diffinfo;
6297         my $to_name;
6298         my (%from, %to);
6299         my @chunk; # for side-by-side diff
6300
6301         print "<div class=\"patchset\">\n";
6302
6303         # skip to first patch
6304         while ($patch_line = to_utf8(scalar <$fd>)) {
6305                 chomp $patch_line;
6306
6307                 last if ($patch_line =~ m/^diff /);
6308         }
6309
6310  PATCH:
6311         while ($patch_line) {
6312
6313                 # parse "git diff" header line
6314                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6315                         # $1 is from_name, which we do not use
6316                         $to_name = unquote($2);
6317                         $to_name =~ s!^b/!!;
6318                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6319                         # $1 is 'cc' or 'combined', which we do not use
6320                         $to_name = unquote($2);
6321                 } else {
6322                         $to_name = undef;
6323                 }
6324
6325                 # check if current patch belong to current raw line
6326                 # and parse raw git-diff line if needed
6327                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6328                         # this is continuation of a split patch
6329                         print "<div class=\"patch cont\">\n";
6330                 } else {
6331                         # advance raw git-diff output if needed
6332                         $patch_idx++ if defined $diffinfo;
6333
6334                         # read and prepare patch information
6335                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6336
6337                         # compact combined diff output can have some patches skipped
6338                         # find which patch (using pathname of result) we are at now;
6339                         if ($is_combined) {
6340                                 while ($to_name ne $diffinfo->{'to_file'}) {
6341                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6342                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6343                                               "</div>\n";  # class="patch"
6344
6345                                         $patch_idx++;
6346                                         $patch_number++;
6347
6348                                         last if $patch_idx > $#$difftree;
6349                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6350                                 }
6351                         }
6352
6353                         # modifies %from, %to hashes
6354                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6355
6356                         # this is first patch for raw difftree line with $patch_idx index
6357                         # we index @$difftree array from 0, but number patches from 1
6358                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6359                 }
6360
6361                 # git diff header
6362                 #assert($patch_line =~ m/^diff /) if DEBUG;
6363                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6364                 $patch_number++;
6365                 # print "git diff" header
6366                 print format_git_diff_header_line($patch_line, $diffinfo,
6367                                                   \%from, \%to);
6368
6369                 # print extended diff header
6370                 print "<div class=\"diff extended_header\">\n";
6371         EXTENDED_HEADER:
6372                 while ($patch_line = to_utf8(scalar<$fd>)) {
6373                         chomp $patch_line;
6374
6375                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6376
6377                         print format_extended_diff_header_line($patch_line, $diffinfo,
6378                                                                \%from, \%to);
6379                 }
6380                 print "</div>\n"; # class="diff extended_header"
6381
6382                 # from-file/to-file diff header
6383                 if (! $patch_line) {
6384                         print "</div>\n"; # class="patch"
6385                         last PATCH;
6386                 }
6387                 next PATCH if ($patch_line =~ m/^diff /);
6388                 #assert($patch_line =~ m/^---/) if DEBUG;
6389
6390                 my $last_patch_line = $patch_line;
6391                 $patch_line = to_utf8(scalar <$fd>);
6392                 chomp $patch_line;
6393                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6394
6395                 print format_diff_from_to_header($last_patch_line, $patch_line,
6396                                                  $diffinfo, \%from, \%to,
6397                                                  @hash_parents);
6398
6399                 # the patch itself
6400         LINE:
6401                 while ($patch_line = to_utf8(scalar <$fd>)) {
6402                         chomp $patch_line;
6403
6404                         next PATCH if ($patch_line =~ m/^diff /);
6405
6406                         my $class = diff_line_class($patch_line, \%from, \%to);
6407
6408                         if ($class eq 'chunk_header') {
6409                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6410                                 @chunk = ();
6411                         }
6412
6413                         push @chunk, [ $class, $patch_line ];
6414                 }
6415
6416         } continue {
6417                 if (@chunk) {
6418                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6419                         @chunk = ();
6420                 }
6421                 print "</div>\n"; # class="patch"
6422         }
6423
6424         # for compact combined (--cc) format, with chunk and patch simplification
6425         # the patchset might be empty, but there might be unprocessed raw lines
6426         for (++$patch_idx if $patch_number > 0;
6427              $patch_idx < @$difftree;
6428              ++$patch_idx) {
6429                 # read and prepare patch information
6430                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6431
6432                 # generate anchor for "patch" links in difftree / whatchanged part
6433                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6434                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6435                       "</div>\n";  # class="patch"
6436
6437                 $patch_number++;
6438         }
6439
6440         if ($patch_number == 0) {
6441                 if (@hash_parents > 1) {
6442                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6443                 } else {
6444                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6445                 }
6446         }
6447
6448         print "</div>\n"; # class="patchset"
6449 }
6450
6451 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6452
6453 sub git_project_search_form {
6454         my ($searchtext, $search_use_regexp) = @_;
6455
6456         my $limit = '';
6457         if ($project_filter) {
6458                 $limit = " in '$project_filter'";
6459         }
6460
6461         print "<div class=\"projsearch\">\n";
6462         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6463               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6464         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6465                 if (defined $project_filter);
6466         print $cgi->textfield(-name => 's', -value => $searchtext,
6467                               -title => "Search project by name and description$limit",
6468                               -size => 60) . "\n" .
6469               "<span title=\"Extended regular expression\">" .
6470               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6471                              -checked => $search_use_regexp) .
6472               "</span>\n" .
6473               $cgi->submit(-name => 'btnS', -value => 'Search') .
6474               $cgi->end_form() . "\n" .
6475               "<span class=\"projectlist_link\">" .
6476               $cgi->a({-href => href(project => undef, searchtext => undef,
6477                                      action => 'project_list',
6478                                      project_filter => $project_filter)},
6479                       esc_html("List all projects$limit")) . "</span><br />\n";
6480         print "<span class=\"projectlist_link\">" .
6481               $cgi->a({-href => href(project => undef, searchtext => undef,
6482                                      action => 'project_list',
6483                                      project_filter => undef)},
6484                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6485         print "</div>\n";
6486 }
6487
6488 # entry for given @keys needs filling if at least one of keys in list
6489 # is not present in %$project_info
6490 sub project_info_needs_filling {
6491         my ($project_info, @keys) = @_;
6492
6493         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6494         foreach my $key (@keys) {
6495                 if (!exists $project_info->{$key}) {
6496                         return 1;
6497                 }
6498         }
6499         return;
6500 }
6501
6502 sub git_cache_file_format {
6503         return GITWEB_CACHE_FORMAT .
6504                 (gitweb_check_feature('forks') ? " (forks)" : "");
6505 }
6506
6507 sub git_retrieve_cache_file {
6508         my $cache_file = shift;
6509
6510         use Storable qw(retrieve);
6511
6512         if ((my $dump = eval { retrieve($cache_file) })) {
6513                 return $$dump[1] if
6514                         ref($dump) eq 'ARRAY' &&
6515                         @$dump == 2 &&
6516                         ref($$dump[1]) eq 'ARRAY' &&
6517                         @{$$dump[1]} == 2 &&
6518                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6519                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6520                         $$dump[0] eq git_cache_file_format();
6521         }
6522
6523         return undef;
6524 }
6525
6526 sub git_store_cache_file {
6527         my ($cache_file, $cachedata) = @_;
6528
6529         use File::Basename qw(dirname);
6530         use File::stat;
6531         use POSIX qw(:fcntl_h);
6532         use Storable qw(store_fd);
6533
6534         my $result = undef;
6535         my $cache_d = dirname($cache_file);
6536         my $mask = umask();
6537         umask($mask & ~0070) if $cache_grpshared;
6538         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6539             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6540                 store_fd([git_cache_file_format(), $cachedata], $fd);
6541                 close $fd;
6542                 rename "$cache_file.lock", $cache_file;
6543                 $result = stat($cache_file)->mtime;
6544         }
6545         umask($mask) if $cache_grpshared;
6546         return $result;
6547 }
6548
6549 sub verify_cached_project {
6550         my ($hashref, $path) = @_;
6551         return undef unless $path;
6552         delete $$hashref{$path}, return undef unless is_valid_project($path);
6553         return $$hashref{$path} if exists $$hashref{$path};
6554
6555         # A valid project was requested but it's not yet in the cache
6556         # Manufacture a minimal project entry (path, name, description)
6557         # Also provide age, but only if it's available via $lastactivity_file
6558
6559         my %proj = ('path' => $path);
6560         my $val = git_get_project_description($path);
6561         defined $val or $val = '';
6562         $proj{'descr_long'} = $val;
6563         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6564         unless ($omit_owner) {
6565                 $val = git_get_project_owner($path);
6566                 defined $val or $val = '';
6567                 $proj{'owner'} = $val;
6568         }
6569         unless ($omit_age_column) {
6570                 ($val) = git_get_last_activity($path, 1);
6571                 $proj{'age_epoch'} = $val if defined $val;
6572         }
6573         $$hashref{$path} = \%proj;
6574         return \%proj;
6575 }
6576
6577 sub git_filter_cached_projects {
6578         my ($cache, $projlist, $verify) = @_;
6579         my $hashref = $$cache[1];
6580         my $sub = $verify ?
6581                 sub {verify_cached_project($hashref, $_[0])} :
6582                 sub {$$hashref{$_[0]}};
6583         return map {
6584                 my $c = &$sub($_->{'path'});
6585                 defined $c ? ($_ = $c) : ()
6586         } @$projlist;
6587 }
6588
6589 # fills project list info (age, description, owner, category, forks, etc.)
6590 # for each project in the list, removing invalid projects from
6591 # returned list, or fill only specified info.
6592 #
6593 # Invalid projects are removed from the returned list if and only if you
6594 # ask 'age_epoch' to be filled, because they are the only fields
6595 # that run unconditionally git command that requires repository, and
6596 # therefore do always check if project repository is invalid.
6597 #
6598 # USAGE:
6599 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6600 #   ensures that 'descr_long' and 'ctags' fields are filled
6601 # * @project_list = fill_project_list_info(\@project_list)
6602 #   ensures that all fields are filled (and invalid projects removed)
6603 #
6604 # NOTE: modifies $projlist, but does not remove entries from it
6605 sub fill_project_list_info {
6606         my ($projlist, @wanted_keys) = @_;
6607
6608         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6609         return fill_project_list_info_uncached($projlist, @wanted_keys)
6610                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6611
6612         use File::stat;
6613
6614         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6615         my $cache_file = "$cache_dir/$projlist_cache_name";
6616
6617         my @projects;
6618         my $stale = 0;
6619         my $now = time();
6620         my $cache_mtime;
6621         if ($cache_lifetime && -f $cache_file) {
6622                 $cache_mtime = stat($cache_file)->mtime;
6623                 $cache_dump = undef if $cache_mtime &&
6624                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6625         }
6626         if (defined $cache_mtime && # caching is on and $cache_file exists
6627             $cache_mtime + $cache_lifetime*60 > $now &&
6628             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6629                 # Cache hit.
6630                 $cache_dump_mtime = $cache_mtime;
6631                 $stale = $now - $cache_mtime;
6632                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6633                         gitweb_check_feature('forks');
6634                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6635
6636         } else { # Cache miss.
6637                 if (defined $cache_mtime) {
6638                         # Postpone timeout by two minutes so that we get
6639                         # enough time to do our job, or to be more exact
6640                         # make cache expire after two minutes from now.
6641                         my $time = $now - $cache_lifetime*60 + 120;
6642                         utime $time, $time, $cache_file;
6643                 }
6644                 my @all_projects = git_get_projects_list();
6645                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6646                         fill_project_list_info_uncached(\@all_projects);
6647                 map { $all_projects_filled{$_->{'path'}} = $_ }
6648                         filter_forks_from_projects_list([values(%all_projects_filled)])
6649                         if gitweb_check_feature('forks');
6650                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6651                                \%all_projects_filled];
6652                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6653                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6654         }
6655
6656         if ($cache_lifetime && $stale > 0) {
6657                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6658                         unless $shown_stale_message;
6659                 $shown_stale_message = 1;
6660         }
6661
6662         return @projects;
6663 }
6664
6665 sub fill_project_list_info_uncached {
6666         my ($projlist, @wanted_keys) = @_;
6667         my @projects;
6668         my $filter_set = sub { return @_; };
6669         if (@wanted_keys) {
6670                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6671                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6672         }
6673
6674         my $show_ctags = gitweb_check_feature('ctags');
6675  PROJECT:
6676         foreach my $pr (@$projlist) {
6677                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6678                         my (@activity) = git_get_last_activity($pr->{'path'});
6679                         unless (@activity) {
6680                                 next PROJECT;
6681                         }
6682                         ($pr->{'age_epoch'}) = @activity;
6683                 }
6684                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6685                         my $descr = git_get_project_description($pr->{'path'}) || "";
6686                         $descr = to_utf8($descr);
6687                         $pr->{'descr_long'} = $descr;
6688                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6689                 }
6690                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6691                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6692                 }
6693                 if ($show_ctags &&
6694                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6695                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6696                 }
6697                 if ($projects_list_group_categories &&
6698                     project_info_needs_filling($pr, $filter_set->('category'))) {
6699                         my $cat = git_get_project_category($pr->{'path'}) ||
6700                                                            $project_list_default_category;
6701                         $pr->{'category'} = to_utf8($cat);
6702                 }
6703
6704                 push @projects, $pr;
6705         }
6706
6707         return @projects;
6708 }
6709
6710 sub sort_projects_list {
6711         my ($projlist, $order) = @_;
6712
6713         sub order_str {
6714                 my $key = shift;
6715                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6716         }
6717
6718         sub order_reverse_num_then_undef {
6719                 my $key = shift;
6720                 return sub {
6721                         defined $a->{$key} ?
6722                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6723                                 (defined $b->{$key} ? 1 : 0)
6724                 };
6725         }
6726
6727         my %orderings = (
6728                 project => order_str('path'),
6729                 descr => order_str('descr_long'),
6730                 owner => order_str('owner'),
6731                 age => order_reverse_num_then_undef('age_epoch'),
6732         );
6733
6734         my $ordering = $orderings{$order};
6735         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6736 }
6737
6738 # returns a hash of categories, containing the list of project
6739 # belonging to each category
6740 sub build_projlist_by_category {
6741         my ($projlist, $from, $to) = @_;
6742         my %categories;
6743
6744         $from = 0 unless defined $from;
6745         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6746
6747         for (my $i = $from; $i <= $to; $i++) {
6748                 my $pr = $projlist->[$i];
6749                 push @{$categories{ $pr->{'category'} }}, $pr;
6750         }
6751
6752         return wantarray ? %categories : \%categories;
6753 }
6754
6755 # print 'sort by' <th> element, generating 'sort by $name' replay link
6756 # if that order is not selected
6757 sub print_sort_th {
6758         print format_sort_th(@_);
6759 }
6760
6761 sub format_sort_th {
6762         my ($name, $order, $header) = @_;
6763         my $sort_th = "";
6764         $header ||= ucfirst($name);
6765
6766         if ($order eq $name) {
6767                 $sort_th .= "<th>$header</th>\n";
6768         } else {
6769                 $sort_th .= "<th>" .
6770                             $cgi->a({-href => href(-replay=>1, order=>$name),
6771                                      -class => "header"}, $header) .
6772                             "</th>\n";
6773         }
6774
6775         return $sort_th;
6776 }
6777
6778 sub git_project_list_rows {
6779         my ($projlist, $from, $to, $check_forks) = @_;
6780
6781         $from = 0 unless defined $from;
6782         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6783
6784         my $now = time;
6785         my $alternate = 1;
6786         for (my $i = $from; $i <= $to; $i++) {
6787                 my $pr = $projlist->[$i];
6788
6789                 if ($alternate) {
6790                         print "<tr class=\"dark\">\n";
6791                 } else {
6792                         print "<tr class=\"light\">\n";
6793                 }
6794                 $alternate ^= 1;
6795
6796                 if ($check_forks) {
6797                         print "<td>";
6798                         if ($pr->{'forks'}) {
6799                                 my $nforks = scalar @{$pr->{'forks'}};
6800                                 my $s = $nforks == 1 ? '' : 's';
6801                                 if ($nforks > 0) {
6802                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6803                                                        -title => "$nforks fork$s"}, "+");
6804                                 } else {
6805                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6806                                 }
6807                         }
6808                         print "</td>\n";
6809                 }
6810                 my $path = $pr->{'path'};
6811                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6812                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6813                                         -class => "list"},
6814                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6815                       "</td>\n" .
6816                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6817                                         -class => "list",
6818                                         -title => $pr->{'descr_long'}},
6819                                         $search_regexp
6820                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6821                                                                     $pr->{'descr'}, $search_regexp)
6822                                         : esc_html($pr->{'descr'})) .
6823                       "</td>\n";
6824                 unless ($omit_owner) {
6825                         print "<td><i>" . ($owner_link_hook
6826                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6827                                                     chop_and_escape_str($pr->{'owner'}, 15))
6828                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6829                 }
6830                 unless ($omit_age_column) {
6831                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6832                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6833                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6834                 }
6835                 print"<td class=\"link\">" .
6836                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
6837                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . " | " .
6838                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6839                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6840                       "</td>\n" .
6841                       "</tr>\n";
6842         }
6843 }
6844
6845 sub git_project_list_body {
6846         # actually uses global variable $project
6847         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
6848         my @projects = @$projlist;
6849
6850         my $check_forks = gitweb_check_feature('forks');
6851         my $show_ctags  = gitweb_check_feature('ctags');
6852         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6853         $check_forks = undef
6854                 if ($tagfilter || $search_regexp);
6855
6856         # filtering out forks before filling info allows us to do less work
6857         if ($check_forks) {
6858                 @projects = filter_forks_from_projects_list(\@projects);
6859                 push @projects, { 'path' => "$project_filter.git" }
6860                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
6861         }
6862         # search_projects_list pre-fills required info
6863         @projects = search_projects_list(\@projects,
6864                                          'search_regexp' => $search_regexp,
6865                                          'tagfilter'  => $tagfilter)
6866                 if ($tagfilter || $search_regexp);
6867         # fill the rest
6868         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6869         push @all_fields, 'age_epoch' unless($omit_age_column);
6870         push @all_fields, 'owner' unless($omit_owner);
6871         @projects = fill_project_list_info(\@projects, @all_fields);
6872
6873         $order ||= $default_projects_order;
6874         $from = 0 unless defined $from;
6875         $to = $#projects if (!defined $to || $#projects < $to);
6876
6877         # short circuit
6878         if ($from > $to) {
6879                 print "<center>\n".
6880                       "<b>No such projects found</b><br />\n".
6881                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
6882                       "</center>\n<br />\n";
6883                 return;
6884         }
6885
6886         @projects = sort_projects_list(\@projects, $order);
6887
6888         if ($show_ctags) {
6889                 my $ctags = git_gather_all_ctags(\@projects);
6890                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
6891                 print git_show_project_tagcloud($cloud, 64);
6892         }
6893
6894         print "<table class=\"project_list\">\n";
6895         unless ($no_header) {
6896                 print "<tr>\n";
6897                 if ($check_forks) {
6898                         print "<th></th>\n";
6899                 }
6900                 print_sort_th('project', $order, 'Project');
6901                 print_sort_th('descr', $order, 'Description');
6902                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
6903                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
6904                 print "<th></th>\n" . # for links
6905                       "</tr>\n";
6906         }
6907
6908         if ($projects_list_group_categories) {
6909                 # only display categories with projects in the $from-$to window
6910                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
6911                 my %categories = build_projlist_by_category(\@projects, $from, $to);
6912                 foreach my $cat (sort keys %categories) {
6913                         unless ($cat eq "") {
6914                                 print "<tr>\n";
6915                                 if ($check_forks) {
6916                                         print "<td></td>\n";
6917                                 }
6918                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
6919                                 print "</tr>\n";
6920                         }
6921
6922                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
6923                 }
6924         } else {
6925                 git_project_list_rows(\@projects, $from, $to, $check_forks);
6926         }
6927
6928         if (defined $extra) {
6929                 print "<tr>\n";
6930                 if ($check_forks) {
6931                         print "<td></td>\n";
6932                 }
6933                 print "<td colspan=\"5\">$extra</td>\n" .
6934                       "</tr>\n";
6935         }
6936         print "</table>\n";
6937 }
6938
6939 sub git_log_body {
6940         # uses global variable $project
6941         my ($commitlist, $from, $to, $refs, $extra) = @_;
6942
6943         $from = 0 unless defined $from;
6944         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6945
6946         for (my $i = 0; $i <= $to; $i++) {
6947                 my %co = %{$commitlist->[$i]};
6948                 next if !%co;
6949                 my $commit = $co{'id'};
6950                 my $ref = format_ref_marker($refs, $commit);
6951                 git_print_header_div('commit',
6952                                "<span class=\"age\">$co{'age_string'}</span>" .
6953                                esc_html($co{'title'}),
6954                                $commit, undef, $ref);
6955                 print "<div class=\"title_text\">\n" .
6956                       "<div class=\"log_link\">\n" .
6957                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
6958                       " | " .
6959                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
6960                       " | " .
6961                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
6962                       "<br/>\n" .
6963                       "</div>\n";
6964                       git_print_authorship(\%co, -tag => 'span');
6965                       print "<br/>\n</div>\n";
6966
6967                 print "<div class=\"log_body\">\n";
6968                 git_print_log($co{'comment'}, -final_empty_line=> 1);
6969                 print "</div>\n";
6970         }
6971         if ($extra) {
6972                 print "<div class=\"page_nav\">\n";
6973                 print "$extra\n";
6974                 print "</div>\n";
6975         }
6976 }
6977
6978 sub git_shortlog_body {
6979         # uses global variable $project
6980         my ($commitlist, $from, $to, $refs, $extra) = @_;
6981
6982         $from = 0 unless defined $from;
6983         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6984
6985         print "<table class=\"shortlog\">\n";
6986         my $alternate = 1;
6987         for (my $i = $from; $i <= $to; $i++) {
6988                 my %co = %{$commitlist->[$i]};
6989                 my $commit = $co{'id'};
6990                 my $ref = format_ref_marker($refs, $commit);
6991                 if ($alternate) {
6992                         print "<tr class=\"dark\">\n";
6993                 } else {
6994                         print "<tr class=\"light\">\n";
6995                 }
6996                 $alternate ^= 1;
6997                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
6998                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6999                       format_author_html('td', \%co, 10) . "<td>";
7000                 print format_subject_html($co{'title'}, $co{'title_short'},
7001                                           href(action=>"commit", hash=>$commit), $ref);
7002                 print "</td>\n" .
7003                       "<td class=\"link\">" .
7004                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
7005                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
7006                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7007                 my $snapshot_links = format_snapshot_links($commit);
7008                 if (defined $snapshot_links) {
7009                         print " | " . $snapshot_links;
7010                 }
7011                 print "</td>\n" .
7012                       "</tr>\n";
7013         }
7014         if (defined $extra) {
7015                 print "<tr>\n" .
7016                       "<td colspan=\"4\">$extra</td>\n" .
7017                       "</tr>\n";
7018         }
7019         print "</table>\n";
7020 }
7021
7022 sub git_history_body {
7023         # Warning: assumes constant type (blob or tree) during history
7024         my ($commitlist, $from, $to, $refs, $extra,
7025             $file_name, $file_hash, $ftype) = @_;
7026
7027         $from = 0 unless defined $from;
7028         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7029
7030         print "<table class=\"history\">\n";
7031         my $alternate = 1;
7032         for (my $i = $from; $i <= $to; $i++) {
7033                 my %co = %{$commitlist->[$i]};
7034                 if (!%co) {
7035                         next;
7036                 }
7037                 my $commit = $co{'id'};
7038
7039                 my $ref = format_ref_marker($refs, $commit);
7040
7041                 if ($alternate) {
7042                         print "<tr class=\"dark\">\n";
7043                 } else {
7044                         print "<tr class=\"light\">\n";
7045                 }
7046                 $alternate ^= 1;
7047                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7048         # shortlog:   format_author_html('td', \%co, 10)
7049                       format_author_html('td', \%co, 15, 3) . "<td>";
7050                 # originally git_history used chop_str($co{'title'}, 50)
7051                 print format_subject_html($co{'title'}, $co{'title_short'},
7052                                           href(action=>"commit", hash=>$commit), $ref);
7053                 print "</td>\n" .
7054                       "<td class=\"link\">" .
7055                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
7056                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7057
7058                 if ($ftype eq 'blob') {
7059                         my $blob_current = $file_hash;
7060                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7061                         if (defined $blob_current && defined $blob_parent &&
7062                                         $blob_current ne $blob_parent) {
7063                                 print " | " .
7064                                         $cgi->a({-href => href(action=>"blobdiff",
7065                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7066                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7067                                                                file_name=>$file_name)},
7068                                                 "diff to current");
7069                         }
7070                 }
7071                 print "</td>\n" .
7072                       "</tr>\n";
7073         }
7074         if (defined $extra) {
7075                 print "<tr>\n" .
7076                       "<td colspan=\"4\">$extra</td>\n" .
7077                       "</tr>\n";
7078         }
7079         print "</table>\n";
7080 }
7081
7082 sub git_tags_body {
7083         # uses global variable $project
7084         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7085         $from = 0 unless defined $from;
7086         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7087         $order ||= $default_refs_order;
7088
7089         print "<table class=\"tags\">\n";
7090         if ($full) {
7091                 print "<tr class=\"tags_header\">\n";
7092                 print_sort_th('age', $order, 'Last Change');
7093                 print_sort_th('name', $order, 'Name');
7094                 print "<th></th>\n" . # for comment
7095                       "<th></th>\n" . # for tag
7096                       "<th></th>\n" . # for links
7097                       "</tr>\n";
7098         }
7099         my $alternate = 1;
7100         for (my $i = $from; $i <= $to; $i++) {
7101                 my $entry = $taglist->[$i];
7102                 my %tag = %$entry;
7103                 my $comment = $tag{'subject'};
7104                 my $comment_short;
7105                 if (defined $comment) {
7106                         $comment_short = chop_str($comment, 30, 5);
7107                 }
7108                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7109                 if ($alternate) {
7110                         print "<tr class=\"dark\">\n";
7111                 } else {
7112                         print "<tr class=\"light\">\n";
7113                 }
7114                 $alternate ^= 1;
7115                 if (defined $tag{'age'}) {
7116                         print "<td><i>$tag{'age'}</i></td>\n";
7117                 } else {
7118                         print "<td></td>\n";
7119                 }
7120                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7121                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7122                                -class => "list name"}, esc_html($tag{'name'})) .
7123                       "</td>\n" .
7124                       "<td>");
7125                 if (defined $comment) {
7126                         print format_subject_html($comment, $comment_short,
7127                                                   href(action=>"tag", hash=>$tag{'id'}));
7128                 }
7129                 print "</td>\n" .
7130                       "<td class=\"selflink\">";
7131                 if ($tag{'type'} eq "tag") {
7132                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7133                 } else {
7134                         print "&#160;";
7135                 }
7136                 print "</td>\n" .
7137                       "<td class=\"link\">" . " | " .
7138                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7139                 if ($tag{'reftype'} eq "commit") {
7140                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7141                         print " | " . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7142                 } elsif ($tag{'reftype'} eq "blob") {
7143                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7144                 }
7145                 print "</td>\n" .
7146                       "</tr>";
7147         }
7148         if (defined $extra) {
7149                 print "<tr>\n" .
7150                       "<td colspan=\"5\">$extra</td>\n" .
7151                       "</tr>\n";
7152         }
7153         print "</table>\n";
7154 }
7155
7156 sub git_heads_body {
7157         # uses global variable $project
7158         my ($headlist, $head_at, $from, $to, $extra) = @_;
7159         $from = 0 unless defined $from;
7160         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7161
7162         print "<table class=\"heads\">\n";
7163         my $alternate = 1;
7164         for (my $i = $from; $i <= $to; $i++) {
7165                 my $entry = $headlist->[$i];
7166                 my %ref = %$entry;
7167                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7168                 if ($alternate) {
7169                         print "<tr class=\"dark\">\n";
7170                 } else {
7171                         print "<tr class=\"light\">\n";
7172                 }
7173                 $alternate ^= 1;
7174                 print "<td><i>$ref{'age'}</i></td>\n" .
7175                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7176                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7177                                -class => "list name"},esc_html($ref{'name'})) .
7178                       "</td>\n" .
7179                       "<td class=\"link\">" .
7180                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . " | " .
7181                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7182                       "</td>\n" .
7183                       "</tr>";
7184         }
7185         if (defined $extra) {
7186                 print "<tr>\n" .
7187                       "<td colspan=\"3\">$extra</td>\n" .
7188                       "</tr>\n";
7189         }
7190         print "</table>\n";
7191 }
7192
7193 # Display a single remote block
7194 sub git_remote_block {
7195         my ($remote, $rdata, $limit, $head) = @_;
7196
7197         my $heads = $rdata->{'heads'};
7198         my $fetch = $rdata->{'fetch'};
7199         my $push = $rdata->{'push'};
7200
7201         my $urls_table = "<table class=\"projects_list\">\n" ;
7202
7203         if (defined $fetch) {
7204                 if ($fetch eq $push) {
7205                         $urls_table .= format_repo_url("URL", $fetch);
7206                 } else {
7207                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7208                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7209                 }
7210         } elsif (defined $push) {
7211                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7212         } else {
7213                 $urls_table .= format_repo_url("", "No remote URL");
7214         }
7215
7216         $urls_table .= "</table>\n";
7217
7218         my $dots;
7219         if (defined $limit && $limit < @$heads) {
7220                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7221         }
7222
7223         print $urls_table;
7224         git_heads_body($heads, $head, 0, $limit, $dots);
7225 }
7226
7227 # Display a list of remote names with the respective fetch and push URLs
7228 sub git_remotes_list {
7229         my ($remotedata, $limit) = @_;
7230         print "<table class=\"heads\">\n";
7231         my $alternate = 1;
7232         my @remotes = sort keys %$remotedata;
7233
7234         my $limited = $limit && $limit < @remotes;
7235
7236         $#remotes = $limit - 1 if $limited;
7237
7238         while (my $remote = shift @remotes) {
7239                 my $rdata = $remotedata->{$remote};
7240                 my $fetch = $rdata->{'fetch'};
7241                 my $push = $rdata->{'push'};
7242                 if ($alternate) {
7243                         print "<tr class=\"dark\">\n";
7244                 } else {
7245                         print "<tr class=\"light\">\n";
7246                 }
7247                 $alternate ^= 1;
7248                 print "<td>" .
7249                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7250                                -class=> "list name"},esc_html($remote)) .
7251                       "</td>";
7252                 print "<td class=\"link\">" .
7253                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7254                       " | " .
7255                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7256                       "</td>";
7257
7258                 print "</tr>\n";
7259         }
7260
7261         if ($limited) {
7262                 print "<tr>\n" .
7263                       "<td colspan=\"3\">" .
7264                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7265                       "</td>\n" . "</tr>\n";
7266         }
7267
7268         print "</table>";
7269 }
7270
7271 # Display remote heads grouped by remote, unless there are too many
7272 # remotes, in which case we only display the remote names
7273 sub git_remotes_body {
7274         my ($remotedata, $limit, $head) = @_;
7275         if ($limit and $limit < keys %$remotedata) {
7276                 git_remotes_list($remotedata, $limit);
7277         } else {
7278                 fill_remote_heads($remotedata);
7279                 while (my ($remote, $rdata) = each %$remotedata) {
7280                         git_print_section({-class=>"remote", -id=>$remote},
7281                                 ["remotes", $remote, $remote], sub {
7282                                         git_remote_block($remote, $rdata, $limit, $head);
7283                                 });
7284                 }
7285         }
7286 }
7287
7288 sub git_search_message {
7289         my %co = @_;
7290
7291         my $greptype;
7292         if ($searchtype eq 'commit') {
7293                 $greptype = "--grep=";
7294         } elsif ($searchtype eq 'author') {
7295                 $greptype = "--author=";
7296         } elsif ($searchtype eq 'committer') {
7297                 $greptype = "--committer=";
7298         }
7299         $greptype .= $searchtext;
7300         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7301                                        $greptype, '--regexp-ignore-case',
7302                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7303
7304         my $paging_nav = '';
7305         if ($page > 0) {
7306                 $paging_nav .=
7307                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7308                                 "first") .
7309                         " &#183; " .
7310                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7311                                  -accesskey => "p", -title => "Alt-p"}, "prev");
7312         } else {
7313                 $paging_nav .= "first &#183; prev";
7314         }
7315         my $next_link = '';
7316         if ($#commitlist >= 100) {
7317                 $next_link =
7318                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7319                                  -accesskey => "n", -title => "Alt-n"}, "next");
7320                 $paging_nav .= " &#183; $next_link";
7321         } else {
7322                 $paging_nav .= " &#183; next";
7323         }
7324
7325         git_header_html();
7326
7327         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
7328         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7329         if ($page == 0 && !@commitlist) {
7330                 print "<p>No match.</p>\n";
7331         } else {
7332                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7333         }
7334
7335         git_footer_html();
7336 }
7337
7338 sub git_search_changes {
7339         my %co = @_;
7340
7341         local $/ = "\n";
7342         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7343                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7344                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7345                         or die_error(500, "Open git-log failed");
7346
7347         git_header_html();
7348
7349         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7350         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7351
7352         print "<table class=\"pickaxe search\">\n";
7353         my $alternate = 1;
7354         undef %co;
7355         my @files;
7356         while (my $line = to_utf8(scalar <$fd>)) {
7357                 chomp $line;
7358                 next unless $line;
7359
7360                 my %set = parse_difftree_raw_line($line);
7361                 if (defined $set{'commit'}) {
7362                         # finish previous commit
7363                         if (%co) {
7364                                 print "</td>\n" .
7365                                       "<td class=\"link\">" .
7366                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7367                                               "commit") .
7368                                       " | " .
7369                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7370                                                              hash_base=>$co{'id'})},
7371                                               "tree") .
7372                                       "</td>\n" .
7373                                       "</tr>\n";
7374                         }
7375
7376                         if ($alternate) {
7377                                 print "<tr class=\"dark\">\n";
7378                         } else {
7379                                 print "<tr class=\"light\">\n";
7380                         }
7381                         $alternate ^= 1;
7382                         %co = parse_commit($set{'commit'});
7383                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7384                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7385                               "<td><i>$author</i></td>\n" .
7386                               "<td>" .
7387                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7388                                       -class => "list subject"},
7389                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7390                 } elsif (defined $set{'to_id'}) {
7391                         next if ($set{'to_id'} =~ m/^0{40}$/);
7392
7393                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7394                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7395                                       -class => "list"},
7396                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7397                               "<br/>\n";
7398                 }
7399         }
7400         close $fd;
7401
7402         # finish last commit (warning: repetition!)
7403         if (%co) {
7404                 print "</td>\n" .
7405                       "<td class=\"link\">" .
7406                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7407                               "commit") .
7408                       " | " .
7409                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7410                                              hash_base=>$co{'id'})},
7411                               "tree") .
7412                       "</td>\n" .
7413                       "</tr>\n";
7414         }
7415
7416         print "</table>\n";
7417
7418         git_footer_html();
7419 }
7420
7421 sub git_search_files {
7422         my %co = @_;
7423
7424         local $/ = "\n";
7425         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7426                 $search_use_regexp ? ('-E', '-i') : '-F',
7427                 $searchtext, $co{'tree'})
7428                         or die_error(500, "Open git-grep failed");
7429
7430         git_header_html();
7431
7432         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7433         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7434
7435         print "<table class=\"grep_search\">\n";
7436         my $alternate = 1;
7437         my $matches = 0;
7438         my $lastfile = '';
7439         my $file_href;
7440         while (my $line = to_utf8(scalar <$fd>)) {
7441                 chomp $line;
7442                 my ($file, $lno, $ltext, $binary);
7443                 last if ($matches++ > 1000);
7444                 if ($line =~ /^Binary file (.+) matches$/) {
7445                         $file = $1;
7446                         $binary = 1;
7447                 } else {
7448                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7449                         $file =~ s/^$co{'tree'}://;
7450                 }
7451                 if ($file ne $lastfile) {
7452                         $lastfile and print "</td></tr>\n";
7453                         if ($alternate++) {
7454                                 print "<tr class=\"dark\">\n";
7455                         } else {
7456                                 print "<tr class=\"light\">\n";
7457                         }
7458                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7459                                           file_name=>$file);
7460                         print "<td class=\"list\">".
7461                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7462                         print "</td><td>\n";
7463                         $lastfile = $file;
7464                 }
7465                 if ($binary) {
7466                         print "<div class=\"binary\">Binary file</div>\n";
7467                 } else {
7468                         $ltext = untabify($ltext);
7469                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7470                                 $ltext = esc_html($1, -nbsp=>1);
7471                                 $ltext .= '<span class="match">';
7472                                 $ltext .= esc_html($2, -nbsp=>1);
7473                                 $ltext .= '</span>';
7474                                 $ltext .= esc_html($3, -nbsp=>1);
7475                         } else {
7476                                 $ltext = esc_html($ltext, -nbsp=>1);
7477                         }
7478                         print "<div class=\"pre\">" .
7479                                 $cgi->a({-href => $file_href.'#l'.$lno,
7480                                         -class => "linenr"}, sprintf('%4i', $lno)) .
7481                                 ' ' .  $ltext . "</div>\n";
7482                 }
7483         }
7484         if ($lastfile) {
7485                 print "</td></tr>\n";
7486                 if ($matches > 1000) {
7487                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7488                 }
7489         } else {
7490                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7491         }
7492         close $fd;
7493
7494         print "</table>\n";
7495
7496         git_footer_html();
7497 }
7498
7499 sub git_search_grep_body {
7500         my ($commitlist, $from, $to, $extra) = @_;
7501         $from = 0 unless defined $from;
7502         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7503
7504         print "<table class=\"commit_search\">\n";
7505         my $alternate = 1;
7506         for (my $i = $from; $i <= $to; $i++) {
7507                 my %co = %{$commitlist->[$i]};
7508                 if (!%co) {
7509                         next;
7510                 }
7511                 my $commit = $co{'id'};
7512                 if ($alternate) {
7513                         print "<tr class=\"dark\">\n";
7514                 } else {
7515                         print "<tr class=\"light\">\n";
7516                 }
7517                 $alternate ^= 1;
7518                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7519                       format_author_html('td', \%co, 15, 5) .
7520                       "<td>" .
7521                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7522                                -class => "list subject"},
7523                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7524                 my $comment = $co{'comment'};
7525                 foreach my $line (@$comment) {
7526                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7527                                 my ($lead, $match, $trail) = ($1, $2, $3);
7528                                 $match = chop_str($match, 70, 5, 'center');
7529                                 my $contextlen = int((80 - length($match))/2);
7530                                 $contextlen = 30 if ($contextlen > 30);
7531                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7532                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7533
7534                                 $lead  = esc_html($lead);
7535                                 $match = esc_html($match);
7536                                 $trail = esc_html($trail);
7537
7538                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7539                         }
7540                 }
7541                 print "</td>\n" .
7542                       "<td class=\"link\">" .
7543                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7544                       " | " .
7545                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7546                       " | " .
7547                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7548                 print "</td>\n" .
7549                       "</tr>\n";
7550         }
7551         if (defined $extra) {
7552                 print "<tr>\n" .
7553                       "<td colspan=\"3\">$extra</td>\n" .
7554                       "</tr>\n";
7555         }
7556         print "</table>\n";
7557 }
7558
7559 ## ======================================================================
7560 ## ======================================================================
7561 ## actions
7562
7563 sub git_project_list_load {
7564         my $empty_list_ok = shift;
7565         my $order = $input_params{'order'};
7566         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7567                 die_error(400, "Unknown order parameter");
7568         }
7569
7570         my @list = git_get_projects_list($project_filter, $strict_export);
7571         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7572                 push @list, { 'path' => "$project_filter.git" }
7573                         if is_valid_project("$project_filter.git");
7574         }
7575         if (!@list) {
7576                 die_error(404, "No projects found") unless $empty_list_ok;
7577         }
7578
7579         return (\@list, $order);
7580 }
7581
7582 sub git_frontpage {
7583         my ($projlist, $order);
7584
7585         if ($frontpage_no_project_list) {
7586                 $project = undef;
7587                 $project_filter = undef;
7588         } else {
7589                 ($projlist, $order) = git_project_list_load(1);
7590         }
7591         git_header_html();
7592         if (defined $home_text && -f $home_text) {
7593                 print "<div class=\"index_include\">\n";
7594                 insert_file($home_text);
7595                 print "</div>\n";
7596         }
7597         git_project_search_form($searchtext, $search_use_regexp);
7598         if ($frontpage_no_project_list) {
7599                 my $show_ctags = gitweb_check_feature('ctags');
7600                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7601                         my @projects = git_get_projects_list($project_filter, $strict_export);
7602                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7603                         @projects = fill_project_list_info(\@projects, 'ctags');
7604                         my $ctags = git_gather_all_ctags(\@projects);
7605                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7606                         print git_show_project_tagcloud($cloud, 64);
7607                 }
7608         } else {
7609                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7610         }
7611         git_footer_html();
7612 }
7613
7614 sub git_project_list {
7615         my ($projlist, $order) = git_project_list_load();
7616         git_header_html();
7617         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7618                 print "<div class=\"index_include\">\n";
7619                 insert_file($home_text);
7620                 print "</div>\n";
7621         }
7622         git_project_search_form();
7623         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7624         git_footer_html();
7625 }
7626
7627 sub git_forks {
7628         my $order = $input_params{'order'};
7629         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7630                 die_error(400, "Unknown order parameter");
7631         }
7632
7633         my $filter = $project;
7634         $filter =~ s/\.git$//;
7635         my @list = git_get_projects_list($filter);
7636         if (!@list) {
7637                 die_error(404, "No forks found");
7638         }
7639
7640         git_header_html();
7641         git_print_page_nav('','');
7642         git_print_header_div('summary', "$project forks");
7643         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7644         git_footer_html();
7645 }
7646
7647 sub git_project_index {
7648         my @projects = git_get_projects_list($project_filter, $strict_export);
7649         if (!@projects) {
7650                 die_error(404, "No projects found");
7651         }
7652
7653         print $cgi->header(
7654                 -type => 'text/plain',
7655                 -charset => 'utf-8',
7656                 -content_disposition => 'inline; filename="index.aux"');
7657
7658         foreach my $pr (@projects) {
7659                 if (!exists $pr->{'owner'}) {
7660                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7661                 }
7662
7663                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7664                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7665                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7666                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7667                 $path  =~ s/ /\+/g;
7668                 $owner =~ s/ /\+/g;
7669
7670                 print "$path $owner\n";
7671         }
7672 }
7673
7674 sub git_summary {
7675         my $descr = git_get_project_description($project) || "none";
7676         my %co = parse_commit("HEAD");
7677         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7678         my $head = $co{'id'};
7679         my $remote_heads = gitweb_check_feature('remote_heads');
7680
7681         my $owner = git_get_project_owner($project);
7682         my $homepage = git_get_project_config('homepage');
7683         my $base_url = git_get_project_config('baseurl');
7684
7685         my $refs = git_get_references();
7686         # These get_*_list functions return one more to allow us to see if
7687         # there are more ...
7688         my @taglist  = git_get_tags_list(16);
7689         my @headlist = git_get_heads_list(16);
7690         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7691         my @forklist;
7692         my $check_forks = gitweb_check_feature('forks');
7693
7694         if ($check_forks) {
7695                 # find forks of a project
7696                 my $filter = $project;
7697                 $filter =~ s/\.git$//;
7698                 @forklist = git_get_projects_list($filter);
7699                 # filter out forks of forks
7700                 @forklist = filter_forks_from_projects_list(\@forklist)
7701                         if (@forklist);
7702         }
7703
7704         git_header_html();
7705         git_print_page_nav('summary','', $head);
7706
7707         if ($check_forks and $project =~ m#/#) {
7708                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7709                 my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7710                 print <<EOT;
7711 <div class="forkinfo">
7712 This project is a fork of the $r project. If you have that one
7713 already cloned locally, you can use
7714 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7715 to save bandwidth during cloning.
7716 </div>
7717 EOT
7718         }
7719
7720         print "<div class=\"title\">&#160;</div>\n";
7721         print "<table class=\"projects_list\">\n" .
7722               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7723         if ($homepage) {
7724                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7725         }
7726         if ($base_url) {
7727                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7728         }
7729         if ($owner and not $omit_owner) {
7730                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7731                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7732                         : email_obfuscate($owner)) . "</td></tr>\n";
7733         }
7734         if (defined $cd{'rfc2822'}) {
7735                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7736                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7737         }
7738         print format_lastrefresh_row(), "\n";
7739
7740         # use per project git URL list in $projectroot/$project/cloneurl
7741         # or make project git URL from git base URL and project name
7742         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7743         my @url_list = git_get_project_url_list($project);
7744         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7745         foreach my $git_url (@url_list) {
7746                 next unless $git_url;
7747                 print format_repo_url($url_tag, $git_url);
7748                 $url_tag = "";
7749         }
7750         @url_list = map { "$_/$project" } @git_base_push_urls;
7751         if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7752             -f "$projectroot/$project/.nofetch") {
7753                 $url_tag = "push&#160;URL";
7754                 foreach my $git_push_url (@url_list) {
7755                         next unless $git_push_url;
7756                         my $hint = $https_hint_html && $git_push_url =~ /^https:/i ?
7757                                 "&#160;$https_hint_html" : '';
7758                         print "<tr class=\"metadata_pushurl\"><td>$url_tag</td><td>$git_push_url$hint</td></tr>\n";
7759                         $url_tag = "";
7760                 }
7761         }
7762
7763         # Tag cloud
7764         my $show_ctags = gitweb_check_feature('ctags');
7765         if ($show_ctags) {
7766                 my $ctags = git_get_project_ctags($project);
7767                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7768                         # without ability to add tags, don't show if there are none
7769                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7770                         print "<tr id=\"metadata_ctags\">" .
7771                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7772                         print "</td>\n<td>" unless %$ctags;
7773                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7774                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7775                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7776                               unless $show_ctags =~ /^\d+$/;
7777                         print "</td>\n<td>" if %$ctags;
7778                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7779                               "</tr>\n";
7780                 }
7781         }
7782
7783         print "</table>\n";
7784
7785         # If XSS prevention is on, we don't include README.html.
7786         # TODO: Allow a readme in some safe format.
7787         if (!$prevent_xss && -s "$projectroot/$project/README.html") {
7788                 print "<div class=\"title\">readme</div>\n" .
7789                       "<div class=\"readme\">\n";
7790                 insert_file("$projectroot/$project/README.html");
7791                 print "\n</div>\n"; # class="readme"
7792         }
7793
7794         # we need to request one more than 16 (0..15) to check if
7795         # those 16 are all
7796         my @commitlist = $head ? parse_commits($head, 17) : ();
7797         if (@commitlist) {
7798                 git_print_header_div('shortlog');
7799                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7800                                   $#commitlist <=  15 ? undef :
7801                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7802         }
7803
7804         if (@taglist) {
7805                 git_print_header_div('tags');
7806                 git_tags_body(\@taglist, 0, 15,
7807                               $#taglist <=  15 ? undef :
7808                               $cgi->a({-href => href(action=>"tags")}, "..."));
7809         }
7810
7811         if (@headlist) {
7812                 git_print_header_div('heads');
7813                 git_heads_body(\@headlist, $head, 0, 15,
7814                                $#headlist <= 15 ? undef :
7815                                $cgi->a({-href => href(action=>"heads")}, "..."));
7816         }
7817
7818         if (%remotedata) {
7819                 git_print_header_div('remotes');
7820                 git_remotes_body(\%remotedata, 15, $head);
7821         }
7822
7823         if (@forklist) {
7824                 git_print_header_div('forks');
7825                 git_project_list_body(\@forklist, 'age', 0, 15,
7826                                       $#forklist <= 15 ? undef :
7827                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7828                                       'no_header', 'forks');
7829         }
7830
7831         git_footer_html();
7832 }
7833
7834 sub git_tag {
7835         my %tag = parse_tag($hash);
7836
7837         if (! %tag) {
7838                 die_error(404, "Unknown tag object");
7839         }
7840
7841         my $fullhash;
7842         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
7843         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
7844
7845         my $head = git_get_head_hash($project);
7846         git_header_html();
7847         git_print_page_nav('','', $head,undef,$head);
7848         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
7849         print "<div class=\"title_text\">\n" .
7850               "<table class=\"object_header\">\n" .
7851               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
7852               "<tr>\n" .
7853               "<td>object</td>\n" .
7854               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7855                                $tag{'object'}) . "</td>\n" .
7856               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7857                                               $tag{'type'}) . "</td>\n" .
7858               "</tr>\n";
7859         if (defined($tag{'author'})) {
7860                 git_print_authorship_rows(\%tag, 'author');
7861         }
7862         print "</table>\n\n" .
7863               "</div>\n";
7864         print "<div class=\"page_body\">";
7865         my $comment = $tag{'comment'};
7866         foreach my $line (@$comment) {
7867                 chomp $line;
7868                 print esc_html($line, -nbsp=>1) . "<br/>\n";
7869         }
7870         print "</div>\n";
7871         git_footer_html();
7872 }
7873
7874 sub git_blame_common {
7875         my $format = shift || 'porcelain';
7876         if ($format eq 'porcelain' && $input_params{'javascript'}) {
7877                 $format = 'incremental';
7878                 $action = 'blame_incremental'; # for page title etc
7879         }
7880
7881         # permissions
7882         gitweb_check_feature('blame')
7883                 or die_error(403, "Blame view not allowed");
7884
7885         # error checking
7886         die_error(400, "No file name given") unless $file_name;
7887         $hash_base ||= git_get_head_hash($project);
7888         die_error(404, "Couldn't find base commit") unless $hash_base;
7889         my %co = parse_commit($hash_base)
7890                 or die_error(404, "Commit not found");
7891         my $ftype = "blob";
7892         if (!defined $hash) {
7893                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
7894                         or die_error(404, "Error looking up file");
7895         } else {
7896                 $ftype = git_get_type($hash);
7897                 if ($ftype !~ "blob") {
7898                         die_error(400, "Object is not a blob");
7899                 }
7900         }
7901
7902         my $fd;
7903         if ($format eq 'incremental') {
7904                 # get file contents (as base)
7905                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
7906                         or die_error(500, "Open git-cat-file failed");
7907         } elsif ($format eq 'data') {
7908                 # run git-blame --incremental
7909                 defined($fd = git_cmd_pipe "blame", "--incremental",
7910                         $hash_base, "--", $file_name)
7911                         or die_error(500, "Open git-blame --incremental failed");
7912         } else {
7913                 # run git-blame --porcelain
7914                 defined($fd = git_cmd_pipe "blame", '-p',
7915                         $hash_base, '--', $file_name)
7916                         or die_error(500, "Open git-blame --porcelain failed");
7917         }
7918
7919         # incremental blame data returns early
7920         if ($format eq 'data') {
7921                 print $cgi->header(
7922                         -type=>"text/plain", -charset => "utf-8",
7923                         -status=> "200 OK");
7924                 local $| = 1; # output autoflush
7925                 while (<$fd>) {
7926                         print to_utf8($_);
7927                 }
7928                 close $fd
7929                         or print "ERROR $!\n";
7930
7931                 print 'END';
7932                 if (defined $t0 && gitweb_check_feature('timed')) {
7933                         print ' '.
7934                               tv_interval($t0, [ gettimeofday() ]).
7935                               ' '.$number_of_git_cmds;
7936                 }
7937                 print "\n";
7938
7939                 return;
7940         }
7941
7942         # page header
7943         git_header_html();
7944         my $formats_nav =
7945                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
7946                         "blob");
7947         $formats_nav .=
7948                 " | " .
7949                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7950                         "history") .
7951                 " | " .
7952                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
7953                         "HEAD");
7954         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7955         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7956         git_print_page_path($file_name, $ftype, $hash_base);
7957
7958         # page body
7959         if ($format eq 'incremental') {
7960                 print "<noscript>\n<div class=\"error\"><center><b>\n".
7961                       "This page requires JavaScript to run.\n Use ".
7962                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
7963                               'this page').
7964                       " instead.\n".
7965                       "</b></center></div>\n</noscript>\n";
7966
7967                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
7968         }
7969
7970         print qq!<div class="page_body">\n!;
7971         print qq!<div id="progress_info">... / ...</div>\n!
7972                 if ($format eq 'incremental');
7973         print qq!<table id="blame_table" class="blame" width="100%">\n!.
7974               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
7975               qq!<thead>\n!.
7976               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
7977               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
7978               qq!title="toggles blame author information display">[+]</a></th>!.
7979               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
7980               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
7981               qq!</thead>\n!.
7982               qq!<tbody>\n!;
7983
7984         my @rev_color = qw(light dark);
7985         my $num_colors = scalar(@rev_color);
7986         my $current_color = 0;
7987
7988         if ($format eq 'incremental') {
7989                 my $color_class = $rev_color[$current_color];
7990
7991                 #contents of a file
7992                 my $linenr = 0;
7993         LINE:
7994                 while (my $line = to_utf8(scalar <$fd>)) {
7995                         chomp $line;
7996                         $linenr++;
7997
7998                         print qq!<tr id="l$linenr" class="$color_class">!.
7999                               qq!<td class="sha1"><a href=""> </a></td>!.
8000                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8001                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8002                               qq!<td class="linenr">!.
8003                               qq!<a class="linenr" href="">$linenr</a></td>!;
8004                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8005                         print qq!</tr>\n!;
8006                 }
8007
8008         } else { # porcelain, i.e. ordinary blame
8009                 my %metainfo = (); # saves information about commits
8010
8011                 # blame data
8012         LINE:
8013                 while (my $line = to_utf8(scalar <$fd>)) {
8014                         chomp $line;
8015                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8016                         # no <lines in group> for subsequent lines in group of lines
8017                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8018                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8019                         if (!exists $metainfo{$full_rev}) {
8020                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8021                         }
8022                         my $meta = $metainfo{$full_rev};
8023                         my $data;
8024                         while ($data = to_utf8(scalar <$fd>)) {
8025                                 chomp $data;
8026                                 last if ($data =~ s/^\t//); # contents of line
8027                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8028                                         $meta->{$1} = $2 unless exists $meta->{$1};
8029                                 }
8030                                 if ($data =~ /^previous /) {
8031                                         $meta->{'nprevious'}++;
8032                                 }
8033                         }
8034                         my $short_rev = substr($full_rev, 0, 8);
8035                         my $author = $meta->{'author'};
8036                         my %date =
8037                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8038                         my $date = $date{'iso-tz'};
8039                         if ($group_size) {
8040                                 $current_color = ($current_color + 1) % $num_colors;
8041                         }
8042                         my $tr_class = $rev_color[$current_color];
8043                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8044                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8045                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8046                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8047                         if ($group_size) {
8048                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8049                                 print "<td class=\"sha1\"";
8050                                 print " title=\"". esc_html($author) . ", $date\"";
8051                                 print "$rowspan>";
8052                                 print $cgi->a({-href => href(action=>"commit",
8053                                                              hash=>$full_rev,
8054                                                              file_name=>$file_name)},
8055                                               esc_html($short_rev));
8056                                 if ($group_size >= 2) {
8057                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8058                                         if (@author_initials) {
8059                                                 print "<br />" .
8060                                                       esc_html(join('', @author_initials));
8061                                                 #           or join('.', ...)
8062                                         }
8063                                 }
8064                                 print "</td>\n";
8065                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8066                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8067                         }
8068                         # 'previous' <sha1 of parent commit> <filename at commit>
8069                         if (exists $meta->{'previous'} &&
8070                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8071                                 $meta->{'parent'} = $1;
8072                                 $meta->{'file_parent'} = unquote($2);
8073                         }
8074                         my $linenr_commit =
8075                                 exists($meta->{'parent'}) ?
8076                                 $meta->{'parent'} : $full_rev;
8077                         my $linenr_filename =
8078                                 exists($meta->{'file_parent'}) ?
8079                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8080                         my $blamed = href(action => 'blame',
8081                                           file_name => $linenr_filename,
8082                                           hash_base => $linenr_commit);
8083                         print "<td class=\"linenr\">";
8084                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8085                                         -class => "linenr" },
8086                                       esc_html($lineno));
8087                         print "</td>";
8088                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8089                         print "</tr>\n";
8090                 } # end while
8091
8092         }
8093
8094         # footer
8095         print "</tbody>\n".
8096               "</table>\n"; # class="blame"
8097         print "</div>\n";   # class="blame_body"
8098         close $fd
8099                 or print "Reading blob failed\n";
8100
8101         git_footer_html();
8102 }
8103
8104 sub git_blame {
8105         git_blame_common();
8106 }
8107
8108 sub git_blame_incremental {
8109         git_blame_common('incremental');
8110 }
8111
8112 sub git_blame_data {
8113         git_blame_common('data');
8114 }
8115
8116 sub git_tags {
8117         my $head = git_get_head_hash($project);
8118         git_header_html();
8119         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8120         git_print_header_div('summary', $project);
8121
8122         my @tagslist = git_get_tags_list();
8123         if (@tagslist) {
8124                 git_tags_body(\@tagslist);
8125         }
8126         git_footer_html();
8127 }
8128
8129 sub git_refs {
8130         my $order = $input_params{'order'};
8131         if (defined $order && $order !~ m/age|name/) {
8132                 die_error(400, "Unknown order parameter");
8133         }
8134
8135         my $head = git_get_head_hash($project);
8136         git_header_html();
8137         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8138         git_print_header_div('summary', $project);
8139
8140         my @refslist = git_get_tags_list(undef, 1, $order);
8141         if (@refslist) {
8142                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8143         }
8144         git_footer_html();
8145 }
8146
8147 sub git_heads {
8148         my $head = git_get_head_hash($project);
8149         git_header_html();
8150         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8151         git_print_header_div('summary', $project);
8152
8153         my @headslist = git_get_heads_list();
8154         if (@headslist) {
8155                 git_heads_body(\@headslist, $head);
8156         }
8157         git_footer_html();
8158 }
8159
8160 # used both for single remote view and for list of all the remotes
8161 sub git_remotes {
8162         gitweb_check_feature('remote_heads')
8163                 or die_error(403, "Remote heads view is disabled");
8164
8165         my $head = git_get_head_hash($project);
8166         my $remote = $input_params{'hash'};
8167
8168         my $remotedata = git_get_remotes_list($remote);
8169         die_error(500, "Unable to get remote information") unless defined $remotedata;
8170
8171         unless (%$remotedata) {
8172                 die_error(404, defined $remote ?
8173                         "Remote $remote not found" :
8174                         "No remotes found");
8175         }
8176
8177         git_header_html(undef, undef, -action_extra => $remote);
8178         git_print_page_nav('', '',  $head, undef, $head,
8179                 format_ref_views($remote ? '' : 'remotes'));
8180
8181         fill_remote_heads($remotedata);
8182         if (defined $remote) {
8183                 git_print_header_div('remotes', "$remote remote for $project");
8184                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8185         } else {
8186                 git_print_header_div('summary', "$project remotes");
8187                 git_remotes_body($remotedata, undef, $head);
8188         }
8189
8190         git_footer_html();
8191 }
8192
8193 sub git_blob_plain {
8194         my $type = shift;
8195         my $expires;
8196
8197         if (!defined $hash) {
8198                 if (defined $file_name) {
8199                         my $base = $hash_base || git_get_head_hash($project);
8200                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8201                                 or die_error(404, "Cannot find file");
8202                 } else {
8203                         die_error(400, "No file name defined");
8204                 }
8205         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8206                 # blobs defined by non-textual hash id's can be cached
8207                 $expires = "+1d";
8208         }
8209
8210         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8211                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8212         binmode($fd);
8213
8214         # content-type (can include charset)
8215         my $leader;
8216         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8217
8218         # "save as" filename, even when no $file_name is given
8219         my $save_as = "$hash";
8220         if (defined $file_name) {
8221                 $save_as = $file_name;
8222         } elsif ($type =~ m/^text\//) {
8223                 $save_as .= '.txt';
8224         }
8225
8226         # With XSS prevention on, blobs of all types except a few known safe
8227         # ones are served with "Content-Disposition: attachment" to make sure
8228         # they don't run in our security domain.  For certain image types,
8229         # blob view writes an <img> tag referring to blob_plain view, and we
8230         # want to be sure not to break that by serving the image as an
8231         # attachment (though Firefox 3 doesn't seem to care).
8232         my $sandbox = $prevent_xss &&
8233                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8234
8235         # serve text/* as text/plain
8236         if ($prevent_xss &&
8237             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8238              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8239                 my $rest = $1;
8240                 $rest = defined $rest ? $rest : '';
8241                 $type = "text/plain$rest";
8242         }
8243
8244         print $cgi->header(
8245                 -type => $type,
8246                 -expires => $expires,
8247                 -content_disposition =>
8248                         ($sandbox ? 'attachment' : 'inline')
8249                         . '; filename="' . $save_as . '"');
8250         binmode STDOUT, ':raw';
8251         $fcgi_raw_mode = 1;
8252         print $leader if defined $leader;
8253         my $buf;
8254         while (read($fd, $buf, 32768)) {
8255                 print $buf;
8256         }
8257         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8258         $fcgi_raw_mode = 0;
8259         close $fd;
8260 }
8261
8262 sub git_blob {
8263         my $expires;
8264
8265         my $fullhash;
8266         if (!defined $hash) {
8267                 if (defined $file_name) {
8268                         my $base = $hash_base || git_get_head_hash($project);
8269                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8270                                 or die_error(404, "Cannot find file");
8271                         $fullhash = $hash;
8272                 } else {
8273                         die_error(400, "No file name defined");
8274                 }
8275         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8276                 # blobs defined by non-textual hash id's can be cached
8277                 $expires = "+1d";
8278                 $fullhash = $hash;
8279         }
8280         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8281
8282         my $have_blame = gitweb_check_feature('blame');
8283         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8284                 or die_error(500, "Couldn't cat $file_name, $hash");
8285         binmode($fd);
8286         my $mimetype = blob_mimetype($fd, $file_name);
8287         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8288         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8289                 close $fd;
8290                 return git_blob_plain($mimetype);
8291         }
8292         # we can have blame only for text/* mimetype
8293         $have_blame &&= ($mimetype =~ m!^text/!);
8294
8295         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8296         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8297         my $highlight_mode_active;
8298         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8299
8300         git_header_html(undef, $expires);
8301         my $formats_nav = '';
8302         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8303                 if (defined $file_name) {
8304                         if ($have_blame) {
8305                                 $formats_nav .=
8306                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8307                                                 -class => "blamelink"},
8308                                                 "blame") .
8309                                         " | ";
8310                         }
8311                         $formats_nav .=
8312                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8313                                         "history") .
8314                                 " | " .
8315                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8316                                         "raw") .
8317                                 " | " .
8318                                 $cgi->a({-href => href(action=>"blob",
8319                                                        hash_base=>"HEAD", file_name=>$file_name)},
8320                                         "HEAD");
8321                 } else {
8322                         $formats_nav .=
8323                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8324                                         "raw");
8325                 }
8326                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8327                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8328         } else {
8329                 print "<div class=\"page_nav\">\n" .
8330                       "<br/><br/></div>\n" .
8331                       "<div class=\"title\">".esc_html($hash)."</div>\n";
8332         }
8333         git_print_page_path($file_name, "blob", $hash_base);
8334         print "<div class=\"title_text\">\n" .
8335               "<table class=\"object_header\">\n";
8336         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8337         print "</table>".
8338               "</div>\n";
8339         print "<div class=\"page_body\">\n";
8340         if ($mimetype =~ m!^image/!) {
8341                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8342                 if ($file_name) {
8343                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8344                 }
8345                 print qq! src="! .
8346                       href(action=>"blob_plain", hash=>$hash,
8347                            hash_base=>$hash_base, file_name=>$file_name) .
8348                       qq!" />\n!;
8349         } else {
8350                 my $nr;
8351                 while (my $line = to_utf8(scalar <$fd>)) {
8352                         chomp $line;
8353                         $nr++;
8354                         $line = untabify($line);
8355                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
8356                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8357                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8358                 }
8359         }
8360         close $fd
8361                 or print "Reading blob failed.\n";
8362         print "</div>";
8363         git_footer_html();
8364 }
8365
8366 sub git_tree {
8367         my $fullhash;
8368         if (!defined $hash_base) {
8369                 $hash_base = "HEAD";
8370         }
8371         if (!defined $hash) {
8372                 if (defined $file_name) {
8373                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8374                         $fullhash = $hash;
8375                 } else {
8376                         $hash = $hash_base;
8377                 }
8378         }
8379         die_error(404, "No such tree") unless defined($hash);
8380         $fullhash = $hash if !$fullhash && $hash =~ m/^[0-9a-fA-F]{40}$/;
8381         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8382
8383         my $show_sizes = gitweb_check_feature('show-sizes');
8384         my $have_blame = gitweb_check_feature('blame');
8385
8386         my @entries = ();
8387         {
8388                 local $/ = "\0";
8389                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8390                         ($show_sizes ? '-l' : ()), @extra_options, $hash)
8391                         or die_error(500, "Open git-ls-tree failed");
8392                 @entries = map { chomp; to_utf8($_) } <$fd>;
8393                 close $fd
8394                         or die_error(404, "Reading tree failed");
8395         }
8396
8397         git_header_html();
8398         my $basedir = '';
8399         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8400                 my $refs = git_get_references();
8401                 my $ref = format_ref_marker($refs, $co{'id'});
8402                 my @views_nav = ();
8403                 if (defined $file_name) {
8404                         push @views_nav,
8405                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8406                                         "history"),
8407                                 $cgi->a({-href => href(action=>"tree",
8408                                                        hash_base=>"HEAD", file_name=>$file_name)},
8409                                         "HEAD"),
8410                 }
8411                 my $snapshot_links = format_snapshot_links($hash);
8412                 if (defined $snapshot_links) {
8413                         # FIXME: Should be available when we have no hash base as well.
8414                         push @views_nav, $snapshot_links;
8415                 }
8416                 git_print_page_nav('tree','', $hash_base, undef, undef,
8417                                    join(' | ', @views_nav));
8418                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8419         } else {
8420                 undef $hash_base;
8421                 print "<div class=\"page_nav\">\n";
8422                 print "<br/><br/></div>\n";
8423                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8424         }
8425         if (defined $file_name) {
8426                 $basedir = $file_name;
8427                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8428                         $basedir .= '/';
8429                 }
8430                 git_print_page_path($file_name, 'tree', $hash_base);
8431         }
8432         print "<div class=\"title_text\">\n" .
8433               "<table class=\"object_header\">\n";
8434         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8435         print "</table>".
8436               "</div>\n";
8437         print "<div class=\"page_body\">\n";
8438         print "<table class=\"tree\">\n";
8439         my $alternate = 1;
8440         # '..' (top directory) link if possible
8441         if (defined $hash_base &&
8442             defined $file_name && $file_name =~ m![^/]+$!) {
8443                 if ($alternate) {
8444                         print "<tr class=\"dark\">\n";
8445                 } else {
8446                         print "<tr class=\"light\">\n";
8447                 }
8448                 $alternate ^= 1;
8449
8450                 my $up = $file_name;
8451                 $up =~ s!/?[^/]+$!!;
8452                 undef $up unless $up;
8453                 # based on git_print_tree_entry
8454                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8455                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8456                 print '<td class="list">';
8457                 print $cgi->a({-href => href(action=>"tree",
8458                                              hash_base=>$hash_base,
8459                                              file_name=>$up)},
8460                               "..");
8461                 print "</td>\n";
8462                 print "<td class=\"link\"></td>\n";
8463
8464                 print "</tr>\n";
8465         }
8466         foreach my $line (@entries) {
8467                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8468
8469                 if ($alternate) {
8470                         print "<tr class=\"dark\">\n";
8471                 } else {
8472                         print "<tr class=\"light\">\n";
8473                 }
8474                 $alternate ^= 1;
8475
8476                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8477
8478                 print "</tr>\n";
8479         }
8480         print "</table>\n" .
8481               "</div>";
8482         git_footer_html();
8483 }
8484
8485 sub sanitize_for_filename {
8486     my $name = shift;
8487
8488     $name =~ s!/!-!g;
8489     $name =~ s/[^[:alnum:]_.-]//g;
8490
8491     return $name;
8492 }
8493
8494 sub snapshot_name {
8495         my ($project, $hash) = @_;
8496
8497         # path/to/project.git  -> project
8498         # path/to/project/.git -> project
8499         my $name = to_utf8($project);
8500         $name =~ s,([^/])/*\.git$,$1,;
8501         $name = sanitize_for_filename(basename($name));
8502
8503         my $ver = $hash;
8504         if ($hash =~ /^[0-9a-fA-F]+$/) {
8505                 # shorten SHA-1 hash
8506                 my $full_hash = git_get_full_hash($project, $hash);
8507                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8508                         $ver = git_get_short_hash($project, $hash);
8509                 }
8510         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8511                 # tags don't need shortened SHA-1 hash
8512                 $ver = $1;
8513         } else {
8514                 # branches and other need shortened SHA-1 hash
8515                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8516                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8517                         my $ref_dir = (defined $1) ? $1 : '';
8518                         $ver = $2;
8519
8520                         $ref_dir = sanitize_for_filename($ref_dir);
8521                         # for refs neither in heads nor remotes we want to
8522                         # add a ref dir to archive name
8523                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8524                                 $ver = $ref_dir . '-' . $ver;
8525                         }
8526                 }
8527                 $ver .= '-' . git_get_short_hash($project, $hash);
8528         }
8529         # special case of sanitization for filename - we change
8530         # slashes to dots instead of dashes
8531         # in case of hierarchical branch names
8532         $ver =~ s!/!.!g;
8533         $ver =~ s/[^[:alnum:]_.-]//g;
8534
8535         # name = project-version_string
8536         $name = "$name-$ver";
8537
8538         return wantarray ? ($name, $name) : $name;
8539 }
8540
8541 sub exit_if_unmodified_since {
8542         my ($latest_epoch) = @_;
8543         our $cgi;
8544
8545         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8546         if (defined $if_modified) {
8547                 my $since;
8548                 if (eval { require HTTP::Date; 1; }) {
8549                         $since = HTTP::Date::str2time($if_modified);
8550                 } elsif (eval { require Time::ParseDate; 1; }) {
8551                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8552                 }
8553                 if (defined $since && $latest_epoch <= $since) {
8554                         my %latest_date = parse_date($latest_epoch);
8555                         print $cgi->header(
8556                                 -last_modified => $latest_date{'rfc2822'},
8557                                 -status => '304 Not Modified');
8558                         goto DONE_GITWEB;
8559                 }
8560         }
8561 }
8562
8563 sub git_snapshot {
8564         my $format = $input_params{'snapshot_format'};
8565         if (!@snapshot_fmts) {
8566                 die_error(403, "Snapshots not allowed");
8567         }
8568         # default to first supported snapshot format
8569         $format ||= $snapshot_fmts[0];
8570         if ($format !~ m/^[a-z0-9]+$/) {
8571                 die_error(400, "Invalid snapshot format parameter");
8572         } elsif (!exists($known_snapshot_formats{$format})) {
8573                 die_error(400, "Unknown snapshot format");
8574         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8575                 die_error(403, "Snapshot format not allowed");
8576         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8577                 die_error(403, "Unsupported snapshot format");
8578         }
8579
8580         my $type = git_get_type("$hash^{}");
8581         if (!$type) {
8582                 die_error(404, 'Object does not exist');
8583         }  elsif ($type eq 'blob') {
8584                 die_error(400, 'Object is not a tree-ish');
8585         }
8586
8587         my ($name, $prefix) = snapshot_name($project, $hash);
8588         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8589
8590         my %co = parse_commit($hash);
8591         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8592
8593         my @cmd = (
8594                 git_cmd(), 'archive',
8595                 "--format=$known_snapshot_formats{$format}{'format'}",
8596                 "--prefix=$prefix/", $hash);
8597         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8598                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8599                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8600         }
8601
8602         $filename =~ s/(["\\])/\\$1/g;
8603         my %latest_date;
8604         if (%co) {
8605                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8606         }
8607
8608         print $cgi->header(
8609                 -type => $known_snapshot_formats{$format}{'type'},
8610                 -content_disposition => 'inline; filename="' . $filename . '"',
8611                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8612                 -status => '200 OK');
8613
8614         defined(my $fd = cmd_pipe @cmd)
8615                 or die_error(500, "Execute git-archive failed");
8616         binmode($fd);
8617         binmode STDOUT, ':raw';
8618         $fcgi_raw_mode = 1;
8619         my $buf;
8620         while (read($fd, $buf, 32768)) {
8621                 print $buf;
8622         }
8623         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8624         $fcgi_raw_mode = 0;
8625         close $fd;
8626 }
8627
8628 sub git_log_generic {
8629         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8630
8631         my $head = git_get_head_hash($project);
8632         if (!defined $base) {
8633                 $base = $head;
8634         }
8635         if (!defined $page) {
8636                 $page = 0;
8637         }
8638         my $refs = git_get_references();
8639
8640         my $commit_hash = $base;
8641         if (defined $parent) {
8642                 $commit_hash = "$parent..$base";
8643         }
8644         my @commitlist =
8645                 parse_commits($commit_hash, 101, (100 * $page),
8646                               defined $file_name ? ($file_name, "--full-history") : ());
8647
8648         my $ftype;
8649         if (!defined $file_hash && defined $file_name) {
8650                 # some commits could have deleted file in question,
8651                 # and not have it in tree, but one of them has to have it
8652                 for (my $i = 0; $i < @commitlist; $i++) {
8653                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8654                         last if defined $file_hash;
8655                 }
8656         }
8657         if (defined $file_hash) {
8658                 $ftype = git_get_type($file_hash);
8659         }
8660         if (defined $file_name && !defined $ftype) {
8661                 die_error(500, "Unknown type of object");
8662         }
8663         my %co;
8664         if (defined $file_name) {
8665                 %co = parse_commit($base)
8666                         or die_error(404, "Unknown commit object");
8667         }
8668
8669
8670         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100);
8671         my $next_link = '';
8672         if ($#commitlist >= 100) {
8673                 $next_link =
8674                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8675                                  -accesskey => "n", -title => "Alt-n"}, "next");
8676         }
8677         my ($patch_max) = gitweb_get_feature('patches');
8678         if ($patch_max && !defined $file_name) {
8679                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8680                         $paging_nav .= " &#183; " .
8681                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
8682                                         "patches");
8683                 }
8684         }
8685
8686         {
8687                 local $action = 'fulllog';
8688                 git_header_html();
8689         }
8690         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8691         if (defined $file_name) {
8692                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8693         } else {
8694                 git_print_header_div('summary', $project)
8695         }
8696         git_print_page_path($file_name, $ftype, $hash_base)
8697                 if (defined $file_name);
8698
8699         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8700                      $file_name, $file_hash, $ftype);
8701
8702         git_footer_html();
8703 }
8704
8705 sub git_log {
8706         git_log_generic('log', \&git_log_body,
8707                         $hash, $hash_parent);
8708 }
8709
8710 sub git_commit {
8711         $hash ||= $hash_base || "HEAD";
8712         my %co = parse_commit($hash)
8713             or die_error(404, "Unknown commit object");
8714
8715         my $parent  = $co{'parent'};
8716         my $parents = $co{'parents'}; # listref
8717
8718         # we need to prepare $formats_nav before any parameter munging
8719         my $formats_nav;
8720         if (!defined $parent) {
8721                 # --root commitdiff
8722                 $formats_nav .= '(initial)';
8723         } elsif (@$parents == 1) {
8724                 # single parent commit
8725                 $formats_nav .=
8726                         '(parent: ' .
8727                         $cgi->a({-href => href(action=>"commit",
8728                                                hash=>$parent)},
8729                                 esc_html(substr($parent, 0, 7))) .
8730                         ')';
8731         } else {
8732                 # merge commit
8733                 $formats_nav .=
8734                         '(merge: ' .
8735                         join(' ', map {
8736                                 $cgi->a({-href => href(action=>"commit",
8737                                                        hash=>$_)},
8738                                         esc_html(substr($_, 0, 7)));
8739                         } @$parents ) .
8740                         ')';
8741         }
8742         if (gitweb_check_feature('patches') && @$parents <= 1) {
8743                 $formats_nav .= " | " .
8744                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8745                                 "patch");
8746         }
8747
8748         if (!defined $parent) {
8749                 $parent = "--root";
8750         }
8751         my @difftree;
8752         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8753                 @diff_opts,
8754                 (@$parents <= 1 ? $parent : '-c'),
8755                 $hash, "--")
8756                 or die_error(500, "Open git-diff-tree failed");
8757         @difftree = map { chomp; to_utf8($_) } <$fd>;
8758         close $fd or die_error(404, "Reading git-diff-tree failed");
8759
8760         # non-textual hash id's can be cached
8761         my $expires;
8762         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8763                 $expires = "+1d";
8764         }
8765         my $refs = git_get_references();
8766         my $ref = format_ref_marker($refs, $co{'id'});
8767
8768         git_header_html(undef, $expires);
8769         git_print_page_nav('commit', '',
8770                            $hash, $co{'tree'}, $hash,
8771                            $formats_nav);
8772
8773         if (defined $co{'parent'}) {
8774                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
8775         } else {
8776                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
8777         }
8778         print "<div class=\"title_text\">\n" .
8779               "<table class=\"object_header\">\n";
8780         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8781         git_print_authorship_rows(\%co);
8782         print "<tr>" .
8783               "<td>tree</td>" .
8784               "<td class=\"sha1\">" .
8785               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8786                        class => "list"}, $co{'tree'}) .
8787               "</td>" .
8788               "<td class=\"link\">" .
8789               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8790                       "tree");
8791         my $snapshot_links = format_snapshot_links($hash);
8792         if (defined $snapshot_links) {
8793                 print " | " . $snapshot_links;
8794         }
8795         print "</td>" .
8796               "</tr>\n";
8797
8798         foreach my $par (@$parents) {
8799                 print "<tr>" .
8800                       "<td>parent</td>" .
8801                       "<td class=\"sha1\">" .
8802                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8803                                class => "list"}, $par) .
8804                       "</td>" .
8805                       "<td class=\"link\">" .
8806                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8807                       " | " .
8808                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8809                       "</td>" .
8810                       "</tr>\n";
8811         }
8812         print "</table>".
8813               "</div>\n";
8814
8815         print "<div class=\"page_body\">\n";
8816         git_print_log($co{'comment'});
8817         print "</div>\n";
8818
8819         git_difftree_body(\@difftree, $hash, @$parents);
8820
8821         git_footer_html();
8822 }
8823
8824 sub git_object {
8825         # object is defined by:
8826         # - hash or hash_base alone
8827         # - hash_base and file_name
8828         my $type;
8829
8830         # - hash or hash_base alone
8831         if ($hash || ($hash_base && !defined $file_name)) {
8832                 my $object_id = $hash || $hash_base;
8833
8834                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8835                         or die_error(404, "Object does not exist");
8836                 $type = <$fd>;
8837                 chomp $type;
8838                 close $fd
8839                         or die_error(404, "Object does not exist");
8840
8841         # - hash_base and file_name
8842         } elsif ($hash_base && defined $file_name) {
8843                 $file_name =~ s,/+$,,;
8844
8845                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
8846                         or die_error(404, "Base object does not exist");
8847
8848                 # here errors should not happen
8849                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
8850                         or die_error(500, "Open git-ls-tree failed");
8851                 my $line = to_utf8(scalar <$fd>);
8852                 close $fd;
8853
8854                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
8855                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
8856                         die_error(404, "File or directory for given base does not exist");
8857                 }
8858                 $type = $2;
8859                 $hash = $3;
8860         } else {
8861                 die_error(400, "Not enough information to find object");
8862         }
8863
8864         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
8865                                           hash=>$hash, hash_base=>$hash_base,
8866                                           file_name=>$file_name),
8867                              -status => '302 Found');
8868 }
8869
8870 sub git_blobdiff {
8871         my $format = shift || 'html';
8872         my $diff_style = $input_params{'diff_style'} || 'inline';
8873
8874         my $fd;
8875         my @difftree;
8876         my %diffinfo;
8877         my $expires;
8878
8879         # preparing $fd and %diffinfo for git_patchset_body
8880         # new style URI
8881         if (defined $hash_base && defined $hash_parent_base) {
8882                 if (defined $file_name) {
8883                         # read raw output
8884                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8885                                 $hash_parent_base, $hash_base,
8886                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
8887                                 or die_error(500, "Open git-diff-tree failed");
8888                         @difftree = map { chomp; to_utf8($_) } <$fd>;
8889                         close $fd
8890                                 or die_error(404, "Reading git-diff-tree failed");
8891                         @difftree
8892                                 or die_error(404, "Blob diff not found");
8893
8894                 } elsif (defined $hash &&
8895                          $hash =~ /[0-9a-fA-F]{40}/) {
8896                         # try to find filename from $hash
8897
8898                         # read filtered raw output
8899                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8900                                 $hash_parent_base, $hash_base, "--")
8901                                 or die_error(500, "Open git-diff-tree failed");
8902                         @difftree =
8903                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
8904                                 # $hash == to_id
8905                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
8906                                 map { chomp; to_utf8($_) } <$fd>;
8907                         close $fd
8908                                 or die_error(404, "Reading git-diff-tree failed");
8909                         @difftree
8910                                 or die_error(404, "Blob diff not found");
8911
8912                 } else {
8913                         die_error(400, "Missing one of the blob diff parameters");
8914                 }
8915
8916                 if (@difftree > 1) {
8917                         die_error(400, "Ambiguous blob diff specification");
8918                 }
8919
8920                 %diffinfo = parse_difftree_raw_line($difftree[0]);
8921                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
8922                 $file_name   ||= $diffinfo{'to_file'};
8923
8924                 $hash_parent ||= $diffinfo{'from_id'};
8925                 $hash        ||= $diffinfo{'to_id'};
8926
8927                 # non-textual hash id's can be cached
8928                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
8929                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
8930                         $expires = '+1d';
8931                 }
8932
8933                 # open patch output
8934                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8935                         '-p', ($format eq 'html' ? "--full-index" : ()),
8936                         $hash_parent_base, $hash_base,
8937                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
8938                         or die_error(500, "Open git-diff-tree failed");
8939         }
8940
8941         # old/legacy style URI -- not generated anymore since 1.4.3.
8942         if (!%diffinfo) {
8943                 die_error('404 Not Found', "Missing one of the blob diff parameters")
8944         }
8945
8946         # header
8947         if ($format eq 'html') {
8948                 my $formats_nav =
8949                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
8950                                 "raw");
8951                 $formats_nav .= diff_style_nav($diff_style);
8952                 git_header_html(undef, $expires);
8953                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8954                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8955                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8956                 } else {
8957                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
8958                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
8959                 }
8960                 if (defined $file_name) {
8961                         git_print_page_path($file_name, "blob", $hash_base);
8962                 } else {
8963                         print "<div class=\"page_path\"></div>\n";
8964                 }
8965
8966         } elsif ($format eq 'plain') {
8967                 print $cgi->header(
8968                         -type => 'text/plain',
8969                         -charset => 'utf-8',
8970                         -expires => $expires,
8971                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
8972
8973                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8974
8975         } else {
8976                 die_error(400, "Unknown blobdiff format");
8977         }
8978
8979         # patch
8980         if ($format eq 'html') {
8981                 print "<div class=\"page_body\">\n";
8982
8983                 git_patchset_body($fd, $diff_style,
8984                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
8985                 close $fd;
8986
8987                 print "</div>\n"; # class="page_body"
8988                 git_footer_html();
8989
8990         } else {
8991                 while (my $line = to_utf8(scalar <$fd>)) {
8992                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
8993                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
8994
8995                         print $line;
8996
8997                         last if $line =~ m!^\+\+\+!;
8998                 }
8999                 while (<$fd>) {
9000                         print to_utf8($_);
9001                 }
9002                 close $fd;
9003         }
9004 }
9005
9006 sub git_blobdiff_plain {
9007         git_blobdiff('plain');
9008 }
9009
9010 # assumes that it is added as later part of already existing navigation,
9011 # so it returns "| foo | bar" rather than just "foo | bar"
9012 sub diff_style_nav {
9013         my ($diff_style, $is_combined) = @_;
9014         $diff_style ||= 'inline';
9015
9016         return "" if ($is_combined);
9017
9018         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
9019         my %styles = @styles;
9020         @styles =
9021                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9022
9023         return join '',
9024                 map { " | ".$_ }
9025                 map {
9026                         $_ eq $diff_style ? $styles{$_} :
9027                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
9028                 } @styles;
9029 }
9030
9031 sub git_commitdiff {
9032         my %params = @_;
9033         my $format = $params{-format} || 'html';
9034         my $diff_style = $input_params{'diff_style'} || 'inline';
9035
9036         my ($patch_max) = gitweb_get_feature('patches');
9037         if ($format eq 'patch') {
9038                 die_error(403, "Patch view not allowed") unless $patch_max;
9039         }
9040
9041         $hash ||= $hash_base || "HEAD";
9042         my %co = parse_commit($hash)
9043             or die_error(404, "Unknown commit object");
9044
9045         # choose format for commitdiff for merge
9046         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9047                 $hash_parent = '--cc';
9048         }
9049         # we need to prepare $formats_nav before almost any parameter munging
9050         my $formats_nav;
9051         if ($format eq 'html') {
9052                 $formats_nav =
9053                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9054                                 "raw");
9055                 if ($patch_max && @{$co{'parents'}} <= 1) {
9056                         $formats_nav .= " | " .
9057                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9058                                         "patch");
9059                 }
9060                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9061
9062                 if (defined $hash_parent &&
9063                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9064                         # commitdiff with two commits given
9065                         my $hash_parent_short = $hash_parent;
9066                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9067                                 $hash_parent_short = substr($hash_parent, 0, 7);
9068                         }
9069                         $formats_nav .=
9070                                 ' (from';
9071                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9072                                 if ($co{'parents'}[$i] eq $hash_parent) {
9073                                         $formats_nav .= ' parent ' . ($i+1);
9074                                         last;
9075                                 }
9076                         }
9077                         $formats_nav .= ': ' .
9078                                 $cgi->a({-href => href(-replay=>1,
9079                                                        hash=>$hash_parent, hash_base=>undef)},
9080                                         esc_html($hash_parent_short)) .
9081                                 ')';
9082                 } elsif (!$co{'parent'}) {
9083                         # --root commitdiff
9084                         $formats_nav .= ' (initial)';
9085                 } elsif (scalar @{$co{'parents'}} == 1) {
9086                         # single parent commit
9087                         $formats_nav .=
9088                                 ' (parent: ' .
9089                                 $cgi->a({-href => href(-replay=>1,
9090                                                        hash=>$co{'parent'}, hash_base=>undef)},
9091                                         esc_html(substr($co{'parent'}, 0, 7))) .
9092                                 ')';
9093                 } else {
9094                         # merge commit
9095                         if ($hash_parent eq '--cc') {
9096                                 $formats_nav .= ' | ' .
9097                                         $cgi->a({-href => href(-replay=>1,
9098                                                                hash=>$hash, hash_parent=>'-c')},
9099                                                 'combined');
9100                         } else { # $hash_parent eq '-c'
9101                                 $formats_nav .= ' | ' .
9102                                         $cgi->a({-href => href(-replay=>1,
9103                                                                hash=>$hash, hash_parent=>'--cc')},
9104                                                 'compact');
9105                         }
9106                         $formats_nav .=
9107                                 ' (merge: ' .
9108                                 join(' ', map {
9109                                         $cgi->a({-href => href(-replay=>1,
9110                                                                hash=>$_, hash_base=>undef)},
9111                                                 esc_html(substr($_, 0, 7)));
9112                                 } @{$co{'parents'}} ) .
9113                                 ')';
9114                 }
9115         }
9116
9117         my $hash_parent_param = $hash_parent;
9118         if (!defined $hash_parent_param) {
9119                 # --cc for multiple parents, --root for parentless
9120                 $hash_parent_param =
9121                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9122         }
9123
9124         # read commitdiff
9125         my $fd;
9126         my @difftree;
9127         if ($format eq 'html') {
9128                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9129                         "--no-commit-id", "--patch-with-raw", "--full-index",
9130                         $hash_parent_param, $hash, "--")
9131                         or die_error(500, "Open git-diff-tree failed");
9132
9133                 while (my $line = to_utf8(scalar <$fd>)) {
9134                         chomp $line;
9135                         # empty line ends raw part of diff-tree output
9136                         last unless $line;
9137                         push @difftree, scalar parse_difftree_raw_line($line);
9138                 }
9139
9140         } elsif ($format eq 'plain') {
9141                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9142                         '-p', $hash_parent_param, $hash, "--")
9143                         or die_error(500, "Open git-diff-tree failed");
9144         } elsif ($format eq 'patch') {
9145                 # For commit ranges, we limit the output to the number of
9146                 # patches specified in the 'patches' feature.
9147                 # For single commits, we limit the output to a single patch,
9148                 # diverging from the git-format-patch default.
9149                 my @commit_spec = ();
9150                 if ($hash_parent) {
9151                         if ($patch_max > 0) {
9152                                 push @commit_spec, "-$patch_max";
9153                         }
9154                         push @commit_spec, '-n', "$hash_parent..$hash";
9155                 } else {
9156                         if ($params{-single}) {
9157                                 push @commit_spec, '-1';
9158                         } else {
9159                                 if ($patch_max > 0) {
9160                                         push @commit_spec, "-$patch_max";
9161                                 }
9162                                 push @commit_spec, "-n";
9163                         }
9164                         push @commit_spec, '--root', $hash;
9165                 }
9166                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9167                         '--encoding=utf8', '--stdout', @commit_spec)
9168                         or die_error(500, "Open git-format-patch failed");
9169         } else {
9170                 die_error(400, "Unknown commitdiff format");
9171         }
9172
9173         # non-textual hash id's can be cached
9174         my $expires;
9175         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9176                 $expires = "+1d";
9177         }
9178
9179         # write commit message
9180         if ($format eq 'html') {
9181                 my $refs = git_get_references();
9182                 my $ref = format_ref_marker($refs, $co{'id'});
9183
9184                 git_header_html(undef, $expires);
9185                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9186                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9187                 print "<div class=\"title_text\">\n" .
9188                       "<table class=\"object_header\">\n";
9189                 git_print_authorship_rows(\%co);
9190                 print "</table>".
9191                       "</div>\n";
9192                 print "<div class=\"page_body\">\n";
9193                 if (@{$co{'comment'}} > 1) {
9194                         print "<div class=\"log\">\n";
9195                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9196                         print "</div>\n"; # class="log"
9197                 }
9198
9199         } elsif ($format eq 'plain') {
9200                 my $refs = git_get_references("tags");
9201                 my $tagname = git_get_rev_name_tags($hash);
9202                 my $filename = basename($project) . "-$hash.patch";
9203
9204                 print $cgi->header(
9205                         -type => 'text/plain',
9206                         -charset => 'utf-8',
9207                         -expires => $expires,
9208                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9209                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9210                 print "From: " . to_utf8($co{'author'}) . "\n";
9211                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9212                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9213
9214                 print "X-Git-Tag: $tagname\n" if $tagname;
9215                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9216
9217                 foreach my $line (@{$co{'comment'}}) {
9218                         print to_utf8($line) . "\n";
9219                 }
9220                 print "---\n\n";
9221         } elsif ($format eq 'patch') {
9222                 my $filename = basename($project) . "-$hash.patch";
9223
9224                 print $cgi->header(
9225                         -type => 'text/plain',
9226                         -charset => 'utf-8',
9227                         -expires => $expires,
9228                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9229         }
9230
9231         # write patch
9232         if ($format eq 'html') {
9233                 my $use_parents = !defined $hash_parent ||
9234                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9235                 git_difftree_body(\@difftree, $hash,
9236                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9237                 print "<br/>\n";
9238
9239                 git_patchset_body($fd, $diff_style,
9240                                   \@difftree, $hash,
9241                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9242                 close $fd;
9243                 print "</div>\n"; # class="page_body"
9244                 git_footer_html();
9245
9246         } elsif ($format eq 'plain') {
9247                 while (<$fd>) {
9248                         print to_utf8($_);
9249                 }
9250                 close $fd
9251                         or print "Reading git-diff-tree failed\n";
9252         } elsif ($format eq 'patch') {
9253                 while (<$fd>) {
9254                         print to_utf8($_);
9255                 }
9256                 close $fd
9257                         or print "Reading git-format-patch failed\n";
9258         }
9259 }
9260
9261 sub git_commitdiff_plain {
9262         git_commitdiff(-format => 'plain');
9263 }
9264
9265 # format-patch-style patches
9266 sub git_patch {
9267         git_commitdiff(-format => 'patch', -single => 1);
9268 }
9269
9270 sub git_patches {
9271         git_commitdiff(-format => 'patch');
9272 }
9273
9274 sub git_history {
9275         git_log_generic('history', \&git_history_body,
9276                         $hash_base, $hash_parent_base,
9277                         $file_name, $hash);
9278 }
9279
9280 sub git_search {
9281         $searchtype ||= 'commit';
9282
9283         # check if appropriate features are enabled
9284         gitweb_check_feature('search')
9285                 or die_error(403, "Search is disabled");
9286         if ($searchtype eq 'pickaxe') {
9287                 # pickaxe may take all resources of your box and run for several minutes
9288                 # with every query - so decide by yourself how public you make this feature
9289                 gitweb_check_feature('pickaxe')
9290                         or die_error(403, "Pickaxe search is disabled");
9291         }
9292         if ($searchtype eq 'grep') {
9293                 # grep search might be potentially CPU-intensive, too
9294                 gitweb_check_feature('grep')
9295                         or die_error(403, "Grep search is disabled");
9296         }
9297
9298         if (!defined $searchtext) {
9299                 die_error(400, "Text field is empty");
9300         }
9301         if (!defined $hash) {
9302                 $hash = git_get_head_hash($project);
9303         }
9304         my %co = parse_commit($hash);
9305         if (!%co) {
9306                 die_error(404, "Unknown commit object");
9307         }
9308         if (!defined $page) {
9309                 $page = 0;
9310         }
9311
9312         if ($searchtype eq 'commit' ||
9313             $searchtype eq 'author' ||
9314             $searchtype eq 'committer') {
9315                 git_search_message(%co);
9316         } elsif ($searchtype eq 'pickaxe') {
9317                 git_search_changes(%co);
9318         } elsif ($searchtype eq 'grep') {
9319                 git_search_files(%co);
9320         } else {
9321                 die_error(400, "Unknown search type");
9322         }
9323 }
9324
9325 sub git_search_help {
9326         git_header_html();
9327         git_print_page_nav('','', $hash,$hash,$hash);
9328         print <<EOT;
9329 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9330 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9331 the pattern entered is recognized as the POSIX extended
9332 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9333 insensitive).</p>
9334 <dl>
9335 <dt><b>commit</b></dt>
9336 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9337 EOT
9338         my $have_grep = gitweb_check_feature('grep');
9339         if ($have_grep) {
9340                 print <<EOT;
9341 <dt><b>grep</b></dt>
9342 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9343     a different one) are searched for the given pattern. On large trees, this search can take
9344 a while and put some strain on the server, so please use it with some consideration. Note that
9345 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9346 case-sensitive.</dd>
9347 EOT
9348         }
9349         print <<EOT;
9350 <dt><b>author</b></dt>
9351 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9352 <dt><b>committer</b></dt>
9353 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9354 EOT
9355         my $have_pickaxe = gitweb_check_feature('pickaxe');
9356         if ($have_pickaxe) {
9357                 print <<EOT;
9358 <dt><b>pickaxe</b></dt>
9359 <dd>All commits that caused the string to appear or disappear from any file (changes that
9360 added, removed or "modified" the string) will be listed. This search can take a while and
9361 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9362 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9363 EOT
9364         }
9365         print "</dl>\n";
9366         git_footer_html();
9367 }
9368
9369 sub git_shortlog {
9370         git_log_generic('shortlog', \&git_shortlog_body,
9371                         $hash, $hash_parent);
9372 }
9373
9374 ## ......................................................................
9375 ## feeds (RSS, Atom; OPML)
9376
9377 sub git_feed {
9378         my $format = shift || 'atom';
9379         my $have_blame = gitweb_check_feature('blame');
9380
9381         # Atom: http://www.atomenabled.org/developers/syndication/
9382         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9383         if ($format ne 'rss' && $format ne 'atom') {
9384                 die_error(400, "Unknown web feed format");
9385         }
9386
9387         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9388         my $head = $hash || 'HEAD';
9389         my @commitlist = parse_commits($head, 150, 0, $file_name);
9390
9391         my %latest_commit;
9392         my %latest_date;
9393         my $content_type = "application/$format+xml";
9394         if (defined $cgi->http('HTTP_ACCEPT') &&
9395                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9396                 # browser (feed reader) prefers text/xml
9397                 $content_type = 'text/xml';
9398         }
9399         if (defined($commitlist[0])) {
9400                 %latest_commit = %{$commitlist[0]};
9401                 my $latest_epoch = $latest_commit{'committer_epoch'};
9402                 exit_if_unmodified_since($latest_epoch);
9403                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9404         }
9405         print $cgi->header(
9406                 -type => $content_type,
9407                 -charset => 'utf-8',
9408                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9409                 -status => '200 OK');
9410
9411         # Optimization: skip generating the body if client asks only
9412         # for Last-Modified date.
9413         return if ($cgi->request_method() eq 'HEAD');
9414
9415         # header variables
9416         my $title = "$site_name - $project/$action";
9417         my $feed_type = 'log';
9418         if (defined $hash) {
9419                 $title .= " - '$hash'";
9420                 $feed_type = 'branch log';
9421                 if (defined $file_name) {
9422                         $title .= " :: $file_name";
9423                         $feed_type = 'history';
9424                 }
9425         } elsif (defined $file_name) {
9426                 $title .= " - $file_name";
9427                 $feed_type = 'history';
9428         }
9429         $title .= " $feed_type";
9430         $title = esc_html($title);
9431         my $descr = git_get_project_description($project);
9432         if (defined $descr) {
9433                 $descr = esc_html($descr);
9434         } else {
9435                 $descr = "$project " .
9436                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9437                          " feed";
9438         }
9439         my $owner = git_get_project_owner($project);
9440         $owner = esc_html($owner);
9441
9442         #header
9443         my $alt_url;
9444         if (defined $file_name) {
9445                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9446         } elsif (defined $hash) {
9447                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9448         } else {
9449                 $alt_url = href(-full=>1, action=>"summary");
9450         }
9451         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9452         if ($format eq 'rss') {
9453                 print <<XML;
9454 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9455 <channel>
9456 XML
9457                 print "<title>$title</title>\n" .
9458                       "<link>$alt_url</link>\n" .
9459                       "<description>$descr</description>\n" .
9460                       "<language>en</language>\n" .
9461                       # project owner is responsible for 'editorial' content
9462                       "<managingEditor>$owner</managingEditor>\n";
9463                 if (defined $logo || defined $favicon) {
9464                         # prefer the logo to the favicon, since RSS
9465                         # doesn't allow both
9466                         my $img = esc_url($logo || $favicon);
9467                         print "<image>\n" .
9468                               "<url>$img</url>\n" .
9469                               "<title>$title</title>\n" .
9470                               "<link>$alt_url</link>\n" .
9471                               "</image>\n";
9472                 }
9473                 if (%latest_date) {
9474                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9475                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9476                 }
9477                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9478         } elsif ($format eq 'atom') {
9479                 print <<XML;
9480 <feed xmlns="http://www.w3.org/2005/Atom">
9481 XML
9482                 print "<title>$title</title>\n" .
9483                       "<subtitle>$descr</subtitle>\n" .
9484                       '<link rel="alternate" type="text/html" href="' .
9485                       $alt_url . '" />' . "\n" .
9486                       '<link rel="self" type="' . $content_type . '" href="' .
9487                       $cgi->self_url() . '" />' . "\n" .
9488                       "<id>" . href(-full=>1) . "</id>\n" .
9489                       # use project owner for feed author
9490                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9491                 if (defined $favicon) {
9492                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9493                 }
9494                 if (defined $logo) {
9495                         # not twice as wide as tall: 72 x 27 pixels
9496                         print "<logo>" . esc_url($logo) . "</logo>\n";
9497                 }
9498                 if (! %latest_date) {
9499                         # dummy date to keep the feed valid until commits trickle in:
9500                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9501                 } else {
9502                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9503                 }
9504                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9505         }
9506
9507         # contents
9508         for (my $i = 0; $i <= $#commitlist; $i++) {
9509                 my %co = %{$commitlist[$i]};
9510                 my $commit = $co{'id'};
9511                 # we read 150, we always show 30 and the ones more recent than 48 hours
9512                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9513                         last;
9514                 }
9515                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9516
9517                 # get list of changed files
9518                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9519                         $co{'parent'} || "--root",
9520                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9521                         or next;
9522                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9523                 close $fd
9524                         or next;
9525
9526                 # print element (entry, item)
9527                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9528                 if ($format eq 'rss') {
9529                         print "<item>\n" .
9530                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9531                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9532                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9533                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9534                               "<link>$co_url</link>\n" .
9535                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9536                               "<content:encoded>" .
9537                               "<![CDATA[\n";
9538                 } elsif ($format eq 'atom') {
9539                         print "<entry>\n" .
9540                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9541                               "<updated>$cd{'iso-8601'}</updated>\n" .
9542                               "<author>\n" .
9543                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9544                         if ($co{'author_email'}) {
9545                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9546                         }
9547                         print "</author>\n" .
9548                               # use committer for contributor
9549                               "<contributor>\n" .
9550                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9551                         if ($co{'committer_email'}) {
9552                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9553                         }
9554                         print "</contributor>\n" .
9555                               "<published>$cd{'iso-8601'}</published>\n" .
9556                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9557                               "<id>$co_url</id>\n" .
9558                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9559                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9560                 }
9561                 my $comment = $co{'comment'};
9562                 print "<pre>\n";
9563                 foreach my $line (@$comment) {
9564                         $line = esc_html($line);
9565                         print "$line\n";
9566                 }
9567                 print "</pre><ul>\n";
9568                 foreach my $difftree_line (@difftree) {
9569                         my %difftree = parse_difftree_raw_line($difftree_line);
9570                         next if !$difftree{'from_id'};
9571
9572                         my $file = $difftree{'file'} || $difftree{'to_file'};
9573
9574                         print "<li>" .
9575                               "[" .
9576                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9577                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9578                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9579                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9580                                       -title => "diff"}, 'D');
9581                         if ($have_blame) {
9582                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9583                                                              file_name=>$file, hash_base=>$commit),
9584                                               -class => "blamelink",
9585                                               -title => "blame"}, 'B');
9586                         }
9587                         # if this is not a feed of a file history
9588                         if (!defined $file_name || $file_name ne $file) {
9589                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9590                                                              file_name=>$file, hash=>$commit),
9591                                               -title => "history"}, 'H');
9592                         }
9593                         $file = esc_path($file);
9594                         print "] ".
9595                               "$file</li>\n";
9596                 }
9597                 if ($format eq 'rss') {
9598                         print "</ul>]]>\n" .
9599                               "</content:encoded>\n" .
9600                               "</item>\n";
9601                 } elsif ($format eq 'atom') {
9602                         print "</ul>\n</div>\n" .
9603                               "</content>\n" .
9604                               "</entry>\n";
9605                 }
9606         }
9607
9608         # end of feed
9609         if ($format eq 'rss') {
9610                 print "</channel>\n</rss>\n";
9611         } elsif ($format eq 'atom') {
9612                 print "</feed>\n";
9613         }
9614 }
9615
9616 sub git_rss {
9617         git_feed('rss');
9618 }
9619
9620 sub git_atom {
9621         git_feed('atom');
9622 }
9623
9624 sub git_opml {
9625         my @list = git_get_projects_list($project_filter, $strict_export);
9626         if (!@list) {
9627                 die_error(404, "No projects found");
9628         }
9629
9630         print $cgi->header(
9631                 -type => 'text/xml',
9632                 -charset => 'utf-8',
9633                 -content_disposition => 'inline; filename="opml.xml"');
9634
9635         my $title = esc_html($site_name);
9636         my $filter = " within subdirectory ";
9637         if (defined $project_filter) {
9638                 $filter .= esc_html($project_filter);
9639         } else {
9640                 $filter = "";
9641         }
9642         print <<XML;
9643 <?xml version="1.0" encoding="utf-8"?>
9644 <opml version="1.0">
9645 <head>
9646   <title>$title OPML Export$filter</title>
9647 </head>
9648 <body>
9649 <outline text="git RSS feeds">
9650 XML
9651
9652         foreach my $pr (@list) {
9653                 my %proj = %$pr;
9654                 my $head = git_get_head_hash($proj{'path'});
9655                 if (!defined $head) {
9656                         next;
9657                 }
9658                 $git_dir = "$projectroot/$proj{'path'}";
9659                 my %co = parse_commit($head);
9660                 if (!%co) {
9661                         next;
9662                 }
9663
9664                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9665                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9666                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9667                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9668         }
9669         print <<XML;
9670 </outline>
9671 </body>
9672 </opml>
9673 XML
9674 }