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 # base URL for bundle info link shown on summary page, but only if
 180 # this config item is defined AND a 'bundles' subdirectory exists
 181 # in the project's repository.
 182 # i.e. full URL is "git_base_bundles_url/$project/bundles"
 183 our $git_base_bundles_url = undef;
 184
 185 # list of git base URLs used for URL to where fetch project from,
 186 # i.e. full URL is "$git_base_url/$project"
 187 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 188
 189 # URLs designated for pushing new changes, extended by the
 190 # project name (i.e. "$git_base_push_url[0]/$project")
 191 our @git_base_push_urls = ();
 192
 193 # https hint html inserted right after any https push URL (undef for none)
 194 our $https_hint_html = undef;
 195
 196 # default blob_plain mimetype and default charset for text/plain blob
 197 our $default_blob_plain_mimetype = 'application/octet-stream';
 198 our $default_text_plain_charset  = undef;
 199
 200 # file to use for guessing MIME types before trying /etc/mime.types
 201 # (relative to the current git repository)
 202 our $mimetypes_file = undef;
 203
 204 # assume this charset if line contains non-UTF-8 characters;
 205 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 206 # for which encoding all byte sequences are valid, for example
 207 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 208 # could be even 'utf-8' for the old behavior)
 209 our $fallback_encoding = 'latin1';
 210
 211 # rename detection options for git-diff and git-diff-tree
 212 # - default is '-M', with the cost proportional to
 213 #   (number of removed files) * (number of new files).
 214 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 215 #   (number of changed files + number of removed files) * (number of new files)
 216 # - even more costly is '-C', '--find-copies-harder' with cost
 217 #   (number of files in the original tree) * (number of new files)
 218 # - one might want to include '-B' option, e.g. '-B', '-M'
 219 our @diff_opts = ('-M'); # taken from git_commit
 220
 221 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 222 # the directory must exist and be writable by the process running gitweb.
 223 # additionally some actions must be selected for caching in %html_cache_actions
 224 # - default is 'htmlcache'
 225 our $html_cache_dir = 'htmlcache';
 226
 227 # which actions to cache in $html_cache_dir
 228 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 229 # process running gitweb, then any actions selected here will have their output
 230 # cached and the cache file will be returned instead of regenerating the page
 231 # if it exists.  For this to be useful, an external process must create the
 232 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 233 # the project information has been changed.  Alternatively it may create a
 234 # "$action.changed" file (if it does not exist) instead to limit the changes
 235 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 236 # exist, then the cached version will never be used for "$action" and a new
 237 # cache page will be regenerated (and the "changed" files removed as appropriate).
 238 #
 239 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 240 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 241 # process must create the 'forkchange' file or update its timestamp if it already
 242 # exists whenever a fork is added to or removed from the project (as well as
 243 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 244 # section on the summary page may remain out-of-date indefinately.
 245 #
 246 # - default is none
 247 #   currently only caching of the summary page is supported
 248 # - to enable caching of the summary page use:
 249 #   $html_cache_actions{'summary'} = 1;
 250 our %html_cache_actions = ();
 251
 252 # Disables features that would allow repository owners to inject script into
 253 # the gitweb domain.
 254 our $prevent_xss = 0;
 255
 256 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 257 # Only used when highlight is enabled or snapshots with compressors are enabled.
 258 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 259
 260 # Path to the highlight executable to use (must be the one from
 261 # http://www.andre-simon.de due to assumptions about parameters and output).
 262 # Useful if highlight is not installed on your webserver's PATH.
 263 # [Default: highlight]
 264 our $highlight_bin = "++HIGHLIGHT_BIN++";
 265
 266 # Whether to include project list on the gitweb front page; 0 means yes,
 267 # 1 means no list but show tag cloud if enabled (all projects still need
 268 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 269 # (very fast)
 270 our $frontpage_no_project_list = 0;
 271
 272 # projects list cache for busy sites with many projects;
 273 # if you set this to non-zero, it will be used as the cached
 274 # index lifetime in minutes
 275 #
 276 # the cached list version is stored in $cache_dir/$cache_name and can
 277 # be tweaked by other scripts running with the same uid as gitweb -
 278 # use this ONLY at secure installations; only single gitweb project
 279 # root per system is supported, unless you tweak configuration!
 280 our $projlist_cache_lifetime = 0; # in minutes
 281 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 282 our $cache_dir =
 283         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 284 our $projlist_cache_name = 'gitweb.index.cache';
 285 our $cache_grpshared = 0;
 286
 287 # information about snapshot formats that gitweb is capable of serving
 288 our %known_snapshot_formats = (
 289         # name => {
 290         #       'display' => display name,
 291         #       'type' => mime type,
 292         #       'suffix' => filename suffix,
 293         #       'format' => --format for git-archive,
 294         #       'compressor' => [compressor command and arguments]
 295         #                       (array reference, optional)
 296         #       'disabled' => boolean (optional)}
 297         #
 298         'tgz' => {
 299                 'display' => 'tar.gz',
 300                 'type' => 'application/x-gzip',
 301                 'suffix' => '.tar.gz',
 302                 'format' => 'tar',
 303                 'compressor' => ['gzip', '-n']},
 304
 305         'tbz2' => {
 306                 'display' => 'tar.bz2',
 307                 'type' => 'application/x-bzip2',
 308                 'suffix' => '.tar.bz2',
 309                 'format' => 'tar',
 310                 'compressor' => ['bzip2']},
 311
 312         'txz' => {
 313                 'display' => 'tar.xz',
 314                 'type' => 'application/x-xz',
 315                 'suffix' => '.tar.xz',
 316                 'format' => 'tar',
 317                 'compressor' => ['xz'],
 318                 'disabled' => 1},
 319
 320         'zip' => {
 321                 'display' => 'zip',
 322                 'type' => 'application/x-zip',
 323                 'suffix' => '.zip',
 324                 'format' => 'zip'},
 325 );
 326
 327 # Aliases so we understand old gitweb.snapshot values in repository
 328 # configuration.
 329 our %known_snapshot_format_aliases = (
 330         'gzip'  => 'tgz',
 331         'bzip2' => 'tbz2',
 332         'xz'    => 'txz',
 333
 334         # backward compatibility: legacy gitweb config support
 335         'x-gzip' => undef, 'gz' => undef,
 336         'x-bzip2' => undef, 'bz2' => undef,
 337         'x-zip' => undef, '' => undef,
 338 );
 339
 340 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 341 # are changed, it may be appropriate to change these values too via
 342 # $GITWEB_CONFIG.
 343 our %avatar_size = (
 344         'default' => 16,
 345         'double'  => 32
 346 );
 347
 348 # Used to set the maximum load that we will still respond to gitweb queries.
 349 # If server load exceed this value then return "503 server busy" error.
 350 # If gitweb cannot determined server load, it is taken to be 0.
 351 # Leave it undefined (or set to 'undef') to turn off load checking.
 352 our $maxload = 300;
 353
 354 # configuration for 'highlight' (http://www.andre-simon.de/)
 355 # match by basename
 356 our %highlight_basename = (
 357         #'Program' => 'py',
 358         #'Library' => 'py',
 359         'SConstruct' => 'py', # SCons equivalent of Makefile
 360         'Makefile' => 'make',
 361         'makefile' => 'make',
 362         'GNUmakefile' => 'make',
 363         'BSDmakefile' => 'make',
 364 );
 365 # match by shebang regex
 366 our %highlight_shebang = (
 367         # Each entry has a key which is the syntax to use and
 368         # a value which is either a qr regex or an array of qr regexs to match
 369         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 370         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 371         # allow a limited subset of NAME=value items to appear.
 372         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 373                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 374         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 375                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 376         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 377                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 378         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 379                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 380         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 381                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 382         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 383                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 384         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 385                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 386 );
 387 # match by extension
 388 our %highlight_ext = (
 389         # main extensions, defining name of syntax;
 390         # see files in /usr/share/highlight/langDefs/ directory
 391         (map { $_ => $_ } qw(
 392                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 393                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 394                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 395                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 396                 go haskell hcl html httpd hx icl icn idl idlang ili
 397                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 398                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 399                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 400                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 401                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 402                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 403                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 404                 yaiff znn)),
 405         # alternate extensions, see /etc/highlight/filetypes.conf
 406         (map { $_ => '4gl' } qw(informix)),
 407         (map { $_ => 'a4c' } qw(ascend)),
 408         (map { $_ => 'abp' } qw(abp4)),
 409         (map { $_ => 'ada' } qw(a adb ads gnad)),
 410         (map { $_ => 'ahk' } qw(autohotkey)),
 411         (map { $_ => 'ampl' } qw(dat run)),
 412         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 413         (map { $_ => 'as' } qw(actionscript)),
 414         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 415         (map { $_ => 'asp' } qw(asa)),
 416         (map { $_ => 'aspect' } qw(was wud)),
 417         (map { $_ => 'ats' } qw(dats)),
 418         (map { $_ => 'au3' } qw(autoit)),
 419         (map { $_ => 'bat' } qw(cmd)),
 420         (map { $_ => 'bb' } qw(blitzbasic)),
 421         (map { $_ => 'bib' } qw(bibtex)),
 422         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 423         (map { $_ => 'cb' } qw(clearbasic)),
 424         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 425         (map { $_ => 'chl' } qw(chill)),
 426         (map { $_ => 'cob' } qw(cbl cobol)),
 427         (map { $_ => 'cs' } qw(csharp)),
 428         (map { $_ => 'diff' } qw(patch)),
 429         (map { $_ => 'dot' } qw(graphviz)),
 430         (map { $_ => 'e' } qw(eiffel se)),
 431         (map { $_ => 'erl' } qw(erlang hrl)),
 432         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 433         (map { $_ => 'exp' } qw(express)),
 434         (map { $_ => 'f90' } qw(f95)),
 435         (map { $_ => 'flx' } qw(felix)),
 436         (map { $_ => 'for' } qw(f f77 ftn)),
 437         (map { $_ => 'fs' } qw(fsharp fsx)),
 438         (map { $_ => 'haskell' } qw(hs)),
 439         (map { $_ => 'html' } qw(htm xhtml)),
 440         (map { $_ => 'hx' } qw(haxe)),
 441         (map { $_ => 'icl' } qw(clean)),
 442         (map { $_ => 'icn' } qw(icon)),
 443         (map { $_ => 'ili' } qw(interlis)),
 444         (map { $_ => 'inp' } qw(fame)),
 445         (map { $_ => 'iss' } qw(innosetup)),
 446         (map { $_ => 'j' } qw(jasmin)),
 447         (map { $_ => 'java' } qw(groovy grv)),
 448         (map { $_ => 'lbn' } qw(luban)),
 449         (map { $_ => 'lgt' } qw(logtalk)),
 450         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 451         (map { $_ => 'ls' } qw(lotus)),
 452         (map { $_ => 'lsl' } qw(lindenscript)),
 453         (map { $_ => 'ly' } qw(lilypond)),
 454         (map { $_ => 'make' } qw(mak mk kmk)),
 455         (map { $_ => 'mel' } qw(maya)),
 456         (map { $_ => 'mib' } qw(smi snmp)),
 457         (map { $_ => 'ml' } qw(mli ocaml)),
 458         (map { $_ => 'mo' } qw(modelica)),
 459         (map { $_ => 'mod2' } qw(def mod)),
 460         (map { $_ => 'mod3' } qw(i3 m3)),
 461         (map { $_ => 'mpl' } qw(maple)),
 462         (map { $_ => 'n' } qw(nemerle)),
 463         (map { $_ => 'nas' } qw(nasal)),
 464         (map { $_ => 'nrx' } qw(netrexx)),
 465         (map { $_ => 'nsi' } qw(nsis)),
 466         (map { $_ => 'nut' } qw(squirrel)),
 467         (map { $_ => 'oberon' } qw(ooc)),
 468         (map { $_ => 'objc' } qw(M m mm)),
 469         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 470         (map { $_ => 'pike' } qw(pmod)),
 471         (map { $_ => 'pl' } qw(perl plex plx pm)),
 472         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 473         (map { $_ => 'progress' } qw(i p w)),
 474         (map { $_ => 'py' } qw(python)),
 475         (map { $_ => 'pyx' } qw(pyrex)),
 476         (map { $_ => 'rb' } qw(pp rjs ruby)),
 477         (map { $_ => 'rexx' } qw(rex rx the)),
 478         (map { $_ => 'sc' } qw(paradox)),
 479         (map { $_ => 'scilab' } qw(sce sci)),
 480         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 481         (map { $_ => 'sma' } qw(small)),
 482         (map { $_ => 'smalltalk' } qw(gst sq st)),
 483         (map { $_ => 'sno' } qw(snobal)),
 484         (map { $_ => 'sybase' } qw(sp)),
 485         (map { $_ => 'tcl' } qw(itcl wish)),
 486         (map { $_ => 'tex' } qw(cls sty)),
 487         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 488         (map { $_ => 'verilog' } qw(v)),
 489         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 490         (map { $_ => 'y' } qw(bison)),
 491 );
 492
 493 # You define site-wide feature defaults here; override them with
 494 # $GITWEB_CONFIG as necessary.
 495 our %feature = (
 496         # feature => {
 497         #       'sub' => feature-sub (subroutine),
 498         #       'override' => allow-override (boolean),
 499         #       'default' => [ default options...] (array reference)}
 500         #
 501         # if feature is overridable (it means that allow-override has true value),
 502         # then feature-sub will be called with default options as parameters;
 503         # return value of feature-sub indicates if to enable specified feature
 504         #
 505         # if there is no 'sub' key (no feature-sub), then feature cannot be
 506         # overridden
 507         #
 508         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 509         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 510         # is enabled
 511
 512         # Enable the 'blame' blob view, showing the last commit that modified
 513         # each line in the file. This can be very CPU-intensive.
 514
 515         # To enable system wide have in $GITWEB_CONFIG
 516         # $feature{'blame'}{'default'} = [1];
 517         # To have project specific config enable override in $GITWEB_CONFIG
 518         # $feature{'blame'}{'override'} = 1;
 519         # and in project config gitweb.blame = 0|1;
 520         'blame' => {
 521                 'sub' => sub { feature_bool('blame', @_) },
 522                 'override' => 0,
 523                 'default' => [0]},
 524
 525         # Enable the 'incremental blame' blob view, which uses javascript to
 526         # incrementally show the revisions of lines as they are discovered
 527         # in the history. It is better for large histories, files and slow
 528         # servers, but requires javascript in the client and can slow down the
 529         # browser on large files.
 530
 531         # To enable system wide have in $GITWEB_CONFIG
 532         # $feature{'blame_incremental'}{'default'} = [1];
 533         # To have project specific config enable override in $GITWEB_CONFIG
 534         # $feature{'blame_incremental'}{'override'} = 1;
 535         # and in project config gitweb.blame_incremental = 0|1;
 536         'blame_incremental' => {
 537                 'sub' => sub { feature_bool('blame_incremental', @_) },
 538                 'override' => 0,
 539                 'default' => [0]},
 540
 541         # Enable the 'snapshot' link, providing a compressed archive of any
 542         # tree. This can potentially generate high traffic if you have large
 543         # project.
 544
 545         # Value is a list of formats defined in %known_snapshot_formats that
 546         # you wish to offer.
 547         # To disable system wide have in $GITWEB_CONFIG
 548         # $feature{'snapshot'}{'default'} = [];
 549         # To have project specific config enable override in $GITWEB_CONFIG
 550         # $feature{'snapshot'}{'override'} = 1;
 551         # and in project config, a comma-separated list of formats or "none"
 552         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 553         'snapshot' => {
 554                 'sub' => \&feature_snapshot,
 555                 'override' => 0,
 556                 'default' => ['tgz']},
 557
 558         # Enable text search, which will list the commits which match author,
 559         # committer or commit text to a given string.  Enabled by default.
 560         # Project specific override is not supported.
 561         #
 562         # Note that this controls all search features, which means that if
 563         # it is disabled, then 'grep' and 'pickaxe' search would also be
 564         # disabled.
 565         'search' => {
 566                 'override' => 0,
 567                 'default' => [1]},
 568
 569         # Enable grep search, which will list the files in currently selected
 570         # tree containing the given string. Enabled by default. This can be
 571         # potentially CPU-intensive, of course.
 572         # Note that you need to have 'search' feature enabled too.
 573
 574         # To enable system wide have in $GITWEB_CONFIG
 575         # $feature{'grep'}{'default'} = [1];
 576         # To have project specific config enable override in $GITWEB_CONFIG
 577         # $feature{'grep'}{'override'} = 1;
 578         # and in project config gitweb.grep = 0|1;
 579         'grep' => {
 580                 'sub' => sub { feature_bool('grep', @_) },
 581                 'override' => 0,
 582                 'default' => [1]},
 583
 584         # Enable the pickaxe search, which will list the commits that modified
 585         # a given string in a file. This can be practical and quite faster
 586         # alternative to 'blame', but still potentially CPU-intensive.
 587         # Note that you need to have 'search' feature enabled too.
 588
 589         # To enable system wide have in $GITWEB_CONFIG
 590         # $feature{'pickaxe'}{'default'} = [1];
 591         # To have project specific config enable override in $GITWEB_CONFIG
 592         # $feature{'pickaxe'}{'override'} = 1;
 593         # and in project config gitweb.pickaxe = 0|1;
 594         'pickaxe' => {
 595                 'sub' => sub { feature_bool('pickaxe', @_) },
 596                 'override' => 0,
 597                 'default' => [1]},
 598
 599         # Enable showing size of blobs in a 'tree' view, in a separate
 600         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 601
 602         # To disable system wide have in $GITWEB_CONFIG
 603         # $feature{'show-sizes'}{'default'} = [0];
 604         # To have project specific config enable override in $GITWEB_CONFIG
 605         # $feature{'show-sizes'}{'override'} = 1;
 606         # and in project config gitweb.showsizes = 0|1;
 607         'show-sizes' => {
 608                 'sub' => sub { feature_bool('showsizes', @_) },
 609                 'override' => 0,
 610                 'default' => [1]},
 611
 612         # Make gitweb use an alternative format of the URLs which can be
 613         # more readable and natural-looking: project name is embedded
 614         # directly in the path and the query string contains other
 615         # auxiliary information. All gitweb installations recognize
 616         # URL in either format; this configures in which formats gitweb
 617         # generates links.
 618
 619         # To enable system wide have in $GITWEB_CONFIG
 620         # $feature{'pathinfo'}{'default'} = [1];
 621         # Project specific override is not supported.
 622
 623         # Note that you will need to change the default location of CSS,
 624         # favicon, logo and possibly other files to an absolute URL. Also,
 625         # if gitweb.cgi serves as your indexfile, you will need to force
 626         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 627         # will also likely want to set $home_link if you're setting $my_uri).
 628         'pathinfo' => {
 629                 'override' => 0,
 630                 'default' => [0]},
 631
 632         # Make gitweb consider projects in project root subdirectories
 633         # to be forks of existing projects. Given project $projname.git,
 634         # projects matching $projname/*.git will not be shown in the main
 635         # projects list, instead a '+' mark will be added to $projname
 636         # there and a 'forks' view will be enabled for the project, listing
 637         # all the forks. If project list is taken from a file, forks have
 638         # to be listed after the main project.
 639
 640         # To enable system wide have in $GITWEB_CONFIG
 641         # $feature{'forks'}{'default'} = [1];
 642         # Project specific override is not supported.
 643         'forks' => {
 644                 'override' => 0,
 645                 'default' => [0]},
 646
 647         # Insert custom links to the action bar of all project pages.
 648         # This enables you mainly to link to third-party scripts integrating
 649         # into gitweb; e.g. git-browser for graphical history representation
 650         # or custom web-based repository administration interface.
 651
 652         # The 'default' value consists of a list of triplets in the form
 653         # (label, link, position) where position is the label after which
 654         # to insert the link and link is a format string where %n expands
 655         # to the project name, %f to the project path within the filesystem,
 656         # %h to the current hash (h gitweb parameter) and %b to the current
 657         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 658         # project name where all '+' characters have been replaced with '%2B'.
 659
 660         # To enable system wide have in $GITWEB_CONFIG e.g.
 661         # $feature{'actions'}{'default'} = [('graphiclog',
 662         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 663         # Project specific override is not supported.
 664         'actions' => {
 665                 'override' => 0,
 666                 'default' => []},
 667
 668         # Allow gitweb scan project content tags of project repository,
 669         # and display the popular Web 2.0-ish "tag cloud" near the projects
 670         # list.  Note that this is something COMPLETELY different from the
 671         # normal Git tags.
 672
 673         # gitweb by itself can show existing tags, but it does not handle
 674         # tagging itself; you need to do it externally, outside gitweb.
 675         # The format is described in git_get_project_ctags() subroutine.
 676         # You may want to install the HTML::TagCloud Perl module to get
 677         # a pretty tag cloud instead of just a list of tags.
 678
 679         # To enable system wide have in $GITWEB_CONFIG
 680         # $feature{'ctags'}{'default'} = [1];
 681         # Project specific override is not supported.
 682
 683         # A value of 0 means no ctags display or editing.  A value of
 684         # 1 enables ctags display but never editing.  A non-empty value
 685         # that is not a string of digits enables ctags display AND the
 686         # ability to add tags using a form that uses method POST and
 687         # an action value set to the configured 'ctags' value.
 688         'ctags' => {
 689                 'override' => 0,
 690                 'default' => [0]},
 691
 692         # The maximum number of patches in a patchset generated in patch
 693         # view. Set this to 0 or undef to disable patch view, or to a
 694         # negative number to remove any limit.
 695
 696         # To disable system wide have in $GITWEB_CONFIG
 697         # $feature{'patches'}{'default'} = [0];
 698         # To have project specific config enable override in $GITWEB_CONFIG
 699         # $feature{'patches'}{'override'} = 1;
 700         # and in project config gitweb.patches = 0|n;
 701         # where n is the maximum number of patches allowed in a patchset.
 702         'patches' => {
 703                 'sub' => \&feature_patches,
 704                 'override' => 0,
 705                 'default' => [16]},
 706
 707         # Avatar support. When this feature is enabled, views such as
 708         # shortlog or commit will display an avatar associated with
 709         # the email of the committer(s) and/or author(s).
 710
 711         # Currently available providers are gravatar and picon.
 712         # If an unknown provider is specified, the feature is disabled.
 713
 714         # Gravatar depends on Digest::MD5.
 715         # Picon currently relies on the indiana.edu database.
 716
 717         # To enable system wide have in $GITWEB_CONFIG
 718         # $feature{'avatar'}{'default'} = ['<provider>'];
 719         # where <provider> is either gravatar or picon.
 720         # To have project specific config enable override in $GITWEB_CONFIG
 721         # $feature{'avatar'}{'override'} = 1;
 722         # and in project config gitweb.avatar = <provider>;
 723         'avatar' => {
 724                 'sub' => \&feature_avatar,
 725                 'override' => 0,
 726                 'default' => ['']},
 727
 728         # Enable displaying how much time and how many git commands
 729         # it took to generate and display page.  Disabled by default.
 730         # Project specific override is not supported.
 731         'timed' => {
 732                 'override' => 0,
 733                 'default' => [0]},
 734
 735         # Enable turning some links into links to actions which require
 736         # JavaScript to run (like 'blame_incremental').  Not enabled by
 737         # default.  Project specific override is currently not supported.
 738         'javascript-actions' => {
 739                 'override' => 0,
 740                 'default' => [0]},
 741
 742         # Enable and configure ability to change common timezone for dates
 743         # in gitweb output via JavaScript.  Enabled by default.
 744         # Project specific override is not supported.
 745         'javascript-timezone' => {
 746                 'override' => 0,
 747                 'default' => [
 748                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 749                                      # or undef to turn off this feature
 750                         'gitweb_tz', # name of cookie where to store selected timezone
 751                         'datetime',  # CSS class used to mark up dates for manipulation
 752                 ]},
 753
 754         # Syntax highlighting support. This is based on Daniel Svensson's
 755         # and Sham Chukoury's work in gitweb-xmms2.git.
 756         # It requires the 'highlight' program present in $PATH,
 757         # and therefore is disabled by default.
 758
 759         # To enable system wide have in $GITWEB_CONFIG
 760         # $feature{'highlight'}{'default'} = [1];
 761
 762         'highlight' => {
 763                 'sub' => sub { feature_bool('highlight', @_) },
 764                 'override' => 0,
 765                 'default' => [0]},
 766
 767         # Enable displaying of remote heads in the heads list
 768
 769         # To enable system wide have in $GITWEB_CONFIG
 770         # $feature{'remote_heads'}{'default'} = [1];
 771         # To have project specific config enable override in $GITWEB_CONFIG
 772         # $feature{'remote_heads'}{'override'} = 1;
 773         # and in project config gitweb.remoteheads = 0|1;
 774         'remote_heads' => {
 775                 'sub' => sub { feature_bool('remote_heads', @_) },
 776                 'override' => 0,
 777                 'default' => [0]},
 778
 779         # Enable showing branches under other refs in addition to heads
 780
 781         # To set system wide extra branch refs have in $GITWEB_CONFIG
 782         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 783         # To have project specific config enable override in $GITWEB_CONFIG
 784         # $feature{'extra-branch-refs'}{'override'} = 1;
 785         # and in project config gitweb.extrabranchrefs = dirs of choice
 786         # Every directory is separated with whitespace.
 787
 788         'extra-branch-refs' => {
 789                 'sub' => \&feature_extra_branch_refs,
 790                 'override' => 0,
 791                 'default' => []},
 792 );
 793
 794 sub gitweb_get_feature {
 795         my ($name) = @_;
 796         return unless exists $feature{$name};
 797         my ($sub, $override, @defaults) = (
 798                 $feature{$name}{'sub'},
 799                 $feature{$name}{'override'},
 800                 @{$feature{$name}{'default'}});
 801         # project specific override is possible only if we have project
 802         our $git_dir; # global variable, declared later
 803         if (!$override || !defined $git_dir) {
 804                 return @defaults;
 805         }
 806         if (!defined $sub) {
 807                 warn "feature $name is not overridable";
 808                 return @defaults;
 809         }
 810         return $sub->(@defaults);
 811 }
 812
 813 # A wrapper to check if a given feature is enabled.
 814 # With this, you can say
 815 #
 816 #   my $bool_feat = gitweb_check_feature('bool_feat');
 817 #   gitweb_check_feature('bool_feat') or somecode;
 818 #
 819 # instead of
 820 #
 821 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 822 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 823 #
 824 sub gitweb_check_feature {
 825         return (gitweb_get_feature(@_))[0];
 826 }
 827
 828
 829 sub feature_bool {
 830         my $key = shift;
 831         my ($val) = git_get_project_config($key, '--bool');
 832
 833         if (!defined $val) {
 834                 return ($_[0]);
 835         } elsif ($val eq 'true') {
 836                 return (1);
 837         } elsif ($val eq 'false') {
 838                 return (0);
 839         }
 840 }
 841
 842 sub feature_snapshot {
 843         my (@fmts) = @_;
 844
 845         my ($val) = git_get_project_config('snapshot');
 846
 847         if ($val) {
 848                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 849         }
 850
 851         return @fmts;
 852 }
 853
 854 sub feature_patches {
 855         my @val = (git_get_project_config('patches', '--int'));
 856
 857         if (@val) {
 858                 return @val;
 859         }
 860
 861         return ($_[0]);
 862 }
 863
 864 sub feature_avatar {
 865         my @val = (git_get_project_config('avatar'));
 866
 867         return @val ? @val : @_;
 868 }
 869
 870 sub feature_extra_branch_refs {
 871         my (@branch_refs) = @_;
 872         my $values = git_get_project_config('extrabranchrefs');
 873
 874         if ($values) {
 875                 $values = config_to_multi ($values);
 876                 @branch_refs = ();
 877                 foreach my $value (@{$values}) {
 878                         push @branch_refs, split /\s+/, $value;
 879                 }
 880         }
 881
 882         return @branch_refs;
 883 }
 884
 885 # checking HEAD file with -e is fragile if the repository was
 886 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 887 # and then pruned.
 888 sub check_head_link {
 889         my ($dir) = @_;
 890         return 0 unless -d "$dir/objects" && -x _;
 891         return 0 unless -d "$dir/refs" && -x _;
 892         my $headfile = "$dir/HEAD";
 893         return -l $headfile ?
 894                 readlink($headfile) =~ /^refs\/heads\// : -f $headfile;
 895 }
 896
 897 sub check_export_ok {
 898         my ($dir) = @_;
 899         return (check_head_link($dir) &&
 900                 (!$export_ok || -e "$dir/$export_ok") &&
 901                 (!$export_auth_hook || $export_auth_hook->($dir)));
 902 }
 903
 904 # process alternate names for backward compatibility
 905 # filter out unsupported (unknown) snapshot formats
 906 sub filter_snapshot_fmts {
 907         my @fmts = @_;
 908
 909         @fmts = map {
 910                 exists $known_snapshot_format_aliases{$_} ?
 911                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 912         @fmts = grep {
 913                 exists $known_snapshot_formats{$_} &&
 914                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 915 }
 916
 917 sub filter_and_validate_refs {
 918         my @refs = @_;
 919         my %unique_refs = ();
 920
 921         foreach my $ref (@refs) {
 922                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 923                 # 'heads' are added implicitly in get_branch_refs().
 924                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 925         }
 926         return sort keys %unique_refs;
 927 }
 928
 929 # If it is set to code reference, it is code that it is to be run once per
 930 # request, allowing updating configurations that change with each request,
 931 # while running other code in config file only once.
 932 #
 933 # Otherwise, if it is false then gitweb would process config file only once;
 934 # if it is true then gitweb config would be run for each request.
 935 our $per_request_config = 1;
 936
 937 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 938 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 939 # same way as though the --fcgi option had been given instead.
 940 our $auto_fcgi = 0;
 941
 942 # read and parse gitweb config file given by its parameter.
 943 # returns true on success, false on recoverable error, allowing
 944 # to chain this subroutine, using first file that exists.
 945 # dies on errors during parsing config file, as it is unrecoverable.
 946 sub read_config_file {
 947         my $filename = shift;
 948         return unless defined $filename;
 949         # die if there are errors parsing config file
 950         if (-e $filename) {
 951                 do $filename;
 952                 die $@ if $@;
 953                 return 1;
 954         }
 955         return;
 956 }
 957
 958 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
 959 sub evaluate_gitweb_config {
 960         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
 961         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
 962         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
 963
 964         # Protect against duplications of file names, to not read config twice.
 965         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
 966         # there possibility of duplication of filename there doesn't matter.
 967         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
 968         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
 969
 970         # Common system-wide settings for convenience.
 971         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
 972         read_config_file($GITWEB_CONFIG_COMMON);
 973
 974         # Use first config file that exists.  This means use the per-instance
 975         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
 976         read_config_file($GITWEB_CONFIG) and return;
 977         read_config_file($GITWEB_CONFIG_SYSTEM);
 978 }
 979
 980 our $encode_object;
 981
 982 sub evaluate_encoding {
 983         my $requested = $fallback_encoding || 'ISO-8859-1';
 984         my $obj = Encode::find_encoding($requested) or
 985                 die_error(400, "Requested fallback encoding not found");
 986         if ($obj->name eq 'iso-8859-1') {
 987                 # Use Windows-1252 instead as required by the HTML 5 standard
 988                 my $altobj = Encode::find_encoding('Windows-1252');
 989                 $obj = $altobj if $altobj;
 990         }
 991         $encode_object = $obj;
 992 }
 993
 994 sub evaluate_email_obfuscate {
 995         # email obfuscation
 996         our $email;
 997         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
 998                 $email = HTML::Email::Obfuscate->new(lite => 1);
 999         }
1000 }
1001
1002 # Get loadavg of system, to compare against $maxload.
1003 # Currently it requires '/proc/loadavg' present to get loadavg;
1004 # if it is not present it returns 0, which means no load checking.
1005 sub get_loadavg {
1006         if( -e '/proc/loadavg' ){
1007                 open my $fd, '<', '/proc/loadavg'
1008                         or return 0;
1009                 my @load = split(/\s+/, scalar <$fd>);
1010                 close $fd;
1011
1012                 # The first three columns measure CPU and IO utilization of the last one,
1013                 # five, and 10 minute periods.  The fourth column shows the number of
1014                 # currently running processes and the total number of processes in the m/n
1015                 # format.  The last column displays the last process ID used.
1016                 return $load[0] || 0;
1017         }
1018         # additional checks for load average should go here for things that don't export
1019         # /proc/loadavg
1020
1021         return 0;
1022 }
1023
1024 # version of the core git binary
1025 our $git_version;
1026 sub evaluate_git_version {
1027         our $git_version = $version;
1028 }
1029
1030 sub check_loadavg {
1031         if (defined $maxload && get_loadavg() > $maxload) {
1032                 die_error(503, "The load average on the server is too high");
1033         }
1034 }
1035
1036 # ======================================================================
1037 # input validation and dispatch
1038
1039 # input parameters can be collected from a variety of sources (presently, CGI
1040 # and PATH_INFO), so we define an %input_params hash that collects them all
1041 # together during validation: this allows subsequent uses (e.g. href()) to be
1042 # agnostic of the parameter origin
1043
1044 our %input_params = ();
1045
1046 # input parameters are stored with the long parameter name as key. This will
1047 # also be used in the href subroutine to convert parameters to their CGI
1048 # equivalent, and since the href() usage is the most frequent one, we store
1049 # the name -> CGI key mapping here, instead of the reverse.
1050 #
1051 # XXX: Warning: If you touch this, check the search form for updating,
1052 # too.
1053
1054 our @cgi_param_mapping = (
1055         project => "p",
1056         action => "a",
1057         file_name => "f",
1058         file_parent => "fp",
1059         hash => "h",
1060         hash_parent => "hp",
1061         hash_base => "hb",
1062         hash_parent_base => "hpb",
1063         page => "pg",
1064         order => "o",
1065         searchtext => "s",
1066         searchtype => "st",
1067         snapshot_format => "sf",
1068         ctag_filter => 't',
1069         extra_options => "opt",
1070         search_use_regexp => "sr",
1071         ctag => "by_tag",
1072         diff_style => "ds",
1073         project_filter => "pf",
1074         # this must be last entry (for manipulation from JavaScript)
1075         javascript => "js"
1076 );
1077 our %cgi_param_mapping = @cgi_param_mapping;
1078
1079 # we will also need to know the possible actions, for validation
1080 our %actions = (
1081         "blame" => \&git_blame,
1082         "blame_incremental" => \&git_blame_incremental,
1083         "blame_data" => \&git_blame_data,
1084         "blobdiff" => \&git_blobdiff,
1085         "blobdiff_plain" => \&git_blobdiff_plain,
1086         "blob" => \&git_blob,
1087         "blob_plain" => \&git_blob_plain,
1088         "commitdiff" => \&git_commitdiff,
1089         "commitdiff_plain" => \&git_commitdiff_plain,
1090         "commit" => \&git_commit,
1091         "forks" => \&git_forks,
1092         "heads" => \&git_heads,
1093         "history" => \&git_history,
1094         "log" => \&git_log,
1095         "patch" => \&git_patch,
1096         "patches" => \&git_patches,
1097         "refs" => \&git_refs,
1098         "remotes" => \&git_remotes,
1099         "rss" => \&git_rss,
1100         "atom" => \&git_atom,
1101         "search" => \&git_search,
1102         "search_help" => \&git_search_help,
1103         "shortlog" => \&git_shortlog,
1104         "summary" => \&git_summary,
1105         "tag" => \&git_tag,
1106         "tags" => \&git_tags,
1107         "tree" => \&git_tree,
1108         "snapshot" => \&git_snapshot,
1109         "object" => \&git_object,
1110         # those below don't need $project
1111         "opml" => \&git_opml,
1112         "frontpage" => \&git_frontpage,
1113         "project_list" => \&git_project_list,
1114         "project_index" => \&git_project_index,
1115 );
1116
1117 # the only actions we will allow to be cached
1118 my %supported_cache_actions;
1119 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1120
1121 # finally, we have the hash of allowed extra_options for the commands that
1122 # allow them
1123 our %allowed_options = (
1124         "--no-merges" => [ qw(rss atom log shortlog history) ],
1125 );
1126
1127 # fill %input_params with the CGI parameters. All values except for 'opt'
1128 # should be single values, but opt can be an array. We should probably
1129 # build an array of parameters that can be multi-valued, but since for the time
1130 # being it's only this one, we just single it out
1131 sub evaluate_query_params {
1132         our $cgi;
1133
1134         while (my ($name, $symbol) = each %cgi_param_mapping) {
1135                 if ($symbol eq 'opt') {
1136                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1137                 } else {
1138                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1139                 }
1140         }
1141
1142         # Backwards compatibility - by_tag= <=> t=
1143         if ($input_params{'ctag'}) {
1144                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1145         }
1146 }
1147
1148 # now read PATH_INFO and update the parameter list for missing parameters
1149 sub evaluate_path_info {
1150         return if defined $input_params{'project'};
1151         return if !$path_info;
1152         $path_info =~ s,^/+,,;
1153         return if !$path_info;
1154
1155         # find which part of PATH_INFO is project
1156         my $project = $path_info;
1157         $project =~ s,/+$,,;
1158         while ($project && !check_head_link("$projectroot/$project")) {
1159                 $project =~ s,/*[^/]*$,,;
1160         }
1161         return unless $project;
1162         $input_params{'project'} = $project;
1163
1164         # do not change any parameters if an action is given using the query string
1165         return if $input_params{'action'};
1166         $path_info =~ s,^\Q$project\E/*,,;
1167
1168         # next, check if we have an action
1169         my $action = $path_info;
1170         $action =~ s,/.*$,,;
1171         if (exists $actions{$action}) {
1172                 $path_info =~ s,^$action/*,,;
1173                 $input_params{'action'} = $action;
1174         }
1175
1176         # list of actions that want hash_base instead of hash, but can have no
1177         # pathname (f) parameter
1178         my @wants_base = (
1179                 'tree',
1180                 'history',
1181         );
1182
1183         # we want to catch, among others
1184         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1185         my ($parentrefname, $parentpathname, $refname, $pathname) =
1186                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1187
1188         # first, analyze the 'current' part
1189         if (defined $pathname) {
1190                 # we got "branch:filename" or "branch:dir/"
1191                 # we could use git_get_type(branch:pathname), but:
1192                 # - it needs $git_dir
1193                 # - it does a git() call
1194                 # - the convention of terminating directories with a slash
1195                 #   makes it superfluous
1196                 # - embedding the action in the PATH_INFO would make it even
1197                 #   more superfluous
1198                 $pathname =~ s,^/+,,;
1199                 if (!$pathname || substr($pathname, -1) eq "/") {
1200                         $input_params{'action'} ||= "tree";
1201                         $pathname =~ s,/$,,;
1202                 } else {
1203                         # the default action depends on whether we had parent info
1204                         # or not
1205                         if ($parentrefname) {
1206                                 $input_params{'action'} ||= "blobdiff_plain";
1207                         } else {
1208                                 $input_params{'action'} ||= "blob_plain";
1209                         }
1210                 }
1211                 $input_params{'hash_base'} ||= $refname;
1212                 $input_params{'file_name'} ||= $pathname;
1213         } elsif (defined $refname) {
1214                 # we got "branch". In this case we have to choose if we have to
1215                 # set hash or hash_base.
1216                 #
1217                 # Most of the actions without a pathname only want hash to be
1218                 # set, except for the ones specified in @wants_base that want
1219                 # hash_base instead. It should also be noted that hand-crafted
1220                 # links having 'history' as an action and no pathname or hash
1221                 # set will fail, but that happens regardless of PATH_INFO.
1222                 if (defined $parentrefname) {
1223                         # if there is parent let the default be 'shortlog' action
1224                         # (for http://git.example.com/repo.git/A..B links); if there
1225                         # is no parent, dispatch will detect type of object and set
1226                         # action appropriately if required (if action is not set)
1227                         $input_params{'action'} ||= "shortlog";
1228                 }
1229                 if ($input_params{'action'} &&
1230                     grep { $_ eq $input_params{'action'} } @wants_base) {
1231                         $input_params{'hash_base'} ||= $refname;
1232                 } else {
1233                         $input_params{'hash'} ||= $refname;
1234                 }
1235         }
1236
1237         # next, handle the 'parent' part, if present
1238         if (defined $parentrefname) {
1239                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1240                 # someproject/blobdiff/oldrev..newrev:/filename
1241                 if ($parentpathname) {
1242                         $parentpathname =~ s,^/+,,;
1243                         $parentpathname =~ s,/$,,;
1244                         $input_params{'file_parent'} ||= $parentpathname;
1245                 } else {
1246                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1247                 }
1248                 # we assume that hash_parent_base is wanted if a path was specified,
1249                 # or if the action wants hash_base instead of hash
1250                 if (defined $input_params{'file_parent'} ||
1251                         grep { $_ eq $input_params{'action'} } @wants_base) {
1252                         $input_params{'hash_parent_base'} ||= $parentrefname;
1253                 } else {
1254                         $input_params{'hash_parent'} ||= $parentrefname;
1255                 }
1256         }
1257
1258         # for the snapshot action, we allow URLs in the form
1259         # $project/snapshot/$hash.ext
1260         # where .ext determines the snapshot and gets removed from the
1261         # passed $refname to provide the $hash.
1262         #
1263         # To be able to tell that $refname includes the format extension, we
1264         # require the following two conditions to be satisfied:
1265         # - the hash input parameter MUST have been set from the $refname part
1266         #   of the URL (i.e. they must be equal)
1267         # - the snapshot format MUST NOT have been defined already (e.g. from
1268         #   CGI parameter sf)
1269         # It's also useless to try any matching unless $refname has a dot,
1270         # so we check for that too
1271         if (defined $input_params{'action'} &&
1272                 $input_params{'action'} eq 'snapshot' &&
1273                 defined $refname && index($refname, '.') != -1 &&
1274                 $refname eq $input_params{'hash'} &&
1275                 !defined $input_params{'snapshot_format'}) {
1276                 # We loop over the known snapshot formats, checking for
1277                 # extensions. Allowed extensions are both the defined suffix
1278                 # (which includes the initial dot already) and the snapshot
1279                 # format key itself, with a prepended dot
1280                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1281                         my $hash = $refname;
1282                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1283                                 next;
1284                         }
1285                         my $sfx = $1;
1286                         # a valid suffix was found, so set the snapshot format
1287                         # and reset the hash parameter
1288                         $input_params{'snapshot_format'} = $fmt;
1289                         $input_params{'hash'} = $hash;
1290                         # we also set the format suffix to the one requested
1291                         # in the URL: this way a request for e.g. .tgz returns
1292                         # a .tgz instead of a .tar.gz
1293                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1294                         last;
1295                 }
1296         }
1297 }
1298
1299 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1300      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1301      $searchtext, $search_regexp, $project_filter);
1302 sub evaluate_and_validate_params {
1303         our $action = $input_params{'action'};
1304         if (defined $action) {
1305                 if (!is_valid_action($action)) {
1306                         die_error(400, "Invalid action parameter");
1307                 }
1308         }
1309
1310         # parameters which are pathnames
1311         our $project = $input_params{'project'};
1312         if (defined $project) {
1313                 if (!is_valid_project($project)) {
1314                         undef $project;
1315                         die_error(404, "No such project");
1316                 }
1317         }
1318
1319         our $project_filter = $input_params{'project_filter'};
1320         if (defined $project_filter) {
1321                 if (!is_valid_pathname($project_filter)) {
1322                         die_error(404, "Invalid project_filter parameter");
1323                 }
1324         }
1325
1326         our $file_name = $input_params{'file_name'};
1327         if (defined $file_name) {
1328                 if (!is_valid_pathname($file_name)) {
1329                         die_error(400, "Invalid file parameter");
1330                 }
1331         }
1332
1333         our $file_parent = $input_params{'file_parent'};
1334         if (defined $file_parent) {
1335                 if (!is_valid_pathname($file_parent)) {
1336                         die_error(400, "Invalid file parent parameter");
1337                 }
1338         }
1339
1340         # parameters which are refnames
1341         our $hash = $input_params{'hash'};
1342         if (defined $hash) {
1343                 if (!is_valid_refname($hash)) {
1344                         die_error(400, "Invalid hash parameter");
1345                 }
1346         }
1347
1348         our $hash_parent = $input_params{'hash_parent'};
1349         if (defined $hash_parent) {
1350                 if (!is_valid_refname($hash_parent)) {
1351                         die_error(400, "Invalid hash parent parameter");
1352                 }
1353         }
1354
1355         our $hash_base = $input_params{'hash_base'};
1356         if (defined $hash_base) {
1357                 if (!is_valid_refname($hash_base)) {
1358                         die_error(400, "Invalid hash base parameter");
1359                 }
1360         }
1361
1362         our @extra_options = @{$input_params{'extra_options'}};
1363         # @extra_options is always defined, since it can only be (currently) set from
1364         # CGI, and $cgi->param() returns the empty array in array context if the param
1365         # is not set
1366         foreach my $opt (@extra_options) {
1367                 if (not exists $allowed_options{$opt}) {
1368                         die_error(400, "Invalid option parameter");
1369                 }
1370                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1371                         die_error(400, "Invalid option parameter for this action");
1372                 }
1373         }
1374
1375         our $hash_parent_base = $input_params{'hash_parent_base'};
1376         if (defined $hash_parent_base) {
1377                 if (!is_valid_refname($hash_parent_base)) {
1378                         die_error(400, "Invalid hash parent base parameter");
1379                 }
1380         }
1381
1382         # other parameters
1383         our $page = $input_params{'page'};
1384         if (defined $page) {
1385                 if ($page =~ m/[^0-9]/) {
1386                         die_error(400, "Invalid page parameter");
1387                 }
1388         }
1389
1390         our $searchtype = $input_params{'searchtype'};
1391         if (defined $searchtype) {
1392                 if ($searchtype =~ m/[^a-z]/) {
1393                         die_error(400, "Invalid searchtype parameter");
1394                 }
1395         }
1396
1397         our $search_use_regexp = $input_params{'search_use_regexp'};
1398
1399         our $searchtext = $input_params{'searchtext'};
1400         our $search_regexp = undef;
1401         if (defined $searchtext) {
1402                 if (length($searchtext) < 2) {
1403                         die_error(403, "At least two characters are required for search parameter");
1404                 }
1405                 if ($search_use_regexp) {
1406                         $search_regexp = $searchtext;
1407                         if (!eval { qr/$search_regexp/; 1; }) {
1408                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1409                                 die_error(400, "Invalid search regexp '$search_regexp'",
1410                                           esc_html($error));
1411                         }
1412                 } else {
1413                         $search_regexp = quotemeta $searchtext;
1414                 }
1415         }
1416 }
1417
1418 # path to the current git repository
1419 our $git_dir;
1420 sub evaluate_git_dir {
1421         our $git_dir = $project ? "$projectroot/$project" : undef;
1422 }
1423
1424 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1425 sub configure_gitweb_features {
1426         # list of supported snapshot formats
1427         our @snapshot_fmts = gitweb_get_feature('snapshot');
1428         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1429
1430         # check that the avatar feature is set to a known provider name,
1431         # and for each provider check if the dependencies are satisfied.
1432         # if the provider name is invalid or the dependencies are not met,
1433         # reset $git_avatar to the empty string.
1434         our ($git_avatar) = gitweb_get_feature('avatar');
1435         if ($git_avatar eq 'gravatar') {
1436                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1437         } elsif ($git_avatar eq 'picon') {
1438                 # no dependencies
1439         } else {
1440                 $git_avatar = '';
1441         }
1442
1443         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1444         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1445 }
1446
1447 sub get_branch_refs {
1448         return ('heads', @extra_branch_refs);
1449 }
1450
1451 # custom error handler: 'die <message>' is Internal Server Error
1452 sub handle_errors_html {
1453         my $msg = shift; # it is already HTML escaped
1454
1455         # to avoid infinite loop where error occurs in die_error,
1456         # change handler to default handler, disabling handle_errors_html
1457         set_message("Error occurred when inside die_error:\n$msg");
1458
1459         # you cannot jump out of die_error when called as error handler;
1460         # the subroutine set via CGI::Carp::set_message is called _after_
1461         # HTTP headers are already written, so it cannot write them itself
1462         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1463 }
1464 set_message(\&handle_errors_html);
1465
1466 our $shown_stale_message = 0;
1467 our $cache_dump = undef;
1468 our $cache_dump_mtime = undef;
1469
1470 # dispatch
1471 my $cache_mode_active;
1472 sub dispatch {
1473         $shown_stale_message = 0;
1474         if (!defined $action) {
1475                 if (defined $hash) {
1476                         $action = git_get_type($hash);
1477                         $action or die_error(404, "Object does not exist");
1478                 } elsif (defined $hash_base && defined $file_name) {
1479                         $action = git_get_type("$hash_base:$file_name");
1480                         $action or die_error(404, "File or directory does not exist");
1481                 } elsif (defined $project) {
1482                         $action = 'summary';
1483                 } else {
1484                         $action = 'frontpage';
1485                 }
1486         }
1487         if (!defined($actions{$action})) {
1488                 die_error(400, "Unknown action");
1489         }
1490         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1491             !$project) {
1492                 die_error(400, "Project needed");
1493         }
1494
1495         my $cached_page = $supported_cache_actions{$action}
1496                 ? cached_action_page($action)
1497                 : undef;
1498         goto DUMPCACHE if $cached_page;
1499         local *SAVEOUT = *STDOUT;
1500         $cache_mode_active = $supported_cache_actions{$action}
1501                 ? cached_action_start($action)
1502                 : undef;
1503
1504         configure_gitweb_features();
1505         $actions{$action}->();
1506
1507         return unless $cache_mode_active;
1508
1509         $cached_page = cached_action_finish($action);
1510         *STDOUT = *SAVEOUT;
1511
1512         DUMPCACHE:
1513
1514         $cache_mode_active = 0;
1515         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1516         binmode STDOUT, ':raw';
1517         our $fcgi_raw_mode = 1;
1518         print expand_gitweb_pi($cached_page, time);
1519         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1520         $fcgi_raw_mode = 0;
1521 }
1522
1523 sub reset_timer {
1524         our $t0 = [ gettimeofday() ]
1525                 if defined $t0;
1526         our $number_of_git_cmds = 0;
1527 }
1528
1529 our $first_request = 1;
1530 our $evaluate_uri_force = undef;
1531 sub run_request {
1532         reset_timer();
1533
1534         # do not reuse stale config or project list from prior FCGI request
1535         our $config_file = '';
1536         our $gitweb_project_owner = undef;
1537
1538         # Only allow GET and HEAD methods
1539         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1540                 print <<EOT;
1541 Status: 405 Method Not Allowed
1542 Content-Type: text/plain
1543 Allow: GET,HEAD
1544
1545 405 Method Not Allowed
1546 EOT
1547                 return;
1548         }
1549
1550         evaluate_uri();
1551         &$evaluate_uri_force() if $evaluate_uri_force;
1552         if ($per_request_config) {
1553                 if (ref($per_request_config) eq 'CODE') {
1554                         $per_request_config->();
1555                 } elsif (!$first_request) {
1556                         evaluate_gitweb_config();
1557                         evaluate_email_obfuscate();
1558                 }
1559         }
1560         check_loadavg();
1561
1562         # $projectroot and $projects_list might be set in gitweb config file
1563         $projects_list ||= $projectroot;
1564
1565         evaluate_query_params();
1566         evaluate_path_info();
1567         evaluate_and_validate_params();
1568         evaluate_git_dir();
1569
1570         dispatch();
1571 }
1572
1573 our $is_last_request = sub { 1 };
1574 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1575 our $CGI = 'CGI';
1576 our $cgi;
1577 our $fcgi_mode = 0;
1578 our $fcgi_nproc_active = 0;
1579 our $fcgi_raw_mode = 0;
1580 sub is_fcgi {
1581         use Errno;
1582         my $stdinfno = fileno STDIN;
1583         return 0 unless defined $stdinfno && $stdinfno == 0;
1584         return 0 unless getsockname STDIN;
1585         return 0 if getpeername STDIN;
1586         return $!{ENOTCONN}?1:0;
1587 }
1588 sub configure_as_fcgi {
1589         return if $fcgi_mode;
1590
1591         require FCGI;
1592         require CGI::Fast;
1593
1594         # We have gone to great effort to make sure that all incoming data has
1595         # been converted from whatever format it was in into UTF-8.  We have
1596         # even taken care to make sure the output handle is in ':utf8' mode.
1597         # Now along comes FCGI and blows it with:
1598         #
1599         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1600         #      and will stop wprking[sic] in a future version of FCGI
1601         #
1602         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1603         # first encodes everything and then calls the original routine, but
1604         # not if $fcgi_raw_mode is true (then we just call the original routine).
1605         #
1606         # Note that we could do this by using utf8::is_utf8 to check instead
1607         # of having a $fcgi_raw_mode global, but that would be slower to run
1608         # the test on each element and much slower than skipping the conversion
1609         # entirely when we know we're outputting raw bytes.
1610         my $orig = \&FCGI::Stream::PRINT;
1611         undef *FCGI::Stream::PRINT;
1612         *FCGI::Stream::PRINT = sub {
1613                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1614                         unless $fcgi_raw_mode;
1615                 goto $orig;
1616         };
1617
1618         our $CGI = 'CGI::Fast';
1619
1620         $fcgi_mode = 1;
1621         $first_request = 0;
1622         my $request_number = 0;
1623         # let each child service 100 requests
1624         our $is_last_request = sub { ++$request_number > 100 };
1625 }
1626 sub evaluate_argv {
1627         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1628         configure_as_fcgi()
1629                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1630
1631         my $nproc_sub = sub {
1632                 my ($arg, $val) = @_;
1633                 return unless eval { require FCGI::ProcManager; 1; };
1634                 $fcgi_nproc_active = 1;
1635                 my $proc_manager = FCGI::ProcManager->new({
1636                         n_processes => $val,
1637                 });
1638                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1639                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1640                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1641         };
1642         if (@ARGV) {
1643                 require Getopt::Long;
1644                 Getopt::Long::GetOptions(
1645                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1646                         'nproc|n=i' => $nproc_sub,
1647                 );
1648         };
1649         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1650                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1651         }
1652 }
1653
1654 sub run {
1655         evaluate_gitweb_config();
1656         evaluate_encoding();
1657         evaluate_email_obfuscate();
1658         evaluate_git_version();
1659         my ($mu, $hl, $subroutine) = ($my_uri, $home_link, '');
1660         $subroutine .= '$my_uri = $mu;' if defined $my_uri && $my_uri ne '';
1661         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1662         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1663         $first_request = 1;
1664         evaluate_argv();
1665
1666         $pre_listen_hook->()
1667                 if $pre_listen_hook;
1668
1669  REQUEST:
1670         while ($cgi = $CGI->new()) {
1671                 $pre_dispatch_hook->()
1672                         if $pre_dispatch_hook;
1673
1674                 run_request();
1675
1676                 $post_dispatch_hook->()
1677                         if $post_dispatch_hook;
1678                 $first_request = 0;
1679
1680                 last REQUEST if ($is_last_request->());
1681         }
1682
1683  DONE_GITWEB:
1684         1;
1685 }
1686
1687 run();
1688
1689 if (defined caller) {
1690         # wrapped in a subroutine processing requests,
1691         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1692         return;
1693 } else {
1694         # pure CGI script, serving single request
1695         exit;
1696 }
1697
1698 ## ======================================================================
1699 ## action links
1700
1701 # possible values of extra options
1702 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1703 # -replay => 1      - start from a current view (replay with modifications)
1704 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1705 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1706 sub href {
1707         my %params = @_;
1708         # default is to use -absolute url() i.e. $my_uri
1709         my $href = $params{-full} ? $my_url : $my_uri;
1710
1711         # implicit -replay, must be first of implicit params
1712         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1713
1714         $params{'project'} = $project unless exists $params{'project'};
1715
1716         if ($params{-replay}) {
1717                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1718                         if (!exists $params{$name}) {
1719                                 $params{$name} = $input_params{$name};
1720                         }
1721                 }
1722         }
1723
1724         my $use_pathinfo = gitweb_check_feature('pathinfo');
1725         if (defined $params{'project'} &&
1726             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1727                 # try to put as many parameters as possible in PATH_INFO:
1728                 #   - project name
1729                 #   - action
1730                 #   - hash_parent or hash_parent_base:/file_parent
1731                 #   - hash or hash_base:/filename
1732                 #   - the snapshot_format as an appropriate suffix
1733
1734                 # When the script is the root DirectoryIndex for the domain,
1735                 # $href here would be something like http://gitweb.example.com/
1736                 # Thus, we strip any trailing / from $href, to spare us double
1737                 # slashes in the final URL
1738                 $href =~ s,/$,,;
1739
1740                 # Then add the project name, if present
1741                 $href .= "/".esc_path_info($params{'project'});
1742                 delete $params{'project'};
1743
1744                 # since we destructively absorb parameters, we keep this
1745                 # boolean that remembers if we're handling a snapshot
1746                 my $is_snapshot = $params{'action'} eq 'snapshot';
1747
1748                 # Summary just uses the project path URL, any other action is
1749                 # added to the URL
1750                 if (defined $params{'action'}) {
1751                         $href .= "/".esc_path_info($params{'action'})
1752                                 unless $params{'action'} eq 'summary';
1753                         delete $params{'action'};
1754                 }
1755
1756                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1757                 # stripping nonexistent or useless pieces
1758                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1759                         || $params{'hash_parent'} || $params{'hash'});
1760                 if (defined $params{'hash_base'}) {
1761                         if (defined $params{'hash_parent_base'}) {
1762                                 $href .= esc_path_info($params{'hash_parent_base'});
1763                                 # skip the file_parent if it's the same as the file_name
1764                                 if (defined $params{'file_parent'}) {
1765                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1766                                                 delete $params{'file_parent'};
1767                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1768                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1769                                                 delete $params{'file_parent'};
1770                                         }
1771                                 }
1772                                 $href .= "..";
1773                                 delete $params{'hash_parent'};
1774                                 delete $params{'hash_parent_base'};
1775                         } elsif (defined $params{'hash_parent'}) {
1776                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1777                                 delete $params{'hash_parent'};
1778                         }
1779
1780                         $href .= esc_path_info($params{'hash_base'});
1781                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1782                                 $href .= ":/".esc_path_info($params{'file_name'});
1783                                 delete $params{'file_name'};
1784                         }
1785                         delete $params{'hash'};
1786                         delete $params{'hash_base'};
1787                 } elsif (defined $params{'hash'}) {
1788                         $href .= esc_path_info($params{'hash'});
1789                         delete $params{'hash'};
1790                 }
1791
1792                 # If the action was a snapshot, we can absorb the
1793                 # snapshot_format parameter too
1794                 if ($is_snapshot) {
1795                         my $fmt = $params{'snapshot_format'};
1796                         # snapshot_format should always be defined when href()
1797                         # is called, but just in case some code forgets, we
1798                         # fall back to the default
1799                         $fmt ||= $snapshot_fmts[0];
1800                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1801                         delete $params{'snapshot_format'};
1802                 }
1803         }
1804
1805         # now encode the parameters explicitly
1806         my @result = ();
1807         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1808                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1809                 if (defined $params{$name}) {
1810                         if (ref($params{$name}) eq "ARRAY") {
1811                                 foreach my $par (@{$params{$name}}) {
1812                                         push @result, $symbol . "=" . esc_param($par);
1813                                 }
1814                         } else {
1815                                 push @result, $symbol . "=" . esc_param($params{$name});
1816                         }
1817                 }
1818         }
1819         $href .= "?" . join(';', @result) if scalar @result;
1820
1821         # final transformation: trailing spaces must be escaped (URI-encoded)
1822         $href =~ s/(\s+)$/CGI::escape($1)/e;
1823
1824         if ($params{-anchor}) {
1825                 $href .= "#".esc_param($params{-anchor});
1826         }
1827
1828         return $href;
1829 }
1830
1831
1832 ## ======================================================================
1833 ## validation, quoting/unquoting and escaping
1834
1835 sub is_valid_action {
1836         my $input = shift;
1837         return undef unless exists $actions{$input};
1838         return 1;
1839 }
1840
1841 sub is_valid_project {
1842         my $input = shift;
1843
1844         return unless defined $input;
1845         if (!is_valid_pathname($input) ||
1846                 !(-d "$projectroot/$input") ||
1847                 !check_export_ok("$projectroot/$input") ||
1848                 ($strict_export && !project_in_list($input))) {
1849                 return undef;
1850         } else {
1851                 return 1;
1852         }
1853 }
1854
1855 sub is_valid_pathname {
1856         my $input = shift;
1857
1858         return undef unless defined $input;
1859         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1860         # at the beginning, at the end, and between slashes.
1861         # also this catches doubled slashes
1862         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1863                 return undef;
1864         }
1865         # no null characters
1866         if ($input =~ m!\0!) {
1867                 return undef;
1868         }
1869         return 1;
1870 }
1871
1872 sub is_valid_ref_format {
1873         my $input = shift;
1874
1875         return undef unless defined $input;
1876         # restrictions on ref name according to git-check-ref-format
1877         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1878                 return undef;
1879         }
1880         return 1;
1881 }
1882
1883 sub is_valid_refname {
1884         my $input = shift;
1885
1886         return undef unless defined $input;
1887         # textual hashes are O.K.
1888         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1889                 return 1;
1890         }
1891         # it must be correct pathname
1892         is_valid_pathname($input) or return undef;
1893         # check git-check-ref-format restrictions
1894         is_valid_ref_format($input) or return undef;
1895         return 1;
1896 }
1897
1898 # decode sequences of octets in utf8 into Perl's internal form,
1899 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1900 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1901 sub to_utf8 {
1902         my $str = shift;
1903         return undef unless defined $str;
1904
1905         if (utf8::is_utf8($str) || utf8::decode($str)) {
1906                 return $str;
1907         } else {
1908                 return $encode_object->decode($str, Encode::FB_DEFAULT);
1909         }
1910 }
1911
1912 # quote unsafe chars, but keep the slash, even when it's not
1913 # correct, but quoted slashes look too horrible in bookmarks
1914 sub esc_param {
1915         my $str = shift;
1916         return undef unless defined $str;
1917         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1918         $str =~ s/ /\+/g;
1919         return $str;
1920 }
1921
1922 # the quoting rules for path_info fragment are slightly different
1923 sub esc_path_info {
1924         my $str = shift;
1925         return undef unless defined $str;
1926
1927         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1928         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1929
1930         return $str;
1931 }
1932
1933 # quote unsafe chars in whole URL, so some characters cannot be quoted
1934 sub esc_url {
1935         my $str = shift;
1936         return undef unless defined $str;
1937         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1938         $str =~ s/ /\+/g;
1939         return $str;
1940 }
1941
1942 # quote unsafe characters in HTML attributes
1943 sub esc_attr {
1944
1945         # for XHTML conformance escaping '"' to '&quot;' is not enough
1946         return esc_html(@_);
1947 }
1948
1949 # replace invalid utf8 character with SUBSTITUTION sequence
1950 sub esc_html {
1951         my $str = shift;
1952         my %opts = @_;
1953
1954         return undef unless defined $str;
1955
1956         $str = to_utf8($str);
1957         $str = $cgi->escapeHTML($str);
1958         if ($opts{'-nbsp'}) {
1959                 $str =~ s/ /&#160;/g;
1960         }
1961         use bytes;
1962         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
1963         return $str;
1964 }
1965
1966 # quote control characters and escape filename to HTML
1967 sub esc_path {
1968         my $str = shift;
1969         my %opts = @_;
1970
1971         return undef unless defined $str;
1972
1973         $str = to_utf8($str);
1974         $str = $cgi->escapeHTML($str);
1975         if ($opts{'-nbsp'}) {
1976                 $str =~ s/ /&#160;/g;
1977         }
1978         use bytes;
1979         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
1980         return $str;
1981 }
1982
1983 # Sanitize for use in XHTML + application/xml+xhtm (valid XML 1.0)
1984 sub sanitize {
1985         my $str = shift;
1986
1987         return undef unless defined $str;
1988
1989         $str = to_utf8($str);
1990         use bytes;
1991         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
1992         return $str;
1993 }
1994
1995 # Make control characters "printable", using character escape codes (CEC)
1996 sub quot_cec {
1997         my $cntrl = shift;
1998         my %opts = @_;
1999         my %es = ( # character escape codes, aka escape sequences
2000                 "\t" => '\t',   # tab            (HT)
2001                 "\n" => '\n',   # line feed      (LF)
2002                 "\r" => '\r',   # carrige return (CR)
2003                 "\f" => '\f',   # form feed      (FF)
2004                 "\b" => '\b',   # backspace      (BS)
2005                 "\a" => '\a',   # alarm (bell)   (BEL)
2006                 "\e" => '\e',   # escape         (ESC)
2007                 "\013" => '\v', # vertical tab   (VT)
2008                 "\000" => '\0', # nul character  (NUL)
2009         );
2010         my $chr = ( (exists $es{$cntrl})
2011                     ? $es{$cntrl}
2012                     : sprintf('\x%02x', ord($cntrl)) );
2013         if ($opts{-nohtml}) {
2014                 return $chr;
2015         } else {
2016                 return "<span class=\"cntrl\">$chr</span>";
2017         }
2018 }
2019
2020 # Alternatively use unicode control pictures codepoints,
2021 # Unicode "printable representation" (PR)
2022 sub quot_upr {
2023         my $cntrl = shift;
2024         my %opts = @_;
2025
2026         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2027         if ($opts{-nohtml}) {
2028                 return $chr;
2029         } else {
2030                 return "<span class=\"cntrl\">$chr</span>";
2031         }
2032 }
2033
2034 # git may return quoted and escaped filenames
2035 sub unquote {
2036         my $str = shift;
2037
2038         sub unq {
2039                 my $seq = shift;
2040                 my %es = ( # character escape codes, aka escape sequences
2041                         't' => "\t",   # tab            (HT, TAB)
2042                         'n' => "\n",   # newline        (NL)
2043                         'r' => "\r",   # return         (CR)
2044                         'f' => "\f",   # form feed      (FF)
2045                         'b' => "\b",   # backspace      (BS)
2046                         'a' => "\a",   # alarm (bell)   (BEL)
2047                         'e' => "\e",   # escape         (ESC)
2048                         'v' => "\013", # vertical tab   (VT)
2049                 );
2050
2051                 if ($seq =~ m/^[0-7]{1,3}$/) {
2052                         # octal char sequence
2053                         return chr(oct($seq));
2054                 } elsif (exists $es{$seq}) {
2055                         # C escape sequence, aka character escape code
2056                         return $es{$seq};
2057                 }
2058                 # quoted ordinary character
2059                 return $seq;
2060         }
2061
2062         if ($str =~ m/^"(.*)"$/) {
2063                 # needs unquoting
2064                 $str = $1;
2065                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2066         }
2067         return $str;
2068 }
2069
2070 # escape tabs (convert tabs to spaces)
2071 sub untabify {
2072         my $line = shift;
2073
2074         while ((my $pos = index($line, "\t")) != -1) {
2075                 if (my $count = (8 - ($pos % 8))) {
2076                         my $spaces = ' ' x $count;
2077                         $line =~ s/\t/$spaces/;
2078                 }
2079         }
2080
2081         return $line;
2082 }
2083
2084 sub project_in_list {
2085         my $project = shift;
2086         my @list = git_get_projects_list();
2087         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2088 }
2089
2090 sub cached_page_precondition_check {
2091         my $action = shift;
2092         return 1 unless
2093                 $action eq 'summary' &&
2094                 $projlist_cache_lifetime > 0 &&
2095                 gitweb_check_feature('forks');
2096
2097         # Note that ALL the 'forkchange' logic is in this function.
2098         # It does NOT belong in cached_action_page NOR in cached_action_start
2099         # NOR in cached_action_finish.  None of those functions should know anything
2100         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2101
2102         # besides the basic 'changed' "$action.changed" check, we may only use
2103         # a summary cache if:
2104         #
2105         #   1) we are not using a project list cache file
2106         #   -OR-
2107         #   2) we are not using the 'forks' feature
2108         #   -OR-
2109         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2110         #   -OR-
2111         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2112         #   -OR-
2113         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2114         #
2115         # Otherwise we must re-generate the cache because we've had a fork change
2116         # (either a fork was added or a fork was removed) AND the change has been
2117         # picked up in the cache file AND we've not got that in our cached copy
2118         #
2119         # For (5) regenerating the cached page wouldn't get us anything if the project
2120         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2121         # forks information comes from the project cache file and it's clearly not
2122         # picked up the changes yet so we may continue to use a cached page until it does.
2123
2124         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2125         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2126         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2127         return 1 unless defined($fc_mt) || defined($afc_mt);
2128         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2129         return 1 unless $prj_mt;
2130         my $old_mt = $fc_mt;
2131         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2132         return 1 if $old_mt > $prj_mt;
2133
2134         # We're going to regenerate the cached page because we know the project cache
2135         # has new fork information that we cannot possibly have in our cached copy.
2136         #
2137         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2138         # them is older than the project cache and one of them is newer, we still
2139         # need to regenerate the page cache, but we will also need to do it again
2140         # in the future because there's yet another fork update not yet in the cache.
2141         #
2142         # So we make sure to touch "$action.changed" to force a cache regeneration
2143         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2144         # they're older than the project cache (they've served their purpose, we're
2145         # forcing a page regeneration by touching "$action.changed" but the project
2146         # cache was rebuilt since then so there are no more pending fork updates to
2147         # pick up in the future and they need to go).
2148
2149         # For best results, the external code that touches 'forkchange' should always
2150         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2151         # if it does not already exist.  That way the cached page will be regenerated
2152         # each time it's requested and ANY fork updates are available in the proj
2153         # cache rather than waiting until they all are before updating.
2154
2155         # Note that we take a shortcut here and will zap 'forkchange' since we know
2156         # that it only affects the 'summary' cache.  If, in the future, it affects
2157         # other cache types, it will first need to be propogated down to
2158         # "$action.forkchange" for those types before we zap it.
2159
2160         my $fd;
2161         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2162         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2163         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2164
2165         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2166         # one and not the other.
2167
2168         if (defined $fc_mt && ! defined $afc_mt) {
2169                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2170                 -e "$htmlcd/$action.forkchange" and
2171                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2172                 unlink "$htmlcd/forkchange";
2173         }
2174
2175         return 0;
2176 }
2177
2178 sub cached_action_page {
2179         my $action = shift;
2180
2181         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2182         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2183         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2184         return undef unless cached_page_precondition_check($action);
2185         open my $fd, '<', "$htmlcd/$action" or return undef;
2186         binmode $fd;
2187         local $/;
2188         my $cached_page = <$fd>;
2189         close $fd or return undef;
2190         return $cached_page;
2191 }
2192
2193 package Git::Gitweb::CacheFile;
2194
2195 sub TIEHANDLE {
2196         use POSIX qw(:fcntl_h);
2197         my $class = shift;
2198         my $cachefile = shift;
2199
2200         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2201                 or return undef;
2202         $$self->{'cachefile'} = $cachefile;
2203         $$self->{'opened'} = 1;
2204         $$self->{'contents'} = '';
2205         return bless $self, $class;
2206 }
2207
2208 sub CLOSE {
2209         my $self = shift;
2210         if ($$self->{'opened'}) {
2211                 $$self->{'opened'} = 0;
2212                 my $result = close $self;
2213                 unlink $$self->{'cachefile'} unless $result;
2214                 return $result;
2215         }
2216         return 0;
2217 }
2218
2219 sub DESTROY {
2220         my $self = shift;
2221         if ($$self->{'opened'}) {
2222                 $self->CLOSE() and unlink $$self->{'cachefile'};
2223         }
2224 }
2225
2226 sub PRINT {
2227         my $self = shift;
2228         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2229         print $self @_ if $$self->{'opened'};
2230         $$self->{'contents'} .= join('', @_);
2231         return 1;
2232 }
2233
2234 sub PRINTF {
2235         my $self = shift;
2236         my $template = shift;
2237         return $self->PRINT(sprintf $template, @_);
2238 }
2239
2240 sub contents {
2241         my $self = shift;
2242         return $$self->{'contents'};
2243 }
2244
2245 package main;
2246
2247 # Caller is responsible for preserving STDOUT beforehand if needed
2248 sub cached_action_start {
2249         my $action = shift;
2250
2251         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2252         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2253         return undef unless -d $htmlcd;
2254         if (-e "$htmlcd/changed") {
2255                 foreach my $cacheable (keys(%html_cache_actions)) {
2256                         next unless $supported_cache_actions{$cacheable} &&
2257                                     $html_cache_actions{$cacheable};
2258                         my $fd;
2259                         open $fd, '>', "$htmlcd/$cacheable.changed"
2260                         and close $fd;
2261                 }
2262                 unlink "$htmlcd/changed";
2263         }
2264         local *CACHEFILE;
2265         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2266         *STDOUT = *CACHEFILE;
2267         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2268         return 1;
2269 }
2270
2271 # Caller is responsible for restoring STDOUT afterward if needed
2272 sub cached_action_finish {
2273         my $action = shift;
2274
2275         use File::Spec;
2276
2277         my $obj = tied *STDOUT;
2278         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2279         my $cached_page = $obj->contents;
2280         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2281         # Do not leave STDOUT file descriptor invalid!
2282         local *NULL;
2283         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2284         *STDOUT = *NULL;
2285         return $cached_page unless $result;
2286         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2287         return $cached_page unless -d $htmlcd;
2288         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2289         return $cached_page;
2290 }
2291
2292 my %expand_pi_subs;
2293 BEGIN {%expand_pi_subs = (
2294         'age_string'              => \&age_string,
2295         'age_string_date'         => \&age_string_date,
2296         'age_string_age'          => \&age_string_age,
2297         'compute_timed_interval'  => \&compute_timed_interval,
2298         'compute_commands_count'  => \&compute_commands_count,
2299         'format_lastrefresh_row'  => \&format_lastrefresh_row,
2300 )}
2301
2302 # Expands any <?gitweb...> processing instructions and returns the result
2303 sub expand_gitweb_pi {
2304         my $page = shift;
2305         $page .= '';
2306         my @time_now = gettimeofday();
2307         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2308                   {defined($1) ?
2309                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2310                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2311                                   '') :
2312                           '' }goes;
2313         return $page;
2314 }
2315
2316 ## ----------------------------------------------------------------------
2317 ## HTML aware string manipulation
2318
2319 # Try to chop given string on a word boundary between position
2320 # $len and $len+$add_len. If there is no word boundary there,
2321 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2322 # (marking chopped part) would be longer than given string.
2323 sub chop_str {
2324         my $str = shift;
2325         my $len = shift;
2326         my $add_len = shift || 10;
2327         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2328
2329         # Make sure perl knows it is utf8 encoded so we don't
2330         # cut in the middle of a utf8 multibyte char.
2331         $str = to_utf8($str);
2332
2333         # allow only $len chars, but don't cut a word if it would fit in $add_len
2334         # if it doesn't fit, cut it if it's still longer than the dots we would add
2335         # remove chopped character entities entirely
2336
2337         # when chopping in the middle, distribute $len into left and right part
2338         # return early if chopping wouldn't make string shorter
2339         if ($where eq 'center') {
2340                 return $str if ($len + 5 >= length($str)); # filler is length 5
2341                 $len = int($len/2);
2342         } else {
2343                 return $str if ($len + 4 >= length($str)); # filler is length 4
2344         }
2345
2346         # regexps: ending and beginning with word part up to $add_len
2347         my $endre = qr/.{$len}\w{0,$add_len}/;
2348         my $begre = qr/\w{0,$add_len}.{$len}/;
2349
2350         if ($where eq 'left') {
2351                 $str =~ m/^(.*?)($begre)$/;
2352                 my ($lead, $body) = ($1, $2);
2353                 if (length($lead) > 4) {
2354                         $lead = " ...";
2355                 }
2356                 return "$lead$body";
2357
2358         } elsif ($where eq 'center') {
2359                 $str =~ m/^($endre)(.*)$/;
2360                 my ($left, $str)  = ($1, $2);
2361                 $str =~ m/^(.*?)($begre)$/;
2362                 my ($mid, $right) = ($1, $2);
2363                 if (length($mid) > 5) {
2364                         $mid = " ... ";
2365                 }
2366                 return "$left$mid$right";
2367
2368         } else {
2369                 $str =~ m/^($endre)(.*)$/;
2370                 my $body = $1;
2371                 my $tail = $2;
2372                 if (length($tail) > 4) {
2373                         $tail = "... ";
2374                 }
2375                 return "$body$tail";
2376         }
2377 }
2378
2379 # pass-through email filter, obfuscating it when possible
2380 sub email_obfuscate {
2381         our $email;
2382         my ($str) = @_;
2383         if ($email) {
2384                 $str = $email->escape_html($str);
2385                 # Stock HTML::Email::Obfuscate version likes to produce
2386                 # invalid XHTML...
2387                 $str =~ s#<(/?)B>#<$1b>#g;
2388                 return $str;
2389         } else {
2390                 $str = esc_html($str);
2391                 $str =~ s/@/&#x40;/;
2392                 return $str;
2393         }
2394 }
2395
2396 # takes the same arguments as chop_str, but also wraps a <span> around the
2397 # result with a title attribute if it does get chopped. Additionally, the
2398 # string is HTML-escaped.
2399 sub chop_and_escape_str {
2400         my ($str) = @_;
2401
2402         my $chopped = chop_str(@_);
2403         $str = to_utf8($str);
2404         if ($chopped eq $str) {
2405                 return email_obfuscate($chopped);
2406         } else {
2407                 use bytes;
2408                 $str =~ s/[[:cntrl:]]/?/g;
2409                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2410         }
2411 }
2412
2413 # Highlight selected fragments of string, using given CSS class,
2414 # and escape HTML.  It is assumed that fragments do not overlap.
2415 # Regions are passed as list of pairs (array references).
2416 #
2417 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2418 # '<span class="mark">foo</span>bar'
2419 sub esc_html_hl_regions {
2420         my ($str, $css_class, @sel) = @_;
2421         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2422         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2423         return esc_html($str, %opts) unless @sel;
2424
2425         my $out = '';
2426         my $pos = 0;
2427
2428         for my $s (@sel) {
2429                 my ($begin, $end) = @$s;
2430
2431                 # Don't create empty <span> elements.
2432                 next if $end <= $begin;
2433
2434                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2435                                        %opts);
2436
2437                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2438                         if ($begin - $pos > 0);
2439                 $out .= $cgi->span({-class => $css_class}, $escaped);
2440
2441                 $pos = $end;
2442         }
2443         $out .= esc_html(substr($str, $pos), %opts)
2444                 if ($pos < length($str));
2445
2446         return $out;
2447 }
2448
2449 # return positions of beginning and end of each match
2450 sub matchpos_list {
2451         my ($str, $regexp) = @_;
2452         return unless (defined $str && defined $regexp);
2453
2454         my @matches;
2455         while ($str =~ /$regexp/g) {
2456                 push @matches, [$-[0], $+[0]];
2457         }
2458         return @matches;
2459 }
2460
2461 # highlight match (if any), and escape HTML
2462 sub esc_html_match_hl {
2463         my ($str, $regexp) = @_;
2464         return esc_html($str) unless defined $regexp;
2465
2466         my @matches = matchpos_list($str, $regexp);
2467         return esc_html($str) unless @matches;
2468
2469         return esc_html_hl_regions($str, 'match', @matches);
2470 }
2471
2472
2473 # highlight match (if any) of shortened string, and escape HTML
2474 sub esc_html_match_hl_chopped {
2475         my ($str, $chopped, $regexp) = @_;
2476         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2477
2478         my @matches = matchpos_list($str, $regexp);
2479         return esc_html($chopped) unless @matches;
2480
2481         # filter matches so that we mark chopped string
2482         my $tail = "... "; # see chop_str
2483         unless ($chopped =~ s/\Q$tail\E$//) {
2484                 $tail = '';
2485         }
2486         my $chop_len = length($chopped);
2487         my $tail_len = length($tail);
2488         my @filtered;
2489
2490         for my $m (@matches) {
2491                 if ($m->[0] > $chop_len) {
2492                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2493                         last;
2494                 } elsif ($m->[1] > $chop_len) {
2495                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2496                         last;
2497                 }
2498                 push @filtered, $m;
2499         }
2500
2501         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2502 }
2503
2504 ## ----------------------------------------------------------------------
2505 ## functions returning short strings
2506
2507 # CSS class for given age epoch value (in seconds)
2508 # and reference time (optional, defaults to now) as second value
2509 sub age_class {
2510         my ($age_epoch, $time_now) = @_;
2511         return "noage" unless defined $age_epoch;
2512         defined $time_now or $time_now = time;
2513         my $age = $time_now - $age_epoch;
2514
2515         if ($age < 60*60*2) {
2516                 return "age0";
2517         } elsif ($age < 60*60*24*2) {
2518                 return "age1";
2519         } else {
2520                 return "age2";
2521         }
2522 }
2523
2524 # convert age epoch in seconds to "nn units ago" string
2525 # reference time used is now unless second argument passed in
2526 # to get the old behavior, pass 0 as the first argument and
2527 # the time in seconds as the second
2528 sub age_string {
2529         my ($age_epoch, $time_now) = @_;
2530         return "unknown" unless defined $age_epoch;
2531         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2532         defined $time_now or $time_now = time;
2533         my $age = $time_now - $age_epoch;
2534         my $age_str;
2535
2536         if ($age > 60*60*24*365*2) {
2537                 $age_str = (int $age/60/60/24/365);
2538                 $age_str .= " years ago";
2539         } elsif ($age > 60*60*24*(365/12)*2) {
2540                 $age_str = int $age/60/60/24/(365/12);
2541                 $age_str .= " months ago";
2542         } elsif ($age > 60*60*24*7*2) {
2543                 $age_str = int $age/60/60/24/7;
2544                 $age_str .= " weeks ago";
2545         } elsif ($age > 60*60*24*2) {
2546                 $age_str = int $age/60/60/24;
2547                 $age_str .= " days ago";
2548         } elsif ($age > 60*60*2) {
2549                 $age_str = int $age/60/60;
2550                 $age_str .= " hours ago";
2551         } elsif ($age > 60*2) {
2552                 $age_str = int $age/60;
2553                 $age_str .= " min ago";
2554         } elsif ($age > 2) {
2555                 $age_str = int $age;
2556                 $age_str .= " sec ago";
2557         } else {
2558                 $age_str .= " right now";
2559         }
2560         return $age_str;
2561 }
2562
2563 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2564 # this is typically shown to the user directly with the age_string_age as a title
2565 sub age_string_date {
2566         my ($age_epoch, $time_now) = @_;
2567         return "unknown" unless defined $age_epoch;
2568         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2569         defined $time_now or $time_now = time;
2570         my $age = $time_now - $age_epoch;
2571
2572         if ($age > 60*60*24*7*2) {
2573                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2574                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2575         } else {
2576                 return age_string($age_epoch, $time_now);
2577         }
2578 }
2579
2580 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2581 # this is typically used for the 'title' attribute so it will show as a tooltip
2582 sub age_string_age {
2583         my ($age_epoch, $time_now) = @_;
2584         return "unknown" unless defined $age_epoch;
2585         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2586         defined $time_now or $time_now = time;
2587         my $age = $time_now - $age_epoch;
2588
2589         if ($age > 60*60*24*7*2) {
2590                 return age_string($age_epoch, $time_now);
2591         } else {
2592                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2593                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2594         }
2595 }
2596
2597 use constant {
2598         S_IFINVALID => 0030000,
2599         S_IFGITLINK => 0160000,
2600 };
2601
2602 # submodule/subproject, a commit object reference
2603 sub S_ISGITLINK {
2604         my $mode = shift;
2605
2606         return (($mode & S_IFMT) == S_IFGITLINK)
2607 }
2608
2609 # convert file mode in octal to symbolic file mode string
2610 sub mode_str {
2611         my $mode = oct shift;
2612
2613         if (S_ISGITLINK($mode)) {
2614                 return 'm---------';
2615         } elsif (S_ISDIR($mode & S_IFMT)) {
2616                 return 'drwxr-xr-x';
2617         } elsif (S_ISLNK($mode)) {
2618                 return 'lrwxrwxrwx';
2619         } elsif (S_ISREG($mode)) {
2620                 # git cares only about the executable bit
2621                 if ($mode & S_IXUSR) {
2622                         return '-rwxr-xr-x';
2623                 } else {
2624                         return '-rw-r--r--';
2625                 };
2626         } else {
2627                 return '----------';
2628         }
2629 }
2630
2631 # convert file mode in octal to file type string
2632 sub file_type {
2633         my $mode = shift;
2634
2635         if ($mode !~ m/^[0-7]+$/) {
2636                 return $mode;
2637         } else {
2638                 $mode = oct $mode;
2639         }
2640
2641         if (S_ISGITLINK($mode)) {
2642                 return "submodule";
2643         } elsif (S_ISDIR($mode & S_IFMT)) {
2644                 return "directory";
2645         } elsif (S_ISLNK($mode)) {
2646                 return "symlink";
2647         } elsif (S_ISREG($mode)) {
2648                 return "file";
2649         } else {
2650                 return "unknown";
2651         }
2652 }
2653
2654 # convert file mode in octal to file type description string
2655 sub file_type_long {
2656         my $mode = shift;
2657
2658         if ($mode !~ m/^[0-7]+$/) {
2659                 return $mode;
2660         } else {
2661                 $mode = oct $mode;
2662         }
2663
2664         if (S_ISGITLINK($mode)) {
2665                 return "submodule";
2666         } elsif (S_ISDIR($mode & S_IFMT)) {
2667                 return "directory";
2668         } elsif (S_ISLNK($mode)) {
2669                 return "symlink";
2670         } elsif (S_ISREG($mode)) {
2671                 if ($mode & S_IXUSR) {
2672                         return "executable";
2673                 } else {
2674                         return "file";
2675                 };
2676         } else {
2677                 return "unknown";
2678         }
2679 }
2680
2681
2682 ## ----------------------------------------------------------------------
2683 ## functions returning short HTML fragments, or transforming HTML fragments
2684 ## which don't belong to other sections
2685
2686 # format line of commit message.
2687 sub format_log_line_html {
2688         my $line = shift;
2689
2690         $line = esc_html($line, -nbsp=>1);
2691         $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
2692                 $cgi->a({-href => href(action=>"object", hash=>$1),
2693                                         -class => "text"}, $1);
2694         }eg unless $line =~ /^\s*git-svn-id:/;
2695
2696         return $line;
2697 }
2698
2699 # format marker of refs pointing to given object
2700
2701 # the destination action is chosen based on object type and current context:
2702 # - for annotated tags, we choose the tag view unless it's the current view
2703 #   already, in which case we go to shortlog view
2704 # - for other refs, we keep the current view if we're in history, shortlog or
2705 #   log view, and select shortlog otherwise
2706 sub format_ref_marker {
2707         my ($refs, $id) = @_;
2708         my $markers = '';
2709
2710         if (defined $refs->{$id}) {
2711                 foreach my $ref (@{$refs->{$id}}) {
2712                         # this code exploits the fact that non-lightweight tags are the
2713                         # only indirect objects, and that they are the only objects for which
2714                         # we want to use tag instead of shortlog as action
2715                         my ($type, $name) = qw();
2716                         my $indirect = ($ref =~ s/\^\{\}$//);
2717                         # e.g. tags/v2.6.11 or heads/next
2718                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2719                                 $type = $1;
2720                                 $name = $2;
2721                         } else {
2722                                 $type = "ref";
2723                                 $name = $ref;
2724                         }
2725
2726                         my $class = $type;
2727                         $class .= " indirect" if $indirect;
2728
2729                         my $dest_action = "shortlog";
2730
2731                         if ($indirect) {
2732                                 $dest_action = "tag" unless $action eq "tag";
2733                         } elsif ($action =~ /^(history|(short)?log)$/) {
2734                                 $dest_action = $action;
2735                         }
2736
2737                         my $dest = "";
2738                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2739                         $dest .= $ref;
2740
2741                         my $link = $cgi->a({
2742                                 -href => href(
2743                                         action=>$dest_action,
2744                                         hash=>$dest
2745                                 )}, $name);
2746
2747                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2748                                 $link . "</span>";
2749                 }
2750         }
2751
2752         if ($markers) {
2753                 return '<span class="refs">'. $markers . '</span>';
2754         } else {
2755                 return "";
2756         }
2757 }
2758
2759 # format, perhaps shortened and with markers, title line
2760 sub format_subject_html {
2761         my ($long, $short, $href, $extra) = @_;
2762         $extra = '' unless defined($extra);
2763
2764         if (length($short) < length($long)) {
2765                 use bytes;
2766                 $long =~ s/[[:cntrl:]]/?/g;
2767                 return $cgi->a({-href => $href, -class => "list subject",
2768                                 -title => to_utf8($long)},
2769                        esc_html($short)) . $extra;
2770         } else {
2771                 return $cgi->a({-href => $href, -class => "list subject"},
2772                        esc_html($long)) . $extra;
2773         }
2774 }
2775
2776 # Rather than recomputing the url for an email multiple times, we cache it
2777 # after the first hit. This gives a visible benefit in views where the avatar
2778 # for the same email is used repeatedly (e.g. shortlog).
2779 # The cache is shared by all avatar engines (currently gravatar only), which
2780 # are free to use it as preferred. Since only one avatar engine is used for any
2781 # given page, there's no risk for cache conflicts.
2782 our %avatar_cache = ();
2783
2784 # Compute the picon url for a given email, by using the picon search service over at
2785 # http://www.cs.indiana.edu/picons/search.html
2786 sub picon_url {
2787         my $email = lc shift;
2788         if (!$avatar_cache{$email}) {
2789                 my ($user, $domain) = split('@', $email);
2790                 $avatar_cache{$email} =
2791                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2792                         "$domain/$user/" .
2793                         "users+domains+unknown/up/single";
2794         }
2795         return $avatar_cache{$email};
2796 }
2797
2798 # Compute the gravatar url for a given email, if it's not in the cache already.
2799 # Gravatar stores only the part of the URL before the size, since that's the
2800 # one computationally more expensive. This also allows reuse of the cache for
2801 # different sizes (for this particular engine).
2802 sub gravatar_url {
2803         my $email = lc shift;
2804         my $size = shift;
2805         $avatar_cache{$email} ||=
2806                 "//www.gravatar.com/avatar/" .
2807                         Digest::MD5::md5_hex($email) . "?s=";
2808         return $avatar_cache{$email} . $size;
2809 }
2810
2811 # Insert an avatar for the given $email at the given $size if the feature
2812 # is enabled.
2813 sub git_get_avatar {
2814         my ($email, %opts) = @_;
2815         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2816         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2817         $opts{-size} ||= 'default';
2818         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2819         my $url = "";
2820         if ($git_avatar eq 'gravatar') {
2821                 $url = gravatar_url($email, $size);
2822         } elsif ($git_avatar eq 'picon') {
2823                 $url = picon_url($email);
2824         }
2825         # Other providers can be added by extending the if chain, defining $url
2826         # as needed. If no variant puts something in $url, we assume avatars
2827         # are completely disabled/unavailable.
2828         if ($url) {
2829                 return $pre_white .
2830                        "<img width=\"$size\" " .
2831                             "class=\"avatar\" " .
2832                             "src=\"".esc_url($url)."\" " .
2833                             "alt=\"\" " .
2834                        "/>" . $post_white;
2835         } else {
2836                 return "";
2837         }
2838 }
2839
2840 sub format_search_author {
2841         my ($author, $searchtype, $displaytext) = @_;
2842         my $have_search = gitweb_check_feature('search');
2843
2844         if ($have_search) {
2845                 my $performed = "";
2846                 if ($searchtype eq 'author') {
2847                         $performed = "authored";
2848                 } elsif ($searchtype eq 'committer') {
2849                         $performed = "committed";
2850                 }
2851
2852                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2853                                 searchtext=>$author,
2854                                 searchtype=>$searchtype), class=>"list",
2855                                 title=>"Search for commits $performed by $author"},
2856                                 $displaytext);
2857
2858         } else {
2859                 return $displaytext;
2860         }
2861 }
2862
2863 # format the author name of the given commit with the given tag
2864 # the author name is chopped and escaped according to the other
2865 # optional parameters (see chop_str).
2866 sub format_author_html {
2867         my $tag = shift;
2868         my $co = shift;
2869         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2870         return "<$tag class=\"author\">" .
2871                format_search_author($co->{'author_name'}, "author",
2872                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2873                        $author) .
2874                "</$tag>";
2875 }
2876
2877 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2878 sub format_git_diff_header_line {
2879         my $line = shift;
2880         my $diffinfo = shift;
2881         my ($from, $to) = @_;
2882
2883         if ($diffinfo->{'nparents'}) {
2884                 # combined diff
2885                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2886                 if ($to->{'href'}) {
2887                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2888                                          esc_path($to->{'file'}));
2889                 } else { # file was deleted (no href)
2890                         $line .= esc_path($to->{'file'});
2891                 }
2892         } else {
2893                 # "ordinary" diff
2894                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2895                 if ($from->{'href'}) {
2896                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2897                                          'a/' . esc_path($from->{'file'}));
2898                 } else { # file was added (no href)
2899                         $line .= 'a/' . esc_path($from->{'file'});
2900                 }
2901                 $line .= ' ';
2902                 if ($to->{'href'}) {
2903                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2904                                          'b/' . esc_path($to->{'file'}));
2905                 } else { # file was deleted
2906                         $line .= 'b/' . esc_path($to->{'file'});
2907                 }
2908         }
2909
2910         return "<div class=\"diff header\">$line</div>\n";
2911 }
2912
2913 # format extended diff header line, before patch itself
2914 sub format_extended_diff_header_line {
2915         my $line = shift;
2916         my $diffinfo = shift;
2917         my ($from, $to) = @_;
2918
2919         # match <path>
2920         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2921                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2922                                        esc_path($from->{'file'}));
2923         }
2924         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2925                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2926                                  esc_path($to->{'file'}));
2927         }
2928         # match single <mode>
2929         if ($line =~ m/\s(\d{6})$/) {
2930                 $line .= '<span class="info"> (' .
2931                          file_type_long($1) .
2932                          ')</span>';
2933         }
2934         # match <hash>
2935         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2936                 # can match only for combined diff
2937                 $line = 'index ';
2938                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2939                         if ($from->{'href'}[$i]) {
2940                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
2941                                                   -class=>"hash"},
2942                                                  substr($diffinfo->{'from_id'}[$i],0,7));
2943                         } else {
2944                                 $line .= '0' x 7;
2945                         }
2946                         # separator
2947                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
2948                 }
2949                 $line .= '..';
2950                 if ($to->{'href'}) {
2951                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2952                                          substr($diffinfo->{'to_id'},0,7));
2953                 } else {
2954                         $line .= '0' x 7;
2955                 }
2956
2957         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
2958                 # can match only for ordinary diff
2959                 my ($from_link, $to_link);
2960                 if ($from->{'href'}) {
2961                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
2962                                              substr($diffinfo->{'from_id'},0,7));
2963                 } else {
2964                         $from_link = '0' x 7;
2965                 }
2966                 if ($to->{'href'}) {
2967                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2968                                            substr($diffinfo->{'to_id'},0,7));
2969                 } else {
2970                         $to_link = '0' x 7;
2971                 }
2972                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
2973                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
2974         }
2975
2976         return $line . "<br/>\n";
2977 }
2978
2979 # format from-file/to-file diff header
2980 sub format_diff_from_to_header {
2981         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
2982         my $line;
2983         my $result = '';
2984
2985         $line = $from_line;
2986         #assert($line =~ m/^---/) if DEBUG;
2987         # no extra formatting for "^--- /dev/null"
2988         if (! $diffinfo->{'nparents'}) {
2989                 # ordinary (single parent) diff
2990                 if ($line =~ m!^--- "?a/!) {
2991                         if ($from->{'href'}) {
2992                                 $line = '--- a/' .
2993                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2994                                                 esc_path($from->{'file'}));
2995                         } else {
2996                                 $line = '--- a/' .
2997                                         esc_path($from->{'file'});
2998                         }
2999                 }
3000                 $result .= qq!<div class="diff from_file">$line</div>\n!;
3001
3002         } else {
3003                 # combined diff (merge commit)
3004                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3005                         if ($from->{'href'}[$i]) {
3006                                 $line = '--- ' .
3007                                         $cgi->a({-href=>href(action=>"blobdiff",
3008                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3009                                                              hash_parent_base=>$parents[$i],
3010                                                              file_parent=>$from->{'file'}[$i],
3011                                                              hash=>$diffinfo->{'to_id'},
3012                                                              hash_base=>$hash,
3013                                                              file_name=>$to->{'file'}),
3014                                                  -class=>"path",
3015                                                  -title=>"diff" . ($i+1)},
3016                                                 $i+1) .
3017                                         '/' .
3018                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3019                                                 esc_path($from->{'file'}[$i]));
3020                         } else {
3021                                 $line = '--- /dev/null';
3022                         }
3023                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3024                 }
3025         }
3026
3027         $line = $to_line;
3028         #assert($line =~ m/^\+\+\+/) if DEBUG;
3029         # no extra formatting for "^+++ /dev/null"
3030         if ($line =~ m!^\+\+\+ "?b/!) {
3031                 if ($to->{'href'}) {
3032                         $line = '+++ b/' .
3033                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3034                                         esc_path($to->{'file'}));
3035                 } else {
3036                         $line = '+++ b/' .
3037                                 esc_path($to->{'file'});
3038                 }
3039         }
3040         $result .= qq!<div class="diff to_file">$line</div>\n!;
3041
3042         return $result;
3043 }
3044
3045 # create note for patch simplified by combined diff
3046 sub format_diff_cc_simplified {
3047         my ($diffinfo, @parents) = @_;
3048         my $result = '';
3049
3050         $result .= "<div class=\"diff header\">" .
3051                    "diff --cc ";
3052         if (!is_deleted($diffinfo)) {
3053                 $result .= $cgi->a({-href => href(action=>"blob",
3054                                                   hash_base=>$hash,
3055                                                   hash=>$diffinfo->{'to_id'},
3056                                                   file_name=>$diffinfo->{'to_file'}),
3057                                     -class => "path"},
3058                                    esc_path($diffinfo->{'to_file'}));
3059         } else {
3060                 $result .= esc_path($diffinfo->{'to_file'});
3061         }
3062         $result .= "</div>\n" . # class="diff header"
3063                    "<div class=\"diff nodifferences\">" .
3064                    "Simple merge" .
3065                    "</div>\n"; # class="diff nodifferences"
3066
3067         return $result;
3068 }
3069
3070 sub diff_line_class {
3071         my ($line, $from, $to) = @_;
3072
3073         # ordinary diff
3074         my $num_sign = 1;
3075         # combined diff
3076         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3077                 $num_sign = scalar @{$from->{'href'}};
3078         }
3079
3080         my @diff_line_classifier = (
3081                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3082                 { regexp => qr/^\\/,               class => "incomplete"  },
3083                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3084                 # classifier for context must come before classifier add/rem,
3085                 # or we would have to use more complicated regexp, for example
3086                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3087                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3088                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3089         );
3090         for my $clsfy (@diff_line_classifier) {
3091                 return $clsfy->{'class'}
3092                         if ($line =~ $clsfy->{'regexp'});
3093         }
3094
3095         # fallback
3096         return "";
3097 }
3098
3099 # assumes that $from and $to are defined and correctly filled,
3100 # and that $line holds a line of chunk header for unified diff
3101 sub format_unidiff_chunk_header {
3102         my ($line, $from, $to) = @_;
3103
3104         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3105                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3106
3107         $from_lines = 0 unless defined $from_lines;
3108         $to_lines   = 0 unless defined $to_lines;
3109
3110         if ($from->{'href'}) {
3111                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3112                                      -class=>"list"}, $from_text);
3113         }
3114         if ($to->{'href'}) {
3115                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3116                                      -class=>"list"}, $to_text);
3117         }
3118         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3119                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3120         return $line;
3121 }
3122
3123 # assumes that $from and $to are defined and correctly filled,
3124 # and that $line holds a line of chunk header for combined diff
3125 sub format_cc_diff_chunk_header {
3126         my ($line, $from, $to) = @_;
3127
3128         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3129         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3130
3131         @from_text = split(' ', $ranges);
3132         for (my $i = 0; $i < @from_text; ++$i) {
3133                 ($from_start[$i], $from_nlines[$i]) =
3134                         (split(',', substr($from_text[$i], 1)), 0);
3135         }
3136
3137         $to_text   = pop @from_text;
3138         $to_start  = pop @from_start;
3139         $to_nlines = pop @from_nlines;
3140
3141         $line = "<span class=\"chunk_info\">$prefix ";
3142         for (my $i = 0; $i < @from_text; ++$i) {
3143                 if ($from->{'href'}[$i]) {
3144                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3145                                           -class=>"list"}, $from_text[$i]);
3146                 } else {
3147                         $line .= $from_text[$i];
3148                 }
3149                 $line .= " ";
3150         }
3151         if ($to->{'href'}) {
3152                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3153                                   -class=>"list"}, $to_text);
3154         } else {
3155                 $line .= $to_text;
3156         }
3157         $line .= " $prefix</span>" .
3158                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3159         return $line;
3160 }
3161
3162 # process patch (diff) line (not to be used for diff headers),
3163 # returning HTML-formatted (but not wrapped) line.
3164 # If the line is passed as a reference, it is treated as HTML and not
3165 # esc_html()'ed.
3166 sub format_diff_line {
3167         my ($line, $diff_class, $from, $to) = @_;
3168
3169         if (ref($line)) {
3170                 $line = $$line;
3171         } else {
3172                 chomp $line;
3173                 $line = untabify($line);
3174
3175                 if ($from && $to && $line =~ m/^\@{2} /) {
3176                         $line = format_unidiff_chunk_header($line, $from, $to);
3177                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3178                         $line = format_cc_diff_chunk_header($line, $from, $to);
3179                 } else {
3180                         $line = esc_html($line, -nbsp=>1);
3181                 }
3182         }
3183
3184         my $diff_classes = "diff diff_body";
3185         $diff_classes .= " $diff_class" if ($diff_class);
3186         $line = "<div class=\"$diff_classes\">$line</div>\n";
3187
3188         return $line;
3189 }
3190
3191 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3192 # linked.  Pass the hash of the tree/commit to snapshot.
3193 sub format_snapshot_links {
3194         my ($hash) = @_;
3195         my $num_fmts = @snapshot_fmts;
3196         if ($num_fmts > 1) {
3197                 # A parenthesized list of links bearing format names.
3198                 # e.g. "snapshot (_tar.gz_ _zip_)"
3199                 return "snapshot (" . join(' ', map
3200                         $cgi->a({
3201                                 -href => href(
3202                                         action=>"snapshot",
3203                                         hash=>$hash,
3204                                         snapshot_format=>$_
3205                                 )
3206                         }, $known_snapshot_formats{$_}{'display'})
3207                 , @snapshot_fmts) . ")";
3208         } elsif ($num_fmts == 1) {
3209                 # A single "snapshot" link whose tooltip bears the format name.
3210                 # i.e. "_snapshot_"
3211                 my ($fmt) = @snapshot_fmts;
3212                 return
3213                         $cgi->a({
3214                                 -href => href(
3215                                         action=>"snapshot",
3216                                         hash=>$hash,
3217                                         snapshot_format=>$fmt
3218                                 ),
3219                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3220                         }, "snapshot");
3221         } else { # $num_fmts == 0
3222                 return undef;
3223         }
3224 }
3225
3226 ## ......................................................................
3227 ## functions returning values to be passed, perhaps after some
3228 ## transformation, to other functions; e.g. returning arguments to href()
3229
3230 # returns hash to be passed to href to generate gitweb URL
3231 # in -title key it returns description of link
3232 sub get_feed_info {
3233         my $format = shift || 'Atom';
3234         my %res = (action => lc($format));
3235         my $matched_ref = 0;
3236
3237         # feed links are possible only for project views
3238         return unless (defined $project);
3239         # some views should link to OPML, or to generic project feed,
3240         # or don't have specific feed yet (so they should use generic)
3241         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3242
3243         my $branch = undef;
3244         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3245         # (fullname) to differentiate from tag links; this also makes
3246         # possible to detect branch links
3247         for my $ref (get_branch_refs()) {
3248                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3249                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3250                         $branch = $1;
3251                         $matched_ref = $ref;
3252                         last;
3253                 }
3254         }
3255         # find log type for feed description (title)
3256         my $type = 'log';
3257         if (defined $file_name) {
3258                 $type  = "history of $file_name";
3259                 $type .= "/" if ($action eq 'tree');
3260                 $type .= " on '$branch'" if (defined $branch);
3261         } else {
3262                 $type = "log of $branch" if (defined $branch);
3263         }
3264
3265         $res{-title} = $type;
3266         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3267         $res{'file_name'} = $file_name;
3268
3269         return %res;
3270 }
3271
3272 ## ----------------------------------------------------------------------
3273 ## git utility subroutines, invoking git commands
3274
3275 # returns path to the core git executable and the --git-dir parameter as list
3276 sub git_cmd {
3277         $number_of_git_cmds++;
3278         return $GIT, '--git-dir='.$git_dir;
3279 }
3280
3281 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3282 sub cmd_pipe {
3283
3284         # In order to be compatible with FCGI mode we must use POSIX
3285         # and access the STDERR_FILENO file descriptor directly
3286
3287         use POSIX qw(STDERR_FILENO dup dup2);
3288
3289         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3290         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3291         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3292         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3293         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3294         my $result = open(my $fd, "-|", @_);
3295         $dup2ok = dup2($saveerr, STDERR_FILENO);
3296         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3297         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3298
3299         return $result ? $fd : undef;
3300 }
3301
3302 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3303 sub git_cmd_pipe {
3304         return cmd_pipe git_cmd(), @_;
3305 }
3306
3307 # quote the given arguments for passing them to the shell
3308 # quote_command("command", "arg 1", "arg with ' and ! characters")
3309 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3310 # Try to avoid using this function wherever possible.
3311 sub quote_command {
3312         return join(' ',
3313                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3314 }
3315
3316 # get HEAD ref of given project as hash
3317 sub git_get_head_hash {
3318         return git_get_full_hash(shift, 'HEAD');
3319 }
3320
3321 sub git_get_full_hash {
3322         return git_get_hash(@_);
3323 }
3324
3325 sub git_get_short_hash {
3326         return git_get_hash(@_, '--short=7');
3327 }
3328
3329 sub git_get_hash {
3330         my ($project, $hash, @options) = @_;
3331         my $o_git_dir = $git_dir;
3332         my $retval = undef;
3333         $git_dir = "$projectroot/$project";
3334         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3335             '--verify', '-q', @options, $hash)) {
3336                 $retval = <$fd>;
3337                 chomp $retval if defined $retval;
3338                 close $fd;
3339         }
3340         if (defined $o_git_dir) {
3341                 $git_dir = $o_git_dir;
3342         }
3343         return $retval;
3344 }
3345
3346 # get type of given object
3347 sub git_get_type {
3348         my $hash = shift;
3349
3350         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3351         my $type = <$fd>;
3352         close $fd or return;
3353         chomp $type;
3354         return $type;
3355 }
3356
3357 # repository configuration
3358 our $config_file = '';
3359 our %config;
3360
3361 # store multiple values for single key as anonymous array reference
3362 # single values stored directly in the hash, not as [ <value> ]
3363 sub hash_set_multi {
3364         my ($hash, $key, $value) = @_;
3365
3366         if (!exists $hash->{$key}) {
3367                 $hash->{$key} = $value;
3368         } elsif (!ref $hash->{$key}) {
3369                 $hash->{$key} = [ $hash->{$key}, $value ];
3370         } else {
3371                 push @{$hash->{$key}}, $value;
3372         }
3373 }
3374
3375 # return hash of git project configuration
3376 # optionally limited to some section, e.g. 'gitweb'
3377 sub git_parse_project_config {
3378         my $section_regexp = shift;
3379         my %config;
3380
3381         local $/ = "\0";
3382
3383         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3384                 or return;
3385
3386         while (my $keyval = to_utf8(scalar <$fh>)) {
3387                 chomp $keyval;
3388                 my ($key, $value) = split(/\n/, $keyval, 2);
3389
3390                 hash_set_multi(\%config, $key, $value)
3391                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3392         }
3393         close $fh;
3394
3395         return %config;
3396 }
3397
3398 # convert config value to boolean: 'true' or 'false'
3399 # no value, number > 0, 'true' and 'yes' values are true
3400 # rest of values are treated as false (never as error)
3401 sub config_to_bool {
3402         my $val = shift;
3403
3404         return 1 if !defined $val;             # section.key
3405
3406         # strip leading and trailing whitespace
3407         $val =~ s/^\s+//;
3408         $val =~ s/\s+$//;
3409
3410         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3411                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3412 }
3413
3414 # convert config value to simple decimal number
3415 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3416 # to be multiplied by 1024, 1048576, or 1073741824
3417 sub config_to_int {
3418         my $val = shift;
3419
3420         # strip leading and trailing whitespace
3421         $val =~ s/^\s+//;
3422         $val =~ s/\s+$//;
3423
3424         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3425                 $unit = lc($unit);
3426                 # unknown unit is treated as 1
3427                 return $num * ($unit eq 'g' ? 1073741824 :
3428                                $unit eq 'm' ?    1048576 :
3429                                $unit eq 'k' ?       1024 : 1);
3430         }
3431         return $val;
3432 }
3433
3434 # convert config value to array reference, if needed
3435 sub config_to_multi {
3436         my $val = shift;
3437
3438         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3439 }
3440
3441 sub git_get_project_config {
3442         my ($key, $type) = @_;
3443
3444         return unless defined $git_dir;
3445
3446         # key sanity check
3447         return unless ($key);
3448         # only subsection, if exists, is case sensitive,
3449         # and not lowercased by 'git config -z -l'
3450         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3451                 $lo =~ s/_//g;
3452                 $key = join(".", lc($hi), $mi, lc($lo));
3453                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3454         } else {
3455                 $key = lc($key);
3456                 $key =~ s/_//g;
3457                 return if ($key =~ /\W/);
3458         }
3459         $key =~ s/^gitweb\.//;
3460
3461         # type sanity check
3462         if (defined $type) {
3463                 $type =~ s/^--//;
3464                 $type = undef
3465                         unless ($type eq 'bool' || $type eq 'int');
3466         }
3467
3468         # get config
3469         if (!defined $config_file ||
3470             $config_file ne "$git_dir/config") {
3471                 %config = git_parse_project_config('gitweb');
3472                 $config_file = "$git_dir/config";
3473         }
3474
3475         # check if config variable (key) exists
3476         return unless exists $config{"gitweb.$key"};
3477
3478         # ensure given type
3479         if (!defined $type) {
3480                 return $config{"gitweb.$key"};
3481         } elsif ($type eq 'bool') {
3482                 # backward compatibility: 'git config --bool' returns true/false
3483                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3484         } elsif ($type eq 'int') {
3485                 return config_to_int($config{"gitweb.$key"});
3486         }
3487         return $config{"gitweb.$key"};
3488 }
3489
3490 # get hash of given path at given ref
3491 sub git_get_hash_by_path {
3492         my $base = shift;
3493         my $path = shift || return undef;
3494         my $type = shift;
3495
3496         $path =~ s,/+$,,;
3497
3498         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3499                 or die_error(500, "Open git-ls-tree failed");
3500         my $line = to_utf8(scalar <$fd>);
3501         close $fd or return undef;
3502
3503         if (!defined $line) {
3504                 # there is no tree or hash given by $path at $base
3505                 return undef;
3506         }
3507
3508         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3509         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3510         if (defined $type && $type ne $2) {
3511                 # type doesn't match
3512                 return undef;
3513         }
3514         return $3;
3515 }
3516
3517 # get path of entry with given hash at given tree-ish (ref)
3518 # used to get 'from' filename for combined diff (merge commit) for renames
3519 sub git_get_path_by_hash {
3520         my $base = shift || return;
3521         my $hash = shift || return;
3522
3523         local $/ = "\0";
3524
3525         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3526                 or return undef;
3527         while (my $line = to_utf8(scalar <$fd>)) {
3528                 chomp $line;
3529
3530                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3531                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3532                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3533                         close $fd;
3534                         return $1;
3535                 }
3536         }
3537         close $fd;
3538         return undef;
3539 }
3540
3541 ## ......................................................................
3542 ## git utility functions, directly accessing git repository
3543
3544 # get the value of config variable either from file named as the variable
3545 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3546 # configuration variable in the repository config file.
3547 sub git_get_file_or_project_config {
3548         my ($path, $name) = @_;
3549
3550         $git_dir = "$projectroot/$path";
3551         open my $fd, '<', "$git_dir/$name"
3552                 or return git_get_project_config($name);
3553         my $conf = to_utf8(scalar <$fd>);
3554         close $fd;
3555         if (defined $conf) {
3556                 chomp $conf;
3557         }
3558         return $conf;
3559 }
3560
3561 sub git_get_project_description {
3562         my $path = shift;
3563         return git_get_file_or_project_config($path, 'description');
3564 }
3565
3566 sub git_get_project_category {
3567         my $path = shift;
3568         return git_get_file_or_project_config($path, 'category');
3569 }
3570
3571
3572 # supported formats:
3573 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3574 #   - if its contents is a number, use it as tag weight,
3575 #   - otherwise add a tag with weight 1
3576 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3577 #   the same value multiple times increases tag weight
3578 # * `gitweb.ctag' multi-valued repo config variable
3579 sub git_get_project_ctags {
3580         my $project = shift;
3581         my $ctags = {};
3582
3583         $git_dir = "$projectroot/$project";
3584         if (opendir my $dh, "$git_dir/ctags") {
3585                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3586                 foreach my $tagfile (@files) {
3587                         open my $ct, '<', $tagfile
3588                                 or next;
3589                         my $val = <$ct>;
3590                         chomp $val if $val;
3591                         close $ct;
3592
3593                         (my $ctag = $tagfile) =~ s#.*/##;
3594                         $ctag = to_utf8($ctag);
3595                         if ($val =~ /^\d+$/) {
3596                                 $ctags->{$ctag} = $val;
3597                         } else {
3598                                 $ctags->{$ctag} = 1;
3599                         }
3600                 }
3601                 closedir $dh;
3602
3603         } elsif (open my $fh, '<', "$git_dir/ctags") {
3604                 while (my $line = to_utf8(scalar <$fh>)) {
3605                         chomp $line;
3606                         $ctags->{$line}++ if $line;
3607                 }
3608                 close $fh;
3609
3610         } else {
3611                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3612                 foreach my $tag (@$taglist) {
3613                         $ctags->{$tag}++;
3614                 }
3615         }
3616
3617         return $ctags;
3618 }
3619
3620 # return hash, where keys are content tags ('ctags'),
3621 # and values are sum of weights of given tag in every project
3622 sub git_gather_all_ctags {
3623         my $projects = shift;
3624         my $ctags = {};
3625
3626         foreach my $p (@$projects) {
3627                 foreach my $ct (keys %{$p->{'ctags'}}) {
3628                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3629                 }
3630         }
3631
3632         return $ctags;
3633 }
3634
3635 sub git_populate_project_tagcloud {
3636         my ($ctags, $action) = @_;
3637
3638         # First, merge different-cased tags; tags vote on casing
3639         my %ctags_lc;
3640         foreach (keys %$ctags) {
3641                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3642                 if (not $ctags_lc{lc $_}->{topcount}
3643                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3644                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3645                         $ctags_lc{lc $_}->{topname} = $_;
3646                 }
3647         }
3648
3649         my $cloud;
3650         my $matched = $input_params{'ctag_filter'};
3651         if (eval { require HTML::TagCloud; 1; }) {
3652                 $cloud = HTML::TagCloud->new;
3653                 foreach my $ctag (sort keys %ctags_lc) {
3654                         # Pad the title with spaces so that the cloud looks
3655                         # less crammed.
3656                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3657                         $title =~ s/ /&#160;/g;
3658                         $title =~ s/^/&#160;/g;
3659                         $title =~ s/$/&#160;/g;
3660                         if (defined $matched && $matched eq $ctag) {
3661                                 $title = qq(<span class="match">$title</span>);
3662                         }
3663                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3664                                     $ctags_lc{$ctag}->{count});
3665                 }
3666         } else {
3667                 $cloud = {};
3668                 foreach my $ctag (keys %ctags_lc) {
3669                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3670                         if (defined $matched && $matched eq $ctag) {
3671                                 $title = qq(<span class="match">$title</span>);
3672                         }
3673                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3674                         $cloud->{$ctag}{ctag} =
3675                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3676                 }
3677         }
3678         return $cloud;
3679 }
3680
3681 sub git_show_project_tagcloud {
3682         my ($cloud, $count) = @_;
3683         if (ref $cloud eq 'HTML::TagCloud') {
3684                 return $cloud->html_and_css($count);
3685         } else {
3686                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3687                 return
3688                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3689                         join (', ', map {
3690                                 $cloud->{$_}->{'ctag'}
3691                         } splice(@tags, 0, $count)) .
3692                         '</div>';
3693         }
3694 }
3695
3696 sub git_get_project_url_list {
3697         my $path = shift;
3698
3699         $git_dir = "$projectroot/$path";
3700         open my $fd, '<', "$git_dir/cloneurl"
3701                 or return wantarray ?
3702                 @{ config_to_multi(git_get_project_config('url')) } :
3703                    config_to_multi(git_get_project_config('url'));
3704         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3705         close $fd;
3706
3707         return wantarray ? @git_project_url_list : \@git_project_url_list;
3708 }
3709
3710 sub git_get_projects_list {
3711         my $filter = shift || '';
3712         my $paranoid = shift;
3713         my @list;
3714
3715         if (-d $projects_list) {
3716                 # search in directory
3717                 my $dir = $projects_list;
3718                 # remove the trailing "/"
3719                 $dir =~ s!/+$!!;
3720                 my $pfxlen = length("$dir");
3721                 my $pfxdepth = ($dir =~ tr!/!!);
3722                 # when filtering, search only given subdirectory
3723                 if ($filter && !$paranoid) {
3724                         $dir .= "/$filter";
3725                         $dir =~ s!/+$!!;
3726                 }
3727
3728                 File::Find::find({
3729                         follow_fast => 1, # follow symbolic links
3730                         follow_skip => 2, # ignore duplicates
3731                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3732                         wanted => sub {
3733                                 # global variables
3734                                 our $project_maxdepth;
3735                                 our $projectroot;
3736                                 # skip project-list toplevel, if we get it.
3737                                 return if (m!^[/.]$!);
3738                                 # only directories can be git repositories
3739                                 return unless (-d $_);
3740                                 # don't traverse too deep (Find is super slow on os x)
3741                                 # $project_maxdepth excludes depth of $projectroot
3742                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3743                                         $File::Find::prune = 1;
3744                                         return;
3745                                 }
3746
3747                                 my $path = substr($File::Find::name, $pfxlen + 1);
3748                                 # paranoidly only filter here
3749                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3750                                         next;
3751                                 }
3752                                 # we check related file in $projectroot
3753                                 if (check_export_ok("$projectroot/$path")) {
3754                                         push @list, { path => $path };
3755                                         $File::Find::prune = 1;
3756                                 }
3757                         },
3758                 }, "$dir");
3759
3760         } elsif (-f $projects_list) {
3761                 # read from file(url-encoded):
3762                 # 'git%2Fgit.git Linus+Torvalds'
3763                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3764                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3765                 open my $fd, '<', $projects_list or return;
3766         PROJECT:
3767                 while (my $line = <$fd>) {
3768                         chomp $line;
3769                         my ($path, $owner) = split ' ', $line;
3770                         $path = unescape($path);
3771                         $owner = unescape($owner);
3772                         if (!defined $path) {
3773                                 next;
3774                         }
3775                         # if $filter is rpovided, check if $path begins with $filter
3776                         if ($filter && $path !~ m!^\Q$filter\E/!) {
3777                                 next;
3778                         }
3779                         if (check_export_ok("$projectroot/$path")) {
3780                                 my $pr = {
3781                                         path => $path
3782                                 };
3783                                 if ($owner) {
3784                                         $pr->{'owner'} = to_utf8($owner);
3785                                 }
3786                                 push @list, $pr;
3787                         }
3788                 }
3789                 close $fd;
3790         }
3791         return @list;
3792 }
3793
3794 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3795 # as side effects it sets 'forks' field to list of forks for forked projects
3796 sub filter_forks_from_projects_list {
3797         my $projects = shift;
3798
3799         my %trie; # prefix tree of directories (path components)
3800         # generate trie out of those directories that might contain forks
3801         foreach my $pr (@$projects) {
3802                 my $path = $pr->{'path'};
3803                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3804                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3805                 next unless ($path);      # skip '.git' repository: tests, git-instaweb
3806                 next unless (-d "$projectroot/$path"); # containing directory exists
3807                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3808
3809                 # add to trie
3810                 my @dirs = split('/', $path);
3811                 # walk the trie, until either runs out of components or out of trie
3812                 my $ref = \%trie;
3813                 while (scalar @dirs &&
3814                        exists($ref->{$dirs[0]})) {
3815                         $ref = $ref->{shift @dirs};
3816                 }
3817                 # create rest of trie structure from rest of components
3818                 foreach my $dir (@dirs) {
3819                         $ref = $ref->{$dir} = {};
3820                 }
3821                 # create end marker, store $pr as a data
3822                 $ref->{''} = $pr if (!exists $ref->{''});
3823         }
3824
3825         # filter out forks, by finding shortest prefix match for paths
3826         my @filtered;
3827  PROJECT:
3828         foreach my $pr (@$projects) {
3829                 # trie lookup
3830                 my $ref = \%trie;
3831         DIR:
3832                 foreach my $dir (split('/', $pr->{'path'})) {
3833                         if (exists $ref->{''}) {
3834                                 # found [shortest] prefix, is a fork - skip it
3835                                 push @{$ref->{''}{'forks'}}, $pr;
3836                                 next PROJECT;
3837                         }
3838                         if (!exists $ref->{$dir}) {
3839                                 # not in trie, cannot have prefix, not a fork
3840                                 push @filtered, $pr;
3841                                 next PROJECT;
3842                         }
3843                         # If the dir is there, we just walk one step down the trie.
3844                         $ref = $ref->{$dir};
3845                 }
3846                 # we ran out of trie
3847                 # (shouldn't happen: it's either no match, or end marker)
3848                 push @filtered, $pr;
3849         }
3850
3851         return @filtered;
3852 }
3853
3854 # note: fill_project_list_info must be run first,
3855 # for 'descr_long' and 'ctags' to be filled
3856 sub search_projects_list {
3857         my ($projlist, %opts) = @_;
3858         my $tagfilter  = $opts{'tagfilter'};
3859         my $search_re = $opts{'search_regexp'};
3860
3861         return @$projlist
3862                 unless ($tagfilter || $search_re);
3863
3864         # searching projects require filling to be run before it;
3865         fill_project_list_info($projlist,
3866                                $tagfilter  ? 'ctags' : (),
3867                                $search_re ? ('path', 'descr') : ());
3868         my @projects;
3869  PROJECT:
3870         foreach my $pr (@$projlist) {
3871
3872                 if ($tagfilter) {
3873                         next unless ref($pr->{'ctags'}) eq 'HASH';
3874                         next unless
3875                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3876                 }
3877
3878                 if ($search_re) {
3879                         my $path = $pr->{'path'};
3880                         $path =~ s/\.git$//; # should not be included in search
3881                         next unless
3882                                 $path =~ /$search_re/ ||
3883                                 $pr->{'descr_long'} =~ /$search_re/;
3884                 }
3885
3886                 push @projects, $pr;
3887         }
3888
3889         return @projects;
3890 }
3891
3892 our $gitweb_project_owner = undef;
3893 sub git_get_project_list_from_file {
3894
3895         return if (defined $gitweb_project_owner);
3896
3897         $gitweb_project_owner = {};
3898         # read from file (url-encoded):
3899         # 'git%2Fgit.git Linus+Torvalds'
3900         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3901         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3902         if (-f $projects_list) {
3903                 open(my $fd, '<', $projects_list);
3904                 while (my $line = <$fd>) {
3905                         chomp $line;
3906                         my ($pr, $ow) = split ' ', $line;
3907                         $pr = unescape($pr);
3908                         $ow = unescape($ow);
3909                         $gitweb_project_owner->{$pr} = to_utf8($ow);
3910                 }
3911                 close $fd;
3912         }
3913 }
3914
3915 sub git_get_project_owner {
3916         my $proj = shift;
3917         my $owner;
3918
3919         return undef unless $proj;
3920         $git_dir = "$projectroot/$proj";
3921
3922         if (defined $project && $proj eq $project) {
3923                 $owner = git_get_project_config('owner');
3924         }
3925         if (!defined $owner && !defined $gitweb_project_owner) {
3926                 git_get_project_list_from_file();
3927         }
3928         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
3929                 $owner = $gitweb_project_owner->{$proj};
3930         }
3931         if (!defined $owner && (!defined $project || $proj ne $project)) {
3932                 $owner = git_get_project_config('owner');
3933         }
3934         if (!defined $owner) {
3935                 $owner = get_file_owner("$git_dir");
3936         }
3937
3938         return $owner;
3939 }
3940
3941 sub parse_activity_date {
3942         my $dstr = shift;
3943
3944         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
3945                 # Unix timestamp
3946                 return 0 + $1;
3947         }
3948         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
3949                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
3950                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
3951                 defined($z) && $z ne '' or $z = 'Z';
3952                 $z =~ s/://;
3953                 substr($z,1,0) = '0' if length($z) == 4;
3954                 my $off = 0;
3955                 if (uc($z) ne 'Z') {
3956                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
3957                         $off = -$off if substr($z,0,1) eq '-';
3958                 }
3959                 return $seconds - $off;
3960         }
3961         return undef;
3962 }
3963
3964 # If $quick is true only look at $lastactivity_file
3965 sub git_get_last_activity {
3966         my ($path, $quick) = @_;
3967         my $fd;
3968
3969         $git_dir = "$projectroot/$path";
3970         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
3971                 my $activity = <$fd>;
3972                 close $fd;
3973                 return (undef) unless defined $activity;
3974                 chomp $activity;
3975                 return (undef) if $activity eq '';
3976                 if (my $timestamp = parse_activity_date($activity)) {
3977                         return ($timestamp);
3978                 }
3979         }
3980         return (undef) if $quick;
3981         defined($fd = git_cmd_pipe 'for-each-ref',
3982              '--format=%(committer)',
3983              '--sort=-committerdate',
3984              '--count=1',
3985              map { "refs/$_" } get_branch_refs ()) or return;
3986         my $most_recent = <$fd>;
3987         close $fd or return (undef);
3988         if (defined $most_recent &&
3989             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
3990                 my $timestamp = $1;
3991                 return ($timestamp);
3992         }
3993         return (undef);
3994 }
3995
3996 # Implementation note: when a single remote is wanted, we cannot use 'git
3997 # remote show -n' because that command always work (assuming it's a remote URL
3998 # if it's not defined), and we cannot use 'git remote show' because that would
3999 # try to make a network roundtrip. So the only way to find if that particular
4000 # remote is defined is to walk the list provided by 'git remote -v' and stop if
4001 # and when we find what we want.
4002 sub git_get_remotes_list {
4003         my $wanted = shift;
4004         my %remotes = ();
4005
4006         my $fd = git_cmd_pipe 'remote', '-v';
4007         return unless $fd;
4008         while (my $remote = to_utf8(scalar <$fd>)) {
4009                 chomp $remote;
4010                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4011                 next if $wanted and not $remote eq $wanted;
4012                 my ($url, $key) = ($1, $2);
4013
4014                 $remotes{$remote} ||= { 'heads' => [] };
4015                 $remotes{$remote}{$key} = $url;
4016         }
4017         close $fd or return;
4018         return wantarray ? %remotes : \%remotes;
4019 }
4020
4021 # Takes a hash of remotes as first parameter and fills it by adding the
4022 # available remote heads for each of the indicated remotes.
4023 sub fill_remote_heads {
4024         my $remotes = shift;
4025         my @heads = map { "remotes/$_" } keys %$remotes;
4026         my @remoteheads = git_get_heads_list(undef, @heads);
4027         foreach my $remote (keys %$remotes) {
4028                 $remotes->{$remote}{'heads'} = [ grep {
4029                         $_->{'name'} =~ s!^$remote/!!
4030                         } @remoteheads ];
4031         }
4032 }
4033
4034 sub git_get_references {
4035         my $type = shift || "";
4036         my %refs;
4037         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4038         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4039         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4040                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4041                 or return;
4042
4043         while (my $line = to_utf8(scalar <$fd>)) {
4044                 chomp $line;
4045                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4046                         if (defined $refs{$1}) {
4047                                 push @{$refs{$1}}, $2;
4048                         } else {
4049                                 $refs{$1} = [ $2 ];
4050                         }
4051                 }
4052         }
4053         close $fd or return;
4054         return \%refs;
4055 }
4056
4057 sub git_get_rev_name_tags {
4058         my $hash = shift || return undef;
4059
4060         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4061                 or return;
4062         my $name_rev = to_utf8(scalar <$fd>);
4063         close $fd;
4064
4065         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4066                 return $1;
4067         } else {
4068                 # catches also '$hash undefined' output
4069                 return undef;
4070         }
4071 }
4072
4073 ## ----------------------------------------------------------------------
4074 ## parse to hash functions
4075
4076 sub parse_date {
4077         my $epoch = shift;
4078         my $tz = shift || "-0000";
4079
4080         my %date;
4081         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4082         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4083         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4084         $date{'hour'} = $hour;
4085         $date{'minute'} = $min;
4086         $date{'mday'} = $mday;
4087         $date{'day'} = $days[$wday];
4088         $date{'month'} = $months[$mon];
4089         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4090                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4091         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4092                              $mday, $months[$mon], $hour ,$min;
4093         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4094                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4095
4096         my ($tz_sign, $tz_hour, $tz_min) =
4097                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4098         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4099         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4100         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4101         $date{'hour_local'} = $hour;
4102         $date{'minute_local'} = $min;
4103         $date{'mday_local'} = $mday;
4104         $date{'tz_local'} = $tz;
4105         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4106                                   1900+$year, $mon+1, $mday,
4107                                   $hour, $min, $sec, $tz);
4108         return %date;
4109 }
4110
4111 sub parse_file_date {
4112         my $file = shift;
4113         my $mtime = (stat("$projectroot/$project/$file"))[9];
4114         return () unless defined $mtime;
4115         my $tzoffset = timegm((localtime($mtime))[0..5]) - $mtime;
4116         my $tzstring = '+';
4117         if ($tzoffset <= 0) {
4118                 $tzstring = '-';
4119                 $tzoffset *= -1;
4120         }
4121         $tzoffset = int($tzoffset/60);
4122         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
4123         return parse_date($mtime, $tzstring);
4124 }
4125
4126 sub parse_tag {
4127         my $tag_id = shift;
4128         my %tag;
4129         my @comment;
4130
4131         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4132         $tag{'id'} = $tag_id;
4133         while (my $line = to_utf8(scalar <$fd>)) {
4134                 chomp $line;
4135                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4136                         $tag{'object'} = $1;
4137                 } elsif ($line =~ m/^type (.+)$/) {
4138                         $tag{'type'} = $1;
4139                 } elsif ($line =~ m/^tag (.+)$/) {
4140                         $tag{'name'} = $1;
4141                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4142                         $tag{'author'} = $1;
4143                         $tag{'author_epoch'} = $2;
4144                         $tag{'author_tz'} = $3;
4145                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4146                                 $tag{'author_name'}  = $1;
4147                                 $tag{'author_email'} = $2;
4148                         } else {
4149                                 $tag{'author_name'} = $tag{'author'};
4150                         }
4151                 } elsif ($line =~ m/--BEGIN/) {
4152                         push @comment, $line;
4153                         last;
4154                 } elsif ($line eq "") {
4155                         last;
4156                 }
4157         }
4158         push @comment, map(to_utf8($_), <$fd>);
4159         $tag{'comment'} = \@comment;
4160         close $fd or return;
4161         if (!defined $tag{'name'}) {
4162                 return
4163         };
4164         return %tag
4165 }
4166
4167 sub parse_commit_text {
4168         my ($commit_text, $withparents) = @_;
4169         my @commit_lines = split '\n', $commit_text;
4170         my %co;
4171
4172         pop @commit_lines; # Remove '\0'
4173
4174         if (! @commit_lines) {
4175                 return;
4176         }
4177
4178         my $header = shift @commit_lines;
4179         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4180                 return;
4181         }
4182         ($co{'id'}, my @parents) = split ' ', $header;
4183         while (my $line = shift @commit_lines) {
4184                 last if $line eq "\n";
4185                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4186                         $co{'tree'} = $1;
4187                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4188                         push @parents, $1;
4189                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4190                         $co{'author'} = to_utf8($1);
4191                         $co{'author_epoch'} = $2;
4192                         $co{'author_tz'} = $3;
4193                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4194                                 $co{'author_name'}  = $1;
4195                                 $co{'author_email'} = $2;
4196                         } else {
4197                                 $co{'author_name'} = $co{'author'};
4198                         }
4199                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4200                         $co{'committer'} = to_utf8($1);
4201                         $co{'committer_epoch'} = $2;
4202                         $co{'committer_tz'} = $3;
4203                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4204                                 $co{'committer_name'}  = $1;
4205                                 $co{'committer_email'} = $2;
4206                         } else {
4207                                 $co{'committer_name'} = $co{'committer'};
4208                         }
4209                 }
4210         }
4211         if (!defined $co{'tree'}) {
4212                 return;
4213         };
4214         $co{'parents'} = \@parents;
4215         $co{'parent'} = $parents[0];
4216
4217         @commit_lines = map to_utf8($_), @commit_lines;
4218         foreach my $title (@commit_lines) {
4219                 $title =~ s/^    //;
4220                 if ($title ne "") {
4221                         $co{'title'} = chop_str($title, 80, 5);
4222                         # remove leading stuff of merges to make the interesting part visible
4223                         if (length($title) > 50) {
4224                                 $title =~ s/^Automatic //;
4225                                 $title =~ s/^merge (of|with) /Merge ... /i;
4226                                 if (length($title) > 50) {
4227                                         $title =~ s/(http|rsync):\/\///;
4228                                 }
4229                                 if (length($title) > 50) {
4230                                         $title =~ s/(master|www|rsync)\.//;
4231                                 }
4232                                 if (length($title) > 50) {
4233                                         $title =~ s/kernel.org:?//;
4234                                 }
4235                                 if (length($title) > 50) {
4236                                         $title =~ s/\/pub\/scm//;
4237                                 }
4238                         }
4239                         $co{'title_short'} = chop_str($title, 50, 5);
4240                         last;
4241                 }
4242         }
4243         if (! defined $co{'title'} || $co{'title'} eq "") {
4244                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4245         }
4246         # remove added spaces
4247         foreach my $line (@commit_lines) {
4248                 $line =~ s/^    //;
4249         }
4250         $co{'comment'} = \@commit_lines;
4251
4252         my $age_epoch = $co{'committer_epoch'};
4253         $co{'age_epoch'} = $age_epoch;
4254         my $time_now = time;
4255         $co{'age_string'} = age_string($age_epoch, $time_now);
4256         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4257         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4258         return %co;
4259 }
4260
4261 sub parse_commit {
4262         my ($commit_id) = @_;
4263         my %co;
4264
4265         local $/ = "\0";
4266
4267         defined(my $fd = git_cmd_pipe "rev-list",
4268                 "--parents",
4269                 "--header",
4270                 "--max-count=1",
4271                 $commit_id,
4272                 "--")
4273                 or die_error(500, "Open git-rev-list failed");
4274         %co = parse_commit_text(<$fd>, 1);
4275         close $fd;
4276
4277         return %co;
4278 }
4279
4280 sub parse_commits {
4281         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4282         my @cos;
4283
4284         $maxcount ||= 1;
4285         $skip ||= 0;
4286
4287         local $/ = "\0";
4288
4289         defined(my $fd = git_cmd_pipe "rev-list",
4290                 "--header",
4291                 @args,
4292                 ("--max-count=" . $maxcount),
4293                 ("--skip=" . $skip),
4294                 @extra_options,
4295                 $commit_id,
4296                 "--",
4297                 ($filename ? ($filename) : ()))
4298                 or die_error(500, "Open git-rev-list failed");
4299         while (my $line = <$fd>) {
4300                 my %co = parse_commit_text($line);
4301                 push @cos, \%co;
4302         }
4303         close $fd;
4304
4305         return wantarray ? @cos : \@cos;
4306 }
4307
4308 # parse line of git-diff-tree "raw" output
4309 sub parse_difftree_raw_line {
4310         my $line = shift;
4311         my %res;
4312
4313         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4314         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4315         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4316                 $res{'from_mode'} = $1;
4317                 $res{'to_mode'} = $2;
4318                 $res{'from_id'} = $3;
4319                 $res{'to_id'} = $4;
4320                 $res{'status'} = $5;
4321                 $res{'similarity'} = $6;
4322                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4323                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4324                 } else {
4325                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4326                 }
4327         }
4328         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4329         # combined diff (for merge commit)
4330         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4331                 $res{'nparents'}  = length($1);
4332                 $res{'from_mode'} = [ split(' ', $2) ];
4333                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4334                 $res{'from_id'} = [ split(' ', $3) ];
4335                 $res{'to_id'} = pop @{$res{'from_id'}};
4336                 $res{'status'} = [ split('', $4) ];
4337                 $res{'to_file'} = unquote($5);
4338         }
4339         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4340         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4341                 $res{'commit'} = $1;
4342         }
4343
4344         return wantarray ? %res : \%res;
4345 }
4346
4347 # wrapper: return parsed line of git-diff-tree "raw" output
4348 # (the argument might be raw line, or parsed info)
4349 sub parsed_difftree_line {
4350         my $line_or_ref = shift;
4351
4352         if (ref($line_or_ref) eq "HASH") {
4353                 # pre-parsed (or generated by hand)
4354                 return $line_or_ref;
4355         } else {
4356                 return parse_difftree_raw_line($line_or_ref);
4357         }
4358 }
4359
4360 # parse line of git-ls-tree output
4361 sub parse_ls_tree_line {
4362         my $line = shift;
4363         my %opts = @_;
4364         my %res;
4365
4366         if ($opts{'-l'}) {
4367                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4368                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4369
4370                 $res{'mode'} = $1;
4371                 $res{'type'} = $2;
4372                 $res{'hash'} = $3;
4373                 $res{'size'} = $4;
4374                 if ($opts{'-z'}) {
4375                         $res{'name'} = $5;
4376                 } else {
4377                         $res{'name'} = unquote($5);
4378                 }
4379         } else {
4380                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4381                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4382
4383                 $res{'mode'} = $1;
4384                 $res{'type'} = $2;
4385                 $res{'hash'} = $3;
4386                 if ($opts{'-z'}) {
4387                         $res{'name'} = $4;
4388                 } else {
4389                         $res{'name'} = unquote($4);
4390                 }
4391         }
4392
4393         return wantarray ? %res : \%res;
4394 }
4395
4396 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4397 sub parse_from_to_diffinfo {
4398         my ($diffinfo, $from, $to, @parents) = @_;
4399
4400         if ($diffinfo->{'nparents'}) {
4401                 # combined diff
4402                 $from->{'file'} = [];
4403                 $from->{'href'} = [];
4404                 fill_from_file_info($diffinfo, @parents)
4405                         unless exists $diffinfo->{'from_file'};
4406                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4407                         $from->{'file'}[$i] =
4408                                 defined $diffinfo->{'from_file'}[$i] ?
4409                                         $diffinfo->{'from_file'}[$i] :
4410                                         $diffinfo->{'to_file'};
4411                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4412                                 $from->{'href'}[$i] = href(action=>"blob",
4413                                                            hash_base=>$parents[$i],
4414                                                            hash=>$diffinfo->{'from_id'}[$i],
4415                                                            file_name=>$from->{'file'}[$i]);
4416                         } else {
4417                                 $from->{'href'}[$i] = undef;
4418                         }
4419                 }
4420         } else {
4421                 # ordinary (not combined) diff
4422                 $from->{'file'} = $diffinfo->{'from_file'};
4423                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4424                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4425                                                hash=>$diffinfo->{'from_id'},
4426                                                file_name=>$from->{'file'});
4427                 } else {
4428                         delete $from->{'href'};
4429                 }
4430         }
4431
4432         $to->{'file'} = $diffinfo->{'to_file'};
4433         if (!is_deleted($diffinfo)) { # file exists in result
4434                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4435                                      hash=>$diffinfo->{'to_id'},
4436                                      file_name=>$to->{'file'});
4437         } else {
4438                 delete $to->{'href'};
4439         }
4440 }
4441
4442 ## ......................................................................
4443 ## parse to array of hashes functions
4444
4445 sub git_get_heads_list {
4446         my ($limit, @classes) = @_;
4447         @classes = get_branch_refs() unless @classes;
4448         my @patterns = map { "refs/$_" } @classes;
4449         my @headslist;
4450
4451         defined(my $fd = git_cmd_pipe 'for-each-ref',
4452                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4453                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4454                 @patterns)
4455                 or return;
4456         while (my $line = to_utf8(scalar <$fd>)) {
4457                 my %ref_item;
4458
4459                 chomp $line;
4460                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4461                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4462                 my ($committer, $epoch, $tz) =
4463                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4464                 $ref_item{'fullname'}  = $name;
4465                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4466                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4467                 $ref_item{'name'} = $name;
4468                 # for refs neither in 'heads' nor 'remotes' we want to
4469                 # show their ref dir
4470                 my $ref_dir = (defined $1) ? $1 : '';
4471                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4472                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4473                 }
4474
4475                 $ref_item{'id'}    = $hash;
4476                 $ref_item{'title'} = $title || '(no commit message)';
4477                 $ref_item{'epoch'} = $epoch;
4478                 if ($epoch) {
4479                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4480                 } else {
4481                         $ref_item{'age'} = "unknown";
4482                 }
4483
4484                 push @headslist, \%ref_item;
4485         }
4486         close $fd;
4487
4488         return wantarray ? @headslist : \@headslist;
4489 }
4490
4491 sub git_get_tags_list {
4492         my $limit = shift;
4493         my @tagslist;
4494         my $all = shift || 0;
4495         my $order = shift || $default_refs_order;
4496         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4497
4498         defined(my $fd = git_cmd_pipe 'for-each-ref',
4499                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4500                 '--format=%(objectname) %(objecttype) %(refname) '.
4501                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4502                 ($all ? 'refs' : 'refs/tags'))
4503                 or return;
4504         while (my $line = to_utf8(scalar <$fd>)) {
4505                 my %ref_item;
4506
4507                 chomp $line;
4508                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4509                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4510                 my ($creator, $epoch, $tz) =
4511                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4512                 $ref_item{'fullname'} = $name;
4513                 $name =~ s!^refs/!! if $all;
4514                 $name =~ s!^refs/tags/!! unless $all;
4515
4516                 $ref_item{'type'} = $type;
4517                 $ref_item{'id'} = $id;
4518                 $ref_item{'name'} = $name;
4519                 if ($type eq "tag") {
4520                         $ref_item{'subject'} = $title;
4521                         $ref_item{'reftype'} = $reftype;
4522                         $ref_item{'refid'}   = $refid;
4523                 } else {
4524                         $ref_item{'reftype'} = $type;
4525                         $ref_item{'refid'}   = $id;
4526                 }
4527
4528                 if ($type eq "tag" || $type eq "commit") {
4529                         $ref_item{'epoch'} = $epoch;
4530                         if ($epoch) {
4531                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4532                         } else {
4533                                 $ref_item{'age'} = "unknown";
4534                         }
4535                 }
4536
4537                 push @tagslist, \%ref_item;
4538         }
4539         close $fd;
4540
4541         return wantarray ? @tagslist : \@tagslist;
4542 }
4543
4544 ## ----------------------------------------------------------------------
4545 ## filesystem-related functions
4546
4547 sub get_file_owner {
4548         my $path = shift;
4549
4550         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4551         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4552         if (!defined $gcos) {
4553                 return undef;
4554         }
4555         my $owner = $gcos;
4556         $owner =~ s/[,;].*$//;
4557         return to_utf8($owner);
4558 }
4559
4560 # assume that file exists
4561 sub insert_file {
4562         my $filename = shift;
4563
4564         open my $fd, '<', $filename;
4565         while (<$fd>) {
4566                 print to_utf8($_);
4567         }
4568         close $fd;
4569 }
4570
4571 ## ......................................................................
4572 ## mimetype related functions
4573
4574 sub mimetype_guess_file {
4575         my $filename = shift;
4576         my $mimemap = shift;
4577         my $rawmode = shift;
4578         -r $mimemap or return undef;
4579
4580         my %mimemap;
4581         open(my $mh, '<', $mimemap) or return undef;
4582         while (<$mh>) {
4583                 next if m/^#/; # skip comments
4584                 my ($mimetype, @exts) = split(/\s+/);
4585                 foreach my $ext (@exts) {
4586                         $mimemap{$ext} = $mimetype;
4587                 }
4588         }
4589         close($mh);
4590
4591         my ($ext, $ans);
4592         $ext = $1 if $filename =~ /\.([^.]*)$/;
4593         $ans = $mimemap{$ext} if $ext;
4594         if (defined $ans) {
4595                 my $l = lc($ans);
4596                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4597                 if (!$rawmode) {
4598                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4599                                              $l eq 'image/svg+xml' ||
4600                                              $l eq 'application/xml-dtd' ||
4601                                              $l eq 'application/xml-external-parsed-entity';
4602                 }
4603         }
4604         return $ans;
4605 }
4606
4607 sub mimetype_guess {
4608         my $filename = shift;
4609         my $rawmode = shift;
4610         my $mime;
4611         $filename =~ /\./ or return undef;
4612
4613         if ($mimetypes_file) {
4614                 my $file = $mimetypes_file;
4615                 if ($file !~ m!^/!) { # if it is relative path
4616                         # it is relative to project
4617                         $file = "$projectroot/$project/$file";
4618                 }
4619                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4620         }
4621         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4622         return $mime;
4623 }
4624
4625 sub blob_mimetype {
4626         my $fd = shift;
4627         my $filename = shift;
4628         my $rawmode = shift;
4629         my $mime;
4630
4631         # The -T/-B file operators produce the wrong result unless a perlio
4632         # layer is present when the file handle is a pipe that delivers less
4633         # than 512 bytes of data before reaching EOF.
4634         #
4635         # If we are running in a Perl that uses the stdio layer rather than the
4636         # unix+perlio layers we will end up adding a perlio layer on top of the
4637         # stdio layer and get a second level of buffering.  This is harmless
4638         # and it makes the -T/-B file operators work properly in all cases.
4639
4640         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4641                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4642
4643         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4644
4645         if (!$mime && $filename) {
4646                 if ($filename =~ m/\.html?$/i) {
4647                         $mime = 'text/html';
4648                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4649                         $mime = 'text/html';
4650                 } elsif ($filename =~ m/\.te?xt?$/i) {
4651                         $mime = 'text/plain';
4652                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4653                         $mime = 'text/plain';
4654                 } elsif ($filename =~ m/\.png$/i) {
4655                         $mime = 'image/png';
4656                 } elsif ($filename =~ m/\.gif$/i) {
4657                         $mime = 'image/gif';
4658                 } elsif ($filename =~ m/\.jpe?g$/i) {
4659                         $mime = 'image/jpeg';
4660                 } elsif ($filename =~ m/\.svgz?$/i) {
4661                         $mime = 'image/svg+xml';
4662                 }
4663         }
4664
4665         # just in case
4666         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4667
4668         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4669
4670         return $mime;
4671 }
4672
4673 sub is_ascii {
4674         use bytes;
4675         my $data = shift;
4676         return scalar($data =~ /^[\x00-\x7f]*$/);
4677 }
4678
4679 sub is_valid_utf8 {
4680         my $data = shift;
4681         return utf8::decode($data);
4682 }
4683
4684 sub extract_html_charset {
4685         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4686         my $head = $1;
4687         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4688         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) {
4689                 my %kv = (lc($1) => $3, lc($4) => $6);
4690                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4691                 return $1 if $he && $c && $he eq 'content-type' &&
4692                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4693         }
4694         return undef;
4695 }
4696
4697 sub blob_contenttype {
4698         my ($fd, $file_name, $type) = @_;
4699
4700         $type ||= blob_mimetype($fd, $file_name, 1);
4701         return $type unless $type =~ m!^text/.+!i;
4702         my ($leader, $charset, $htmlcharset);
4703         if ($fd && read($fd, $leader, 32768)) {{
4704                 $charset='US-ASCII' if is_ascii($leader);
4705                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4706                 $charset='ISO-8859-1' unless $charset;
4707                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4708                 if ($htmlcharset && $charset ne 'US-ASCII') {
4709                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4710                 }
4711         }}
4712         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4713         my $defcharset = $default_text_plain_charset || '';
4714         $defcharset =~ s/^\s+//;
4715         $defcharset =~ s/\s+$//;
4716         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4717         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4718 }
4719
4720 # peek the first upto 128 bytes off a file handle
4721 sub peek128bytes {
4722         my $fd = shift;
4723
4724         use IO::Handle;
4725         use bytes;
4726
4727         my $prefix128;
4728         return '' unless $fd && read($fd, $prefix128, 128);
4729
4730         # In the general case, we're guaranteed only to be able to ungetc one
4731         # character (provided, of course, we actually got a character first).
4732         #
4733         # However, we know:
4734         #
4735         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4736         #    already been called at least once on the file handle before us
4737         #
4738         # 2) we have an $fd positioned at the start of the input stream and
4739         #    therefore know we were positioned at a buffer boundary before
4740         #    reading the initial upto 128 bytes
4741         #
4742         # 3) the buffer size is at least 512 bytes
4743         #
4744         # 4) we are careful to only unget raw bytes
4745         #
4746         # 5) we are attempting to unget exactly the same number of bytes we got
4747         #
4748         # Given the above conditions we will ALWAYS be able to safely unget
4749         # the $prefix128 value we just got.
4750         #
4751         # In fact, we could read up to 511 bytes and still be sure.
4752         # (Reading 512 might pop us into the next internal buffer, but probably
4753         # not since that could break the always able to unget at least the one
4754         # you just got guarantee.)
4755
4756         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4757
4758         return $prefix128;
4759 }
4760
4761 # guess file syntax for syntax highlighting; return undef if no highlighting
4762 # the name of syntax can (in the future) depend on syntax highlighter used
4763 sub guess_file_syntax {
4764         my ($fd, $mimetype, $file_name) = @_;
4765         return undef unless $fd && defined $file_name &&
4766                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4767         my $basename = basename($file_name, '.in');
4768         return $highlight_basename{$basename}
4769                 if exists $highlight_basename{$basename};
4770
4771         # Peek to see if there's a shebang or xml line.
4772         # We always operate on bytes when testing this.
4773         {
4774                 use bytes;
4775                 my $shebang = peek128bytes($fd);
4776                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4777                         foreach my $key (keys %highlight_shebang) {
4778                                 my $ar = ref($highlight_shebang{$key}) ?
4779                                         $highlight_shebang{$key} :
4780                                         [$highlight_shebang{key}];
4781                                 map {return $key if $shebang =~ /$_/} @$ar;
4782                         }
4783                 }
4784                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4785         }
4786
4787         $basename =~ /\.([^.]*)$/;
4788         my $ext = $1 or return undef;
4789         return $highlight_ext{$ext}
4790                 if exists $highlight_ext{$ext};
4791
4792         return undef;
4793 }
4794
4795 # run highlighter and return FD of its output,
4796 # or return original FD if no highlighting
4797 sub run_highlighter {
4798         my ($fd, $syntax) = @_;
4799         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4800
4801         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4802                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4803                 quote_command($highlight_bin).
4804                 " --replace-tabs=8 --fragment --syntax $syntax")
4805                 or die_error(500, "Couldn't open file or run syntax highlighter");
4806         if (eof $hifd) {
4807                 # just in case, should not happen as we tested !eof($fd) above
4808                 return $fd if close($hifd);
4809
4810                 # should not happen
4811                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4812
4813                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4814                 # instead of dying horribly on this, just skip the highlighting
4815                 # but do output a message about it to STDERR that will end up in the log
4816                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4817                         sprintf("child exit status 0x%x\n", $?);
4818                 return $fd
4819         }
4820         close $fd;
4821         return ($hifd, 1);
4822 }
4823
4824 ## ======================================================================
4825 ## functions printing HTML: header, footer, error page
4826
4827 sub get_page_title {
4828         my $title = to_utf8($site_name);
4829
4830         unless (defined $project) {
4831                 if (defined $project_filter) {
4832                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4833                 }
4834                 return $title;
4835         }
4836         $title .= " - " . to_utf8($project);
4837
4838         return $title unless (defined $action);
4839         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4840         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4841
4842         return $title unless (defined $file_name);
4843         $title .= " - " . esc_path($file_name);
4844         if ($action eq "tree" && $file_name !~ m|/$|) {
4845                 $title .= "/";
4846         }
4847
4848         return $title;
4849 }
4850
4851 sub get_content_type_html {
4852         # We do not ever emit application/xhtml+xml since that gives us
4853         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4854         # strict, which is troublesome for example when showing user-supplied
4855         # README.html files.
4856         return 'text/html';
4857 }
4858
4859 sub print_feed_meta {
4860         if (defined $project) {
4861                 my %href_params = get_feed_info();
4862                 if (!exists $href_params{'-title'}) {
4863                         $href_params{'-title'} = 'log';
4864                 }
4865
4866                 foreach my $format (qw(RSS Atom)) {
4867                         my $type = lc($format);
4868                         my %link_attr = (
4869                                 '-rel' => 'alternate',
4870                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4871                                 '-type' => "application/$type+xml"
4872                         );
4873
4874                         $href_params{'extra_options'} = undef;
4875                         $href_params{'action'} = $type;
4876                         $link_attr{'-href'} = href(%href_params);
4877                         print "<link ".
4878                               "rel=\"$link_attr{'-rel'}\" ".
4879                               "title=\"$link_attr{'-title'}\" ".
4880                               "href=\"$link_attr{'-href'}\" ".
4881                               "type=\"$link_attr{'-type'}\" ".
4882                               "/>\n";
4883
4884                         $href_params{'extra_options'} = '--no-merges';
4885                         $link_attr{'-href'} = href(%href_params);
4886                         $link_attr{'-title'} .= ' (no merges)';
4887                         print "<link ".
4888                               "rel=\"$link_attr{'-rel'}\" ".
4889                               "title=\"$link_attr{'-title'}\" ".
4890                               "href=\"$link_attr{'-href'}\" ".
4891                               "type=\"$link_attr{'-type'}\" ".
4892                               "/>\n";
4893                 }
4894
4895         } else {
4896                 printf('<link rel="alternate" title="%s projects list" '.
4897                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4898                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4899                 printf('<link rel="alternate" title="%s projects feeds" '.
4900                        'href="%s" type="text/x-opml" />'."\n",
4901                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4902         }
4903 }
4904
4905 sub print_header_links {
4906         my $status = shift;
4907
4908         # print out each stylesheet that exist, providing backwards capability
4909         # for those people who defined $stylesheet in a config file
4910         if (defined $stylesheet) {
4911                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4912         } else {
4913                 foreach my $stylesheet (@stylesheets) {
4914                         next unless $stylesheet;
4915                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4916                 }
4917         }
4918         print_feed_meta()
4919                 if ($status eq '200 OK');
4920         if (defined $favicon) {
4921                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4922         }
4923 }
4924
4925 sub print_nav_breadcrumbs_path {
4926         my $dirprefix = undef;
4927         while (my $part = shift) {
4928                 $dirprefix .= "/" if defined $dirprefix;
4929                 $dirprefix .= $part;
4930                 print $cgi->a({-href => href(project => undef,
4931                                              project_filter => $dirprefix,
4932                                              action => "project_list")},
4933                               esc_html($part)) . " / ";
4934         }
4935 }
4936
4937 sub print_nav_breadcrumbs {
4938         my %opts = @_;
4939
4940         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4941                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4942         }
4943         if (defined $project) {
4944                 my @dirname = split '/', $project;
4945                 my $projectbasename = pop @dirname;
4946                 print_nav_breadcrumbs_path(@dirname);
4947                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4948                 if (defined $action) {
4949                         my $action_print = $action ;
4950                         $action_print = 'blame' if $action_print eq 'blame_incremental';
4951                         if (defined $opts{-action_extra}) {
4952                                 $action_print = $cgi->a({-href => href(action=>$action)},
4953                                         $action);
4954                         }
4955                         print " / $action_print";
4956                 }
4957                 if (defined $opts{-action_extra}) {
4958                         print " / $opts{-action_extra}";
4959                 }
4960                 print "\n";
4961         } elsif (defined $project_filter) {
4962                 print_nav_breadcrumbs_path(split '/', $project_filter);
4963         }
4964 }
4965
4966 sub print_search_form {
4967         if (!defined $searchtext) {
4968                 $searchtext = "";
4969         }
4970         my $search_hash;
4971         if (defined $hash_base) {
4972                 $search_hash = $hash_base;
4973         } elsif (defined $hash) {
4974                 $search_hash = $hash;
4975         } else {
4976                 $search_hash = "HEAD";
4977         }
4978         # We can't use href() here because we need to encode the
4979         # URL parameters into the form, not into the action link.
4980         my $action = $my_uri;
4981         my $use_pathinfo = gitweb_check_feature('pathinfo');
4982         if ($use_pathinfo) {
4983                 # See notes about doubled / in href()
4984                 $action =~ s,/$,,;
4985                 $action .= "/".esc_path_info($project);
4986         }
4987         print $cgi->start_form(-method => "get", -action => $action) .
4988               "<div class=\"search\">\n" .
4989               (!$use_pathinfo &&
4990               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
4991               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
4992               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
4993               $cgi->popup_menu(-name => 'st', -default => 'commit',
4994                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
4995               " " . $cgi->a({-href => href(action=>"search_help"),
4996                              -title => "search help" }, "?") . " search:\n",
4997               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
4998               "<span title=\"Extended regular expression\">" .
4999               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5000                              -checked => $search_use_regexp) .
5001               "</span>" .
5002               "</div>" .
5003               $cgi->end_form() . "\n";
5004 }
5005
5006 sub git_header_html {
5007         my $status = shift || "200 OK";
5008         my $expires = shift;
5009         my %opts = @_;
5010
5011         my $title = get_page_title();
5012         my $content_type = get_content_type_html();
5013         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5014                            -status=> $status, -expires => $expires)
5015                 unless ($opts{'-no_http_header'});
5016         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5017         print <<EOF;
5018 <?xml version="1.0" encoding="utf-8"?>
5019 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5020 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5021 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5022 <!-- git core binaries version $git_version -->
5023 <head>
5024 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5025 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5026 <meta name="robots" content="index, nofollow"/>
5027 <title>$title</title>
5028 <script type="text/javascript">/* <![CDATA[ */
5029 function fixBlameLinks() {
5030         var allLinks = document.getElementsByTagName("a");
5031         for (var i = 0; i < allLinks.length; i++) {
5032                 var link = allLinks.item(i);
5033                 if (link.className == 'blamelink')
5034                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5035         }
5036 }
5037 /* ]]> */</script>
5038 EOF
5039         # the stylesheet, favicon etc urls won't work correctly with path_info
5040         # unless we set the appropriate base URL
5041         if ($ENV{'PATH_INFO'}) {
5042                 print "<base href=\"".esc_url($base_url)."\" />\n";
5043         }
5044         print_header_links($status);
5045
5046         if (defined $site_html_head_string) {
5047                 print to_utf8($site_html_head_string);
5048         }
5049
5050         print "</head>\n" .
5051               "<body>\n";
5052
5053         if (defined $site_header && -f $site_header) {
5054                 insert_file($site_header);
5055         }
5056
5057         print "<div class=\"page_header\">\n";
5058         if (defined $logo) {
5059                 print $cgi->a({-href => esc_url($logo_url),
5060                                -title => $logo_label},
5061                               $cgi->img({-src => esc_url($logo),
5062                                          -width => 72, -height => 27,
5063                                          -alt => "git",
5064                                          -class => "logo"}));
5065         }
5066         print_nav_breadcrumbs(%opts);
5067         print "</div>\n";
5068
5069         my $have_search = gitweb_check_feature('search');
5070         if (defined $project && $have_search) {
5071                 print_search_form();
5072         }
5073 }
5074
5075 sub compute_timed_interval {
5076         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5077         return tv_interval($t0, [ gettimeofday() ]);
5078 }
5079
5080 sub compute_commands_count {
5081         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5082         my $s = $number_of_git_cmds == 1 ? '' : 's';
5083         return '<span id="generating_cmd">'.
5084                 $number_of_git_cmds.
5085                 "</span> git command$s";
5086 }
5087
5088 sub git_footer_html {
5089         my $feed_class = 'rss_logo';
5090
5091         print "<div class=\"page_footer\">\n";
5092         if (defined $project) {
5093                 my $descr = git_get_project_description($project);
5094                 if (defined $descr) {
5095                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5096                 }
5097
5098                 my %href_params = get_feed_info();
5099                 if (!%href_params) {
5100                         $feed_class .= ' generic';
5101                 }
5102                 $href_params{'-title'} ||= 'log';
5103
5104                 foreach my $format (qw(RSS Atom)) {
5105                         $href_params{'action'} = lc($format);
5106                         print $cgi->a({-href => href(%href_params),
5107                                       -title => "$href_params{'-title'} $format feed",
5108                                       -class => $feed_class}, $format)."\n";
5109                 }
5110
5111         } else {
5112                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5113                                              project_filter => $project_filter),
5114                               -class => $feed_class}, "OPML") . " ";
5115                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5116                                              project_filter => $project_filter),
5117                               -class => $feed_class}, "TXT") . "\n";
5118         }
5119         print "</div>\n"; # class="page_footer"
5120
5121         if (defined $t0 && gitweb_check_feature('timed')) {
5122                 print "<div id=\"generating_info\">\n";
5123                 print 'This page took '.
5124                       '<span id="generating_time" class="time_span">'.
5125                       compute_timed_interval().
5126                       ' seconds </span>'.
5127                       ' and '.
5128                       compute_commands_count().
5129                       " to generate.\n";
5130                 print "</div>\n"; # class="page_footer"
5131         }
5132
5133         if (defined $site_footer && -f $site_footer) {
5134                 insert_file($site_footer);
5135         }
5136
5137         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5138         if (defined $action &&
5139             $action eq 'blame_incremental') {
5140                 print qq!<script type="text/javascript">\n!.
5141                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5142                       qq!           "!. href() .qq!");\n!.
5143                       qq!</script>\n!;
5144         } else {
5145                 my ($jstimezone, $tz_cookie, $datetime_class) =
5146                         gitweb_get_feature('javascript-timezone');
5147
5148                 print qq!<script type="text/javascript">\n!.
5149                       qq!window.onload = function () {\n!;
5150                 if (gitweb_check_feature('blame_incremental')) {
5151                         print qq!       fixBlameLinks();\n!;
5152                 }
5153                 if (gitweb_check_feature('javascript-actions')) {
5154                         print qq!       fixLinks();\n!;
5155                 }
5156                 if ($jstimezone && $tz_cookie && $datetime_class) {
5157                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5158                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5159                 }
5160                 print qq!};\n!.
5161                       qq!</script>\n!;
5162         }
5163
5164         print "</body>\n" .
5165               "</html>";
5166 }
5167
5168 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5169 # Example: die_error(404, 'Hash not found')
5170 # By convention, use the following status codes (as defined in RFC 2616):
5171 # 400: Invalid or missing CGI parameters, or
5172 #      requested object exists but has wrong type.
5173 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5174 #      this server or project.
5175 # 404: Requested object/revision/project doesn't exist.
5176 # 500: The server isn't configured properly, or
5177 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5178 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5179 # 503: The server is currently unavailable (because it is overloaded,
5180 #      or down for maintenance).  Generally, this is a temporary state.
5181 sub die_error {
5182         my $status = shift || 500;
5183         my $error = esc_html(shift) || "Internal Server Error";
5184         my $extra = shift;
5185         my %opts = @_;
5186
5187         my %http_responses = (
5188                 400 => '400 Bad Request',
5189                 403 => '403 Forbidden',
5190                 404 => '404 Not Found',
5191                 500 => '500 Internal Server Error',
5192                 503 => '503 Service Unavailable',
5193         );
5194         git_header_html($http_responses{$status}, undef, %opts);
5195         print <<EOF;
5196 <div class="page_body">
5197 <br /><br />
5198 $status - $error
5199 <br />
5200 EOF
5201         if (defined $extra) {
5202                 print "<hr />\n" .
5203                       "$extra\n";
5204         }
5205         print "</div>\n";
5206
5207         git_footer_html();
5208         goto DONE_GITWEB
5209                 unless ($opts{'-error_handler'});
5210 }
5211
5212 ## ----------------------------------------------------------------------
5213 ## functions printing or outputting HTML: navigation
5214
5215 sub git_print_page_nav {
5216         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5217         $extra = '' if !defined $extra; # pager or formats
5218
5219         my @navs = qw(summary log commit commitdiff tree refs);
5220         if ($suppress) {
5221                 @navs = grep { $_ ne $suppress } @navs;
5222         }
5223
5224         my %arg = map { $_ => {action=>$_} } @navs;
5225         if (defined $head) {
5226                 for (qw(commit commitdiff)) {
5227                         $arg{$_}{'hash'} = $head;
5228                 }
5229                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5230                         $arg{'log'}{'hash'} = $head;
5231                 }
5232         }
5233
5234         $arg{'log'}{'action'} = 'shortlog';
5235         if ($current eq 'log') {
5236                 $current = 'shortlog';
5237         } elsif ($current eq 'shortlog') {
5238                 $current = 'log';
5239         }
5240         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5241         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5242
5243         my @actions = gitweb_get_feature('actions');
5244         my $escname = $project;
5245         $escname =~ s/[+]/%2B/g;
5246         my %repl = (
5247                 '%' => '%',
5248                 'n' => $project,         # project name
5249                 'f' => $git_dir,         # project path within filesystem
5250                 'h' => $treehead || '',  # current hash ('h' parameter)
5251                 'b' => $treebase || '',  # hash base ('hb' parameter)
5252                 'e' => $escname,         # project name with '+' escaped
5253         );
5254         while (@actions) {
5255                 my ($label, $link, $pos) = splice(@actions,0,3);
5256                 # insert
5257                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5258                 # munch munch
5259                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5260                 $arg{$label}{'_href'} = $link;
5261         }
5262
5263         print "<div class=\"page_nav\">\n" .
5264                 (join " | ",
5265                  map { $_ eq $current ?
5266                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
5267                  } @navs);
5268         print "<br/>\n$extra<br/>\n" .
5269               "</div>\n";
5270 }
5271
5272 # returns a submenu for the nagivation of the refs views (tags, heads,
5273 # remotes) with the current view disabled and the remotes view only
5274 # available if the feature is enabled
5275 sub format_ref_views {
5276         my ($current) = @_;
5277         my @ref_views = qw{tags heads};
5278         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5279         return join " | ", map {
5280                 $_ eq $current ? $_ :
5281                 $cgi->a({-href => href(action=>$_)}, $_)
5282         } @ref_views
5283 }
5284
5285 sub format_paging_nav {
5286         my ($action, $page, $has_next_link) = @_;
5287         my $paging_nav;
5288
5289
5290         if ($page > 0) {
5291                 $paging_nav .=
5292                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
5293                         " &#183; " .
5294                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5295                                  -accesskey => "p", -title => "Alt-p"}, "prev");
5296         } else {
5297                 $paging_nav .= "first &#183; prev";
5298         }
5299
5300         if ($has_next_link) {
5301                 $paging_nav .= " &#183; " .
5302                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5303                                  -accesskey => "n", -title => "Alt-n"}, "next");
5304         } else {
5305                 $paging_nav .= " &#183; next";
5306         }
5307
5308         return $paging_nav;
5309 }
5310
5311 sub format_log_nav {
5312         my ($action, $page, $has_next_link) = @_;
5313         my $paging_nav;
5314
5315         if ($action eq 'shortlog') {
5316                 $paging_nav .= 'shortlog';
5317         } else {
5318                 $paging_nav .= $cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog');
5319         }
5320         $paging_nav .= ' | ';
5321         if ($action eq 'log') {
5322                 $paging_nav .= 'fulllog';
5323         } else {
5324                 $paging_nav .= $cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog');
5325         }
5326
5327         $paging_nav .= " | " . format_paging_nav($action, $page, $has_next_link);
5328         return $paging_nav;
5329 }
5330
5331 ## ......................................................................
5332 ## functions printing or outputting HTML: div
5333
5334 sub git_print_header_div {
5335         my ($action, $title, $hash, $hash_base, $extra) = @_;
5336         my %args = ();
5337         defined $extra or $extra = '';
5338
5339         $args{'action'} = $action;
5340         $args{'hash'} = $hash if $hash;
5341         $args{'hash_base'} = $hash_base if $hash_base;
5342
5343         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5344                             $title ? $title : $action);
5345         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5346         print "<div class=\"header\">\n" . '<span class="title">' .
5347               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5348 }
5349
5350 sub format_repo_url {
5351         my ($name, $url) = @_;
5352         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5353 }
5354
5355 # Group output by placing it in a DIV element and adding a header.
5356 # Options for start_div() can be provided by passing a hash reference as the
5357 # first parameter to the function.
5358 # Options to git_print_header_div() can be provided by passing an array
5359 # reference. This must follow the options to start_div if they are present.
5360 # The content can be a scalar, which is output as-is, a scalar reference, which
5361 # is output after html escaping, an IO handle passed either as *handle or
5362 # *handle{IO}, or a function reference. In the latter case all following
5363 # parameters will be taken as argument to the content function call.
5364 sub git_print_section {
5365         my ($div_args, $header_args, $content);
5366         my $arg = shift;
5367         if (ref($arg) eq 'HASH') {
5368                 $div_args = $arg;
5369                 $arg = shift;
5370         }
5371         if (ref($arg) eq 'ARRAY') {
5372                 $header_args = $arg;
5373                 $arg = shift;
5374         }
5375         $content = $arg;
5376
5377         print $cgi->start_div($div_args);
5378         git_print_header_div(@$header_args);
5379
5380         if (ref($content) eq 'CODE') {
5381                 $content->(@_);
5382         } elsif (ref($content) eq 'SCALAR') {
5383                 print esc_html($$content);
5384         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5385                 while (<$content>) {
5386                         print to_utf8($_);
5387                 }
5388         } elsif (!ref($content) && defined($content)) {
5389                 print $content;
5390         }
5391
5392         print $cgi->end_div;
5393 }
5394
5395 sub format_timestamp_html {
5396         my $date = shift;
5397         my $useatnight = shift;
5398         defined($useatnight) or $useatnight = 1;
5399         my $strtime = $date->{'rfc2822'};
5400
5401         my (undef, undef, $datetime_class) =
5402                 gitweb_get_feature('javascript-timezone');
5403         if ($datetime_class) {
5404                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5405         }
5406
5407         my $localtime_format = '(%d %02d:%02d %s)';
5408         if ($useatnight && $date->{'hour_local'} < 6) {
5409                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5410         }
5411         $strtime .= ' ' .
5412                     sprintf($localtime_format, $date->{'mday_local'},
5413                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5414
5415         return $strtime;
5416 }
5417
5418 sub format_lastrefresh_row {
5419         return "<?gitweb format_lastrefresh_row?>" if $cache_mode_active;
5420         my %rd = parse_file_date('.last_refresh');
5421         if (defined $rd{'rfc2822'}) {
5422                 return "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
5423                        "<td>".format_timestamp_html(\%rd,0)."</td></tr>";
5424         }
5425         return "";
5426 }
5427
5428 # Outputs the author name and date in long form
5429 sub git_print_authorship {
5430         my $co = shift;
5431         my %opts = @_;
5432         my $tag = $opts{-tag} || 'div';
5433         my $author = $co->{'author_name'};
5434
5435         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5436         print "<$tag class=\"author_date\">" .
5437               format_search_author($author, "author", esc_html($author)) .
5438               " [".format_timestamp_html(\%ad)."]".
5439               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5440               "</$tag>\n";
5441 }
5442
5443 # Outputs table rows containing the full author or committer information,
5444 # in the format expected for 'commit' view (& similar).
5445 # Parameters are a commit hash reference, followed by the list of people
5446 # to output information for. If the list is empty it defaults to both
5447 # author and committer.
5448 sub git_print_authorship_rows {
5449         my $co = shift;
5450         # too bad we can't use @people = @_ || ('author', 'committer')
5451         my @people = @_;
5452         @people = ('author', 'committer') unless @people;
5453         foreach my $who (@people) {
5454                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5455                 print "<tr><td>$who</td><td>" .
5456                       format_search_author($co->{"${who}_name"}, $who,
5457                                            esc_html($co->{"${who}_name"})) . " " .
5458                       format_search_author($co->{"${who}_email"}, $who,
5459                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5460                       "</td><td rowspan=\"2\">" .
5461                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5462                       "</td></tr>\n" .
5463                       "<tr>" .
5464                       "<td></td><td>" .
5465                       format_timestamp_html(\%wd) .
5466                       "</td>" .
5467                       "</tr>\n";
5468         }
5469 }
5470
5471 sub git_print_page_path {
5472         my $name = shift;
5473         my $type = shift;
5474         my $hb = shift;
5475
5476
5477         print "<div class=\"page_path\">";
5478         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5479                       -title => 'tree root'}, to_utf8("[$project]"));
5480         print " / ";
5481         if (defined $name) {
5482                 my @dirname = split '/', $name;
5483                 my $basename = pop @dirname;
5484                 my $fullname = '';
5485
5486                 foreach my $dir (@dirname) {
5487                         $fullname .= ($fullname ? '/' : '') . $dir;
5488                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5489                                                      hash_base=>$hb),
5490                                       -title => $fullname}, esc_path($dir));
5491                         print " / ";
5492                 }
5493                 if (defined $type && $type eq 'blob') {
5494                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5495                                                      hash_base=>$hb),
5496                                       -title => $name}, esc_path($basename));
5497                 } elsif (defined $type && $type eq 'tree') {
5498                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5499                                                      hash_base=>$hb),
5500                                       -title => $name}, esc_path($basename));
5501                         print " / ";
5502                 } else {
5503                         print esc_path($basename);
5504                 }
5505         }
5506         print "<br/></div>\n";
5507 }
5508
5509 sub git_print_log {
5510         my $log = shift;
5511         my %opts = @_;
5512
5513         if ($opts{'-remove_title'}) {
5514                 # remove title, i.e. first line of log
5515                 shift @$log;
5516         }
5517         # remove leading empty lines
5518         while (defined $log->[0] && $log->[0] eq "") {
5519                 shift @$log;
5520         }
5521
5522         # print log
5523         my $skip_blank_line = 0;
5524         foreach my $line (@$log) {
5525                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5526                         if (! $opts{'-remove_signoff'}) {
5527                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5528                                 $skip_blank_line = 1;
5529                         }
5530                         next;
5531                 }
5532
5533                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5534                         if (! $opts{'-remove_signoff'}) {
5535                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5536                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5537                                         "</span><br/>\n";
5538                                 $skip_blank_line = 1;
5539                         }
5540                         next;
5541                 }
5542
5543                 # print only one empty line
5544                 # do not print empty line after signoff
5545                 if ($line eq "") {
5546                         next if ($skip_blank_line);
5547                         $skip_blank_line = 1;
5548                 } else {
5549                         $skip_blank_line = 0;
5550                 }
5551
5552                 print format_log_line_html($line) . "<br/>\n";
5553         }
5554
5555         if ($opts{'-final_empty_line'}) {
5556                 # end with single empty line
5557                 print "<br/>\n" unless $skip_blank_line;
5558         }
5559 }
5560
5561 # return link target (what link points to)
5562 sub git_get_link_target {
5563         my $hash = shift;
5564         my $link_target;
5565
5566         # read link
5567         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5568                 or return;
5569         {
5570                 local $/ = undef;
5571                 $link_target = to_utf8(scalar <$fd>);
5572         }
5573         close $fd
5574                 or return;
5575
5576         return $link_target;
5577 }
5578
5579 # given link target, and the directory (basedir) the link is in,
5580 # return target of link relative to top directory (top tree);
5581 # return undef if it is not possible (including absolute links).
5582 sub normalize_link_target {
5583         my ($link_target, $basedir) = @_;
5584
5585         # absolute symlinks (beginning with '/') cannot be normalized
5586         return if (substr($link_target, 0, 1) eq '/');
5587
5588         # normalize link target to path from top (root) tree (dir)
5589         my $path;
5590         if ($basedir) {
5591                 $path = $basedir . '/' . $link_target;
5592         } else {
5593                 # we are in top (root) tree (dir)
5594                 $path = $link_target;
5595         }
5596
5597         # remove //, /./, and /../
5598         my @path_parts;
5599         foreach my $part (split('/', $path)) {
5600                 # discard '.' and ''
5601                 next if (!$part || $part eq '.');
5602                 # handle '..'
5603                 if ($part eq '..') {
5604                         if (@path_parts) {
5605                                 pop @path_parts;
5606                         } else {
5607                                 # link leads outside repository (outside top dir)
5608                                 return;
5609                         }
5610                 } else {
5611                         push @path_parts, $part;
5612                 }
5613         }
5614         $path = join('/', @path_parts);
5615
5616         return $path;
5617 }
5618
5619 # print tree entry (row of git_tree), but without encompassing <tr> element
5620 sub git_print_tree_entry {
5621         my ($t, $basedir, $hash_base, $have_blame) = @_;
5622
5623         my %base_key = ();
5624         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5625
5626         # The format of a table row is: mode list link.  Where mode is
5627         # the mode of the entry, list is the name of the entry, an href,
5628         # and link is the action links of the entry.
5629
5630         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5631         if (exists $t->{'size'}) {
5632                 print "<td class=\"size\">$t->{'size'}</td>\n";
5633         }
5634         if ($t->{'type'} eq "blob") {
5635                 print "<td class=\"list\">" .
5636                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5637                                                file_name=>"$basedir$t->{'name'}", %base_key),
5638                                 -class => "list"}, esc_path($t->{'name'}));
5639                 if (S_ISLNK(oct $t->{'mode'})) {
5640                         my $link_target = git_get_link_target($t->{'hash'});
5641                         if ($link_target) {
5642                                 my $norm_target = normalize_link_target($link_target, $basedir);
5643                                 if (defined $norm_target) {
5644                                         print " -> " .
5645                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5646                                                                      file_name=>$norm_target),
5647                                                        -title => $norm_target}, esc_path($link_target));
5648                                 } else {
5649                                         print " -> " . esc_path($link_target);
5650                                 }
5651                         }
5652                 }
5653                 print "</td>\n";
5654                 print "<td class=\"link\">";
5655                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5656                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5657                               "blob");
5658                 if ($have_blame) {
5659                         print " | " .
5660                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5661                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5662                                       -class => "blamelink"},
5663                                       "blame");
5664                 }
5665                 if (defined $hash_base) {
5666                         print " | " .
5667                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5668                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5669                                       "history");
5670                 }
5671                 print " | " .
5672                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5673                                                file_name=>"$basedir$t->{'name'}")},
5674                                 "raw");
5675                 print "</td>\n";
5676
5677         } elsif ($t->{'type'} eq "tree") {
5678                 print "<td class=\"list\">";
5679                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5680                                              file_name=>"$basedir$t->{'name'}",
5681                                              %base_key)},
5682                               esc_path($t->{'name'}));
5683                 print "</td>\n";
5684                 print "<td class=\"link\">";
5685                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5686                                              file_name=>"$basedir$t->{'name'}",
5687                                              %base_key)},
5688                               "tree");
5689                 if (defined $hash_base) {
5690                         print " | " .
5691                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5692                                                      file_name=>"$basedir$t->{'name'}")},
5693                                       "history");
5694                 }
5695                 print "</td>\n";
5696         } else {
5697                 # unknown object: we can only present history for it
5698                 # (this includes 'commit' object, i.e. submodule support)
5699                 print "<td class=\"list\">" .
5700                       esc_path($t->{'name'}) .
5701                       "</td>\n";
5702                 print "<td class=\"link\">";
5703                 if (defined $hash_base) {
5704                         print $cgi->a({-href => href(action=>"history",
5705                                                      hash_base=>$hash_base,
5706                                                      file_name=>"$basedir$t->{'name'}")},
5707                                       "history");
5708                 }
5709                 print "</td>\n";
5710         }
5711 }
5712
5713 ## ......................................................................
5714 ## functions printing large fragments of HTML
5715
5716 # get pre-image filenames for merge (combined) diff
5717 sub fill_from_file_info {
5718         my ($diff, @parents) = @_;
5719
5720         $diff->{'from_file'} = [ ];
5721         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5722         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5723                 if ($diff->{'status'}[$i] eq 'R' ||
5724                     $diff->{'status'}[$i] eq 'C') {
5725                         $diff->{'from_file'}[$i] =
5726                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5727                 }
5728         }
5729
5730         return $diff;
5731 }
5732
5733 # is current raw difftree line of file deletion
5734 sub is_deleted {
5735         my $diffinfo = shift;
5736
5737         return $diffinfo->{'to_id'} eq ('0' x 40);
5738 }
5739
5740 # does patch correspond to [previous] difftree raw line
5741 # $diffinfo  - hashref of parsed raw diff format
5742 # $patchinfo - hashref of parsed patch diff format
5743 #              (the same keys as in $diffinfo)
5744 sub is_patch_split {
5745         my ($diffinfo, $patchinfo) = @_;
5746
5747         return defined $diffinfo && defined $patchinfo
5748                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5749 }
5750
5751
5752 sub git_difftree_body {
5753         my ($difftree, $hash, @parents) = @_;
5754         my ($parent) = $parents[0];
5755         my $have_blame = gitweb_check_feature('blame');
5756         print "<div class=\"list_head\">\n";
5757         if ($#{$difftree} > 10) {
5758                 print(($#{$difftree} + 1) . " files changed:\n");
5759         }
5760         print "</div>\n";
5761
5762         print "<table class=\"" .
5763               (@parents > 1 ? "combined " : "") .
5764               "diff_tree\">\n";
5765
5766         # header only for combined diff in 'commitdiff' view
5767         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5768         if ($has_header) {
5769                 # table header
5770                 print "<thead><tr>\n" .
5771                        "<th></th><th></th>\n"; # filename, patchN link
5772                 for (my $i = 0; $i < @parents; $i++) {
5773                         my $par = $parents[$i];
5774                         print "<th>" .
5775                               $cgi->a({-href => href(action=>"commitdiff",
5776                                                      hash=>$hash, hash_parent=>$par),
5777                                        -title => 'commitdiff to parent number ' .
5778                                                   ($i+1) . ': ' . substr($par,0,7)},
5779                                       $i+1) .
5780                               "&#160;</th>\n";
5781                 }
5782                 print "</tr></thead>\n<tbody>\n";
5783         }
5784
5785         my $alternate = 1;
5786         my $patchno = 0;
5787         foreach my $line (@{$difftree}) {
5788                 my $diff = parsed_difftree_line($line);
5789
5790                 if ($alternate) {
5791                         print "<tr class=\"dark\">\n";
5792                 } else {
5793                         print "<tr class=\"light\">\n";
5794                 }
5795                 $alternate ^= 1;
5796
5797                 if (exists $diff->{'nparents'}) { # combined diff
5798
5799                         fill_from_file_info($diff, @parents)
5800                                 unless exists $diff->{'from_file'};
5801
5802                         if (!is_deleted($diff)) {
5803                                 # file exists in the result (child) commit
5804                                 print "<td>" .
5805                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5806                                                              file_name=>$diff->{'to_file'},
5807                                                              hash_base=>$hash),
5808                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5809                                       "</td>\n";
5810                         } else {
5811                                 print "<td>" .
5812                                       esc_path($diff->{'to_file'}) .
5813                                       "</td>\n";
5814                         }
5815
5816                         if ($action eq 'commitdiff') {
5817                                 # link to patch
5818                                 $patchno++;
5819                                 print "<td class=\"link\">" .
5820                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5821                                               "patch") .
5822                                       " | " .
5823                                       "</td>\n";
5824                         }
5825
5826                         my $has_history = 0;
5827                         my $not_deleted = 0;
5828                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5829                                 my $hash_parent = $parents[$i];
5830                                 my $from_hash = $diff->{'from_id'}[$i];
5831                                 my $from_path = $diff->{'from_file'}[$i];
5832                                 my $status = $diff->{'status'}[$i];
5833
5834                                 $has_history ||= ($status ne 'A');
5835                                 $not_deleted ||= ($status ne 'D');
5836
5837                                 if ($status eq 'A') {
5838                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
5839                                 } elsif ($status eq 'D') {
5840                                         print "<td class=\"link\">" .
5841                                               $cgi->a({-href => href(action=>"blob",
5842                                                                      hash_base=>$hash,
5843                                                                      hash=>$from_hash,
5844                                                                      file_name=>$from_path)},
5845                                                       "blob" . ($i+1)) .
5846                                               " | </td>\n";
5847                                 } else {
5848                                         if ($diff->{'to_id'} eq $from_hash) {
5849                                                 print "<td class=\"link nochange\">";
5850                                         } else {
5851                                                 print "<td class=\"link\">";
5852                                         }
5853                                         print $cgi->a({-href => href(action=>"blobdiff",
5854                                                                      hash=>$diff->{'to_id'},
5855                                                                      hash_parent=>$from_hash,
5856                                                                      hash_base=>$hash,
5857                                                                      hash_parent_base=>$hash_parent,
5858                                                                      file_name=>$diff->{'to_file'},
5859                                                                      file_parent=>$from_path)},
5860                                                       "diff" . ($i+1)) .
5861                                               " | </td>\n";
5862                                 }
5863                         }
5864
5865                         print "<td class=\"link\">";
5866                         if ($not_deleted) {
5867                                 print $cgi->a({-href => href(action=>"blob",
5868                                                              hash=>$diff->{'to_id'},
5869                                                              file_name=>$diff->{'to_file'},
5870                                                              hash_base=>$hash)},
5871                                               "blob");
5872                                 print " | " if ($has_history);
5873                         }
5874                         if ($has_history) {
5875                                 print $cgi->a({-href => href(action=>"history",
5876                                                              file_name=>$diff->{'to_file'},
5877                                                              hash_base=>$hash)},
5878                                               "history");
5879                         }
5880                         print "</td>\n";
5881
5882                         print "</tr>\n";
5883                         next; # instead of 'else' clause, to avoid extra indent
5884                 }
5885                 # else ordinary diff
5886
5887                 my ($to_mode_oct, $to_mode_str, $to_file_type);
5888                 my ($from_mode_oct, $from_mode_str, $from_file_type);
5889                 if ($diff->{'to_mode'} ne ('0' x 6)) {
5890                         $to_mode_oct = oct $diff->{'to_mode'};
5891                         if (S_ISREG($to_mode_oct)) { # only for regular file
5892                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
5893                         }
5894                         $to_file_type = file_type($diff->{'to_mode'});
5895                 }
5896                 if ($diff->{'from_mode'} ne ('0' x 6)) {
5897                         $from_mode_oct = oct $diff->{'from_mode'};
5898                         if (S_ISREG($from_mode_oct)) { # only for regular file
5899                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
5900                         }
5901                         $from_file_type = file_type($diff->{'from_mode'});
5902                 }
5903
5904                 if ($diff->{'status'} eq "A") { # created
5905                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
5906                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
5907                         $mode_chng   .= "]</span>";
5908                         print "<td>";
5909                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5910                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5911                                       -class => "list"}, esc_path($diff->{'file'}));
5912                         print "</td>\n";
5913                         print "<td>$mode_chng</td>\n";
5914                         print "<td class=\"link\">";
5915                         if ($action eq 'commitdiff') {
5916                                 # link to patch
5917                                 $patchno++;
5918                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5919                                               "patch") .
5920                                       " | ";
5921                         }
5922                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5923                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5924                                       "blob");
5925                         print "</td>\n";
5926
5927                 } elsif ($diff->{'status'} eq "D") { # deleted
5928                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5929                         print "<td>";
5930                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5931                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
5932                                        -class => "list"}, esc_path($diff->{'file'}));
5933                         print "</td>\n";
5934                         print "<td>$mode_chng</td>\n";
5935                         print "<td class=\"link\">";
5936                         if ($action eq 'commitdiff') {
5937                                 # link to patch
5938                                 $patchno++;
5939                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5940                                               "patch") .
5941                                       " | ";
5942                         }
5943                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5944                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
5945                                       "blob") . " | ";
5946                         if ($have_blame) {
5947                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5948                                                              file_name=>$diff->{'file'}),
5949                                               -class => "blamelink"},
5950                                               "blame") . " | ";
5951                         }
5952                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5953                                                      file_name=>$diff->{'file'})},
5954                                       "history");
5955                         print "</td>\n";
5956
5957                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5958                         my $mode_chnge = "";
5959                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5960                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5961                                 if ($from_file_type ne $to_file_type) {
5962                                         $mode_chnge .= " from $from_file_type to $to_file_type";
5963                                 }
5964                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
5965                                         if ($from_mode_str && $to_mode_str) {
5966                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
5967                                         } elsif ($to_mode_str) {
5968                                                 $mode_chnge .= " mode: $to_mode_str";
5969                                         }
5970                                 }
5971                                 $mode_chnge .= "]</span>\n";
5972                         }
5973                         print "<td>";
5974                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5975                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5976                                       -class => "list"}, esc_path($diff->{'file'}));
5977                         print "</td>\n";
5978                         print "<td>$mode_chnge</td>\n";
5979                         print "<td class=\"link\">";
5980                         if ($action eq 'commitdiff') {
5981                                 # link to patch
5982                                 $patchno++;
5983                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5984                                               "patch") .
5985                                       " | ";
5986                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5987                                 # "commit" view and modified file (not onlu mode changed)
5988                                 print $cgi->a({-href => href(action=>"blobdiff",
5989                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5990                                                              hash_base=>$hash, hash_parent_base=>$parent,
5991                                                              file_name=>$diff->{'file'})},
5992                                               "diff") .
5993                                       " | ";
5994                         }
5995                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5996                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5997                                        "blob") . " | ";
5998                         if ($have_blame) {
5999                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6000                                                              file_name=>$diff->{'file'}),
6001                                               -class => "blamelink"},
6002                                               "blame") . " | ";
6003                         }
6004                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6005                                                      file_name=>$diff->{'file'})},
6006                                       "history");
6007                         print "</td>\n";
6008
6009                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6010                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6011                         my $nstatus = $status_name{$diff->{'status'}};
6012                         my $mode_chng = "";
6013                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6014                                 # mode also for directories, so we cannot use $to_mode_str
6015                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6016                         }
6017                         print "<td>" .
6018                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6019                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6020                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6021                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6022                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6023                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6024                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6025                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6026                               "<td class=\"link\">";
6027                         if ($action eq 'commitdiff') {
6028                                 # link to patch
6029                                 $patchno++;
6030                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6031                                               "patch") .
6032                                       " | ";
6033                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6034                                 # "commit" view and modified file (not only pure rename or copy)
6035                                 print $cgi->a({-href => href(action=>"blobdiff",
6036                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6037                                                              hash_base=>$hash, hash_parent_base=>$parent,
6038                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6039                                               "diff") .
6040                                       " | ";
6041                         }
6042                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6043                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6044                                       "blob") . " | ";
6045                         if ($have_blame) {
6046                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6047                                                              file_name=>$diff->{'to_file'}),
6048                                               -class => "blamelink"},
6049                                               "blame") . " | ";
6050                         }
6051                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6052                                                     file_name=>$diff->{'to_file'})},
6053                                       "history");
6054                         print "</td>\n";
6055
6056                 } # we should not encounter Unmerged (U) or Unknown (X) status
6057                 print "</tr>\n";
6058         }
6059         print "</tbody>" if $has_header;
6060         print "</table>\n";
6061 }
6062
6063 # Print context lines and then rem/add lines in a side-by-side manner.
6064 sub print_sidebyside_diff_lines {
6065         my ($ctx, $rem, $add) = @_;
6066
6067         # print context block before add/rem block
6068         if (@$ctx) {
6069                 print join '',
6070                         '<div class="chunk_block ctx">',
6071                                 '<div class="old">',
6072                                 @$ctx,
6073                                 '</div>',
6074                                 '<div class="new">',
6075                                 @$ctx,
6076                                 '</div>',
6077                         '</div>';
6078         }
6079
6080         if (!@$add) {
6081                 # pure removal
6082                 print join '',
6083                         '<div class="chunk_block rem">',
6084                                 '<div class="old">',
6085                                 @$rem,
6086                                 '</div>',
6087                         '</div>';
6088         } elsif (!@$rem) {
6089                 # pure addition
6090                 print join '',
6091                         '<div class="chunk_block add">',
6092                                 '<div class="new">',
6093                                 @$add,
6094                                 '</div>',
6095                         '</div>';
6096         } else {
6097                 print join '',
6098                         '<div class="chunk_block chg">',
6099                                 '<div class="old">',
6100                                 @$rem,
6101                                 '</div>',
6102                                 '<div class="new">',
6103                                 @$add,
6104                                 '</div>',
6105                         '</div>';
6106         }
6107 }
6108
6109 # Print context lines and then rem/add lines in inline manner.
6110 sub print_inline_diff_lines {
6111         my ($ctx, $rem, $add) = @_;
6112
6113         print @$ctx, @$rem, @$add;
6114 }
6115
6116 # Format removed and added line, mark changed part and HTML-format them.
6117 # Implementation is based on contrib/diff-highlight
6118 sub format_rem_add_lines_pair {
6119         my ($rem, $add, $num_parents) = @_;
6120
6121         # We need to untabify lines before split()'ing them;
6122         # otherwise offsets would be invalid.
6123         chomp $rem;
6124         chomp $add;
6125         $rem = untabify($rem);
6126         $add = untabify($add);
6127
6128         my @rem = split(//, $rem);
6129         my @add = split(//, $add);
6130         my ($esc_rem, $esc_add);
6131         # Ignore leading +/- characters for each parent.
6132         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6133         my ($prefix_has_nonspace, $suffix_has_nonspace);
6134
6135         my $shorter = (@rem < @add) ? @rem : @add;
6136         while ($prefix_len < $shorter) {
6137                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6138
6139                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6140                 $prefix_len++;
6141         }
6142
6143         while ($prefix_len + $suffix_len < $shorter) {
6144                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6145
6146                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6147                 $suffix_len++;
6148         }
6149
6150         # Mark lines that are different from each other, but have some common
6151         # part that isn't whitespace.  If lines are completely different, don't
6152         # mark them because that would make output unreadable, especially if
6153         # diff consists of multiple lines.
6154         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6155                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6156                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6157                 $esc_add = esc_html_hl_regions($add, 'marked',
6158                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6159         } else {
6160                 $esc_rem = esc_html($rem, -nbsp=>1);
6161                 $esc_add = esc_html($add, -nbsp=>1);
6162         }
6163
6164         return format_diff_line(\$esc_rem, 'rem'),
6165                format_diff_line(\$esc_add, 'add');
6166 }
6167
6168 # HTML-format diff context, removed and added lines.
6169 sub format_ctx_rem_add_lines {
6170         my ($ctx, $rem, $add, $num_parents) = @_;
6171         my (@new_ctx, @new_rem, @new_add);
6172         my $can_highlight = 0;
6173         my $is_combined = ($num_parents > 1);
6174
6175         # Highlight if every removed line has a corresponding added line.
6176         if (@$add > 0 && @$add == @$rem) {
6177                 $can_highlight = 1;
6178
6179                 # Highlight lines in combined diff only if the chunk contains
6180                 # diff between the same version, e.g.
6181                 #
6182                 #    - a
6183                 #   -  b
6184                 #    + c
6185                 #   +  d
6186                 #
6187                 # Otherwise the highlightling would be confusing.
6188                 if ($is_combined) {
6189                         for (my $i = 0; $i < @$add; $i++) {
6190                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6191                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6192
6193                                 $prefix_rem =~ s/-/+/g;
6194
6195                                 if ($prefix_rem ne $prefix_add) {
6196                                         $can_highlight = 0;
6197                                         last;
6198                                 }
6199                         }
6200                 }
6201         }
6202
6203         if ($can_highlight) {
6204                 for (my $i = 0; $i < @$add; $i++) {
6205                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6206                                 $rem->[$i], $add->[$i], $num_parents);
6207                         push @new_rem, $line_rem;
6208                         push @new_add, $line_add;
6209                 }
6210         } else {
6211                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6212                 @new_add = map { format_diff_line($_, 'add') } @$add;
6213         }
6214
6215         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6216
6217         return (\@new_ctx, \@new_rem, \@new_add);
6218 }
6219
6220 # Print context lines and then rem/add lines.
6221 sub print_diff_lines {
6222         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6223         my $is_combined = $num_parents > 1;
6224
6225         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6226                 $num_parents);
6227
6228         if ($diff_style eq 'sidebyside' && !$is_combined) {
6229                 print_sidebyside_diff_lines($ctx, $rem, $add);
6230         } else {
6231                 # default 'inline' style and unknown styles
6232                 print_inline_diff_lines($ctx, $rem, $add);
6233         }
6234 }
6235
6236 sub print_diff_chunk {
6237         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6238         my (@ctx, @rem, @add);
6239
6240         # The class of the previous line.
6241         my $prev_class = '';
6242
6243         return unless @chunk;
6244
6245         # incomplete last line might be among removed or added lines,
6246         # or both, or among context lines: find which
6247         for (my $i = 1; $i < @chunk; $i++) {
6248                 if ($chunk[$i][0] eq 'incomplete') {
6249                         $chunk[$i][0] = $chunk[$i-1][0];
6250                 }
6251         }
6252
6253         # guardian
6254         push @chunk, ["", ""];
6255
6256         foreach my $line_info (@chunk) {
6257                 my ($class, $line) = @$line_info;
6258
6259                 # print chunk headers
6260                 if ($class && $class eq 'chunk_header') {
6261                         print format_diff_line($line, $class, $from, $to);
6262                         next;
6263                 }
6264
6265                 ## print from accumulator when have some add/rem lines or end
6266                 # of chunk (flush context lines), or when have add and rem
6267                 # lines and new block is reached (otherwise add/rem lines could
6268                 # be reordered)
6269                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6270                     (@rem && @add && $class ne $prev_class)) {
6271                         print_diff_lines(\@ctx, \@rem, \@add,
6272                                          $diff_style, $num_parents);
6273                         @ctx = @rem = @add = ();
6274                 }
6275
6276                 ## adding lines to accumulator
6277                 # guardian value
6278                 last unless $line;
6279                 # rem, add or change
6280                 if ($class eq 'rem') {
6281                         push @rem, $line;
6282                 } elsif ($class eq 'add') {
6283                         push @add, $line;
6284                 }
6285                 # context line
6286                 if ($class eq 'ctx') {
6287                         push @ctx, $line;
6288                 }
6289
6290                 $prev_class = $class;
6291         }
6292 }
6293
6294 sub git_patchset_body {
6295         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6296         my ($hash_parent) = $hash_parents[0];
6297
6298         my $is_combined = (@hash_parents > 1);
6299         my $patch_idx = 0;
6300         my $patch_number = 0;
6301         my $patch_line;
6302         my $diffinfo;
6303         my $to_name;
6304         my (%from, %to);
6305         my @chunk; # for side-by-side diff
6306
6307         print "<div class=\"patchset\">\n";
6308
6309         # skip to first patch
6310         while ($patch_line = to_utf8(scalar <$fd>)) {
6311                 chomp $patch_line;
6312
6313                 last if ($patch_line =~ m/^diff /);
6314         }
6315
6316  PATCH:
6317         while ($patch_line) {
6318
6319                 # parse "git diff" header line
6320                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6321                         # $1 is from_name, which we do not use
6322                         $to_name = unquote($2);
6323                         $to_name =~ s!^b/!!;
6324                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6325                         # $1 is 'cc' or 'combined', which we do not use
6326                         $to_name = unquote($2);
6327                 } else {
6328                         $to_name = undef;
6329                 }
6330
6331                 # check if current patch belong to current raw line
6332                 # and parse raw git-diff line if needed
6333                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6334                         # this is continuation of a split patch
6335                         print "<div class=\"patch cont\">\n";
6336                 } else {
6337                         # advance raw git-diff output if needed
6338                         $patch_idx++ if defined $diffinfo;
6339
6340                         # read and prepare patch information
6341                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6342
6343                         # compact combined diff output can have some patches skipped
6344                         # find which patch (using pathname of result) we are at now;
6345                         if ($is_combined) {
6346                                 while ($to_name ne $diffinfo->{'to_file'}) {
6347                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6348                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6349                                               "</div>\n";  # class="patch"
6350
6351                                         $patch_idx++;
6352                                         $patch_number++;
6353
6354                                         last if $patch_idx > $#$difftree;
6355                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6356                                 }
6357                         }
6358
6359                         # modifies %from, %to hashes
6360                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6361
6362                         # this is first patch for raw difftree line with $patch_idx index
6363                         # we index @$difftree array from 0, but number patches from 1
6364                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6365                 }
6366
6367                 # git diff header
6368                 #assert($patch_line =~ m/^diff /) if DEBUG;
6369                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6370                 $patch_number++;
6371                 # print "git diff" header
6372                 print format_git_diff_header_line($patch_line, $diffinfo,
6373                                                   \%from, \%to);
6374
6375                 # print extended diff header
6376                 print "<div class=\"diff extended_header\">\n";
6377         EXTENDED_HEADER:
6378                 while ($patch_line = to_utf8(scalar<$fd>)) {
6379                         chomp $patch_line;
6380
6381                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6382
6383                         print format_extended_diff_header_line($patch_line, $diffinfo,
6384                                                                \%from, \%to);
6385                 }
6386                 print "</div>\n"; # class="diff extended_header"
6387
6388                 # from-file/to-file diff header
6389                 if (! $patch_line) {
6390                         print "</div>\n"; # class="patch"
6391                         last PATCH;
6392                 }
6393                 next PATCH if ($patch_line =~ m/^diff /);
6394                 #assert($patch_line =~ m/^---/) if DEBUG;
6395
6396                 my $last_patch_line = $patch_line;
6397                 $patch_line = to_utf8(scalar <$fd>);
6398                 chomp $patch_line;
6399                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6400
6401                 print format_diff_from_to_header($last_patch_line, $patch_line,
6402                                                  $diffinfo, \%from, \%to,
6403                                                  @hash_parents);
6404
6405                 # the patch itself
6406         LINE:
6407                 while ($patch_line = to_utf8(scalar <$fd>)) {
6408                         chomp $patch_line;
6409
6410                         next PATCH if ($patch_line =~ m/^diff /);
6411
6412                         my $class = diff_line_class($patch_line, \%from, \%to);
6413
6414                         if ($class eq 'chunk_header') {
6415                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6416                                 @chunk = ();
6417                         }
6418
6419                         push @chunk, [ $class, $patch_line ];
6420                 }
6421
6422         } continue {
6423                 if (@chunk) {
6424                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6425                         @chunk = ();
6426                 }
6427                 print "</div>\n"; # class="patch"
6428         }
6429
6430         # for compact combined (--cc) format, with chunk and patch simplification
6431         # the patchset might be empty, but there might be unprocessed raw lines
6432         for (++$patch_idx if $patch_number > 0;
6433              $patch_idx < @$difftree;
6434              ++$patch_idx) {
6435                 # read and prepare patch information
6436                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6437
6438                 # generate anchor for "patch" links in difftree / whatchanged part
6439                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6440                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6441                       "</div>\n";  # class="patch"
6442
6443                 $patch_number++;
6444         }
6445
6446         if ($patch_number == 0) {
6447                 if (@hash_parents > 1) {
6448                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6449                 } else {
6450                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6451                 }
6452         }
6453
6454         print "</div>\n"; # class="patchset"
6455 }
6456
6457 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6458
6459 sub git_project_search_form {
6460         my ($searchtext, $search_use_regexp) = @_;
6461
6462         my $limit = '';
6463         if ($project_filter) {
6464                 $limit = " in '$project_filter'";
6465         }
6466
6467         print "<div class=\"projsearch\">\n";
6468         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6469               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6470         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6471                 if (defined $project_filter);
6472         print $cgi->textfield(-name => 's', -value => $searchtext,
6473                               -title => "Search project by name and description$limit",
6474                               -size => 60) . "\n" .
6475               "<span title=\"Extended regular expression\">" .
6476               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6477                              -checked => $search_use_regexp) .
6478               "</span>\n" .
6479               $cgi->submit(-name => 'btnS', -value => 'Search') .
6480               $cgi->end_form() . "\n" .
6481               "<span class=\"projectlist_link\">" .
6482               $cgi->a({-href => href(project => undef, searchtext => undef,
6483                                      action => 'project_list',
6484                                      project_filter => $project_filter)},
6485                       esc_html("List all projects$limit")) . "</span><br />\n";
6486         print "<span class=\"projectlist_link\">" .
6487               $cgi->a({-href => href(project => undef, searchtext => undef,
6488                                      action => 'project_list',
6489                                      project_filter => undef)},
6490                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6491         print "</div>\n";
6492 }
6493
6494 # entry for given @keys needs filling if at least one of keys in list
6495 # is not present in %$project_info
6496 sub project_info_needs_filling {
6497         my ($project_info, @keys) = @_;
6498
6499         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6500         foreach my $key (@keys) {
6501                 if (!exists $project_info->{$key}) {
6502                         return 1;
6503                 }
6504         }
6505         return;
6506 }
6507
6508 sub git_cache_file_format {
6509         return GITWEB_CACHE_FORMAT .
6510                 (gitweb_check_feature('forks') ? " (forks)" : "");
6511 }
6512
6513 sub git_retrieve_cache_file {
6514         my $cache_file = shift;
6515
6516         use Storable qw(retrieve);
6517
6518         if ((my $dump = eval { retrieve($cache_file) })) {
6519                 return $$dump[1] if
6520                         ref($dump) eq 'ARRAY' &&
6521                         @$dump == 2 &&
6522                         ref($$dump[1]) eq 'ARRAY' &&
6523                         @{$$dump[1]} == 2 &&
6524                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6525                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6526                         $$dump[0] eq git_cache_file_format();
6527         }
6528
6529         return undef;
6530 }
6531
6532 sub git_store_cache_file {
6533         my ($cache_file, $cachedata) = @_;
6534
6535         use File::Basename qw(dirname);
6536         use File::stat;
6537         use POSIX qw(:fcntl_h);
6538         use Storable qw(store_fd);
6539
6540         my $result = undef;
6541         my $cache_d = dirname($cache_file);
6542         my $mask = umask();
6543         umask($mask & ~0070) if $cache_grpshared;
6544         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6545             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6546                 store_fd([git_cache_file_format(), $cachedata], $fd);
6547                 close $fd;
6548                 rename "$cache_file.lock", $cache_file;
6549                 $result = stat($cache_file)->mtime;
6550         }
6551         umask($mask) if $cache_grpshared;
6552         return $result;
6553 }
6554
6555 sub verify_cached_project {
6556         my ($hashref, $path) = @_;
6557         return undef unless $path;
6558         delete $$hashref{$path}, return undef unless is_valid_project($path);
6559         return $$hashref{$path} if exists $$hashref{$path};
6560
6561         # A valid project was requested but it's not yet in the cache
6562         # Manufacture a minimal project entry (path, name, description)
6563         # Also provide age, but only if it's available via $lastactivity_file
6564
6565         my %proj = ('path' => $path);
6566         my $val = git_get_project_description($path);
6567         defined $val or $val = '';
6568         $proj{'descr_long'} = $val;
6569         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6570         unless ($omit_owner) {
6571                 $val = git_get_project_owner($path);
6572                 defined $val or $val = '';
6573                 $proj{'owner'} = $val;
6574         }
6575         unless ($omit_age_column) {
6576                 ($val) = git_get_last_activity($path, 1);
6577                 $proj{'age_epoch'} = $val if defined $val;
6578         }
6579         $$hashref{$path} = \%proj;
6580         return \%proj;
6581 }
6582
6583 sub git_filter_cached_projects {
6584         my ($cache, $projlist, $verify) = @_;
6585         my $hashref = $$cache[1];
6586         my $sub = $verify ?
6587                 sub {verify_cached_project($hashref, $_[0])} :
6588                 sub {$$hashref{$_[0]}};
6589         return map {
6590                 my $c = &$sub($_->{'path'});
6591                 defined $c ? ($_ = $c) : ()
6592         } @$projlist;
6593 }
6594
6595 # fills project list info (age, description, owner, category, forks, etc.)
6596 # for each project in the list, removing invalid projects from
6597 # returned list, or fill only specified info.
6598 #
6599 # Invalid projects are removed from the returned list if and only if you
6600 # ask 'age_epoch' to be filled, because they are the only fields
6601 # that run unconditionally git command that requires repository, and
6602 # therefore do always check if project repository is invalid.
6603 #
6604 # USAGE:
6605 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6606 #   ensures that 'descr_long' and 'ctags' fields are filled
6607 # * @project_list = fill_project_list_info(\@project_list)
6608 #   ensures that all fields are filled (and invalid projects removed)
6609 #
6610 # NOTE: modifies $projlist, but does not remove entries from it
6611 sub fill_project_list_info {
6612         my ($projlist, @wanted_keys) = @_;
6613
6614         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6615         return fill_project_list_info_uncached($projlist, @wanted_keys)
6616                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6617
6618         use File::stat;
6619
6620         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6621         my $cache_file = "$cache_dir/$projlist_cache_name";
6622
6623         my @projects;
6624         my $stale = 0;
6625         my $now = time();
6626         my $cache_mtime;
6627         if ($cache_lifetime && -f $cache_file) {
6628                 $cache_mtime = stat($cache_file)->mtime;
6629                 $cache_dump = undef if $cache_mtime &&
6630                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6631         }
6632         if (defined $cache_mtime && # caching is on and $cache_file exists
6633             $cache_mtime + $cache_lifetime*60 > $now &&
6634             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6635                 # Cache hit.
6636                 $cache_dump_mtime = $cache_mtime;
6637                 $stale = $now - $cache_mtime;
6638                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6639                         gitweb_check_feature('forks');
6640                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6641
6642         } else { # Cache miss.
6643                 if (defined $cache_mtime) {
6644                         # Postpone timeout by two minutes so that we get
6645                         # enough time to do our job, or to be more exact
6646                         # make cache expire after two minutes from now.
6647                         my $time = $now - $cache_lifetime*60 + 120;
6648                         utime $time, $time, $cache_file;
6649                 }
6650                 my @all_projects = git_get_projects_list();
6651                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6652                         fill_project_list_info_uncached(\@all_projects);
6653                 map { $all_projects_filled{$_->{'path'}} = $_ }
6654                         filter_forks_from_projects_list([values(%all_projects_filled)])
6655                         if gitweb_check_feature('forks');
6656                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6657                                \%all_projects_filled];
6658                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6659                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6660         }
6661
6662         if ($cache_lifetime && $stale > 0) {
6663                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6664                         unless $shown_stale_message;
6665                 $shown_stale_message = 1;
6666         }
6667
6668         return @projects;
6669 }
6670
6671 sub fill_project_list_info_uncached {
6672         my ($projlist, @wanted_keys) = @_;
6673         my @projects;
6674         my $filter_set = sub { return @_; };
6675         if (@wanted_keys) {
6676                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6677                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6678         }
6679
6680         my $show_ctags = gitweb_check_feature('ctags');
6681  PROJECT:
6682         foreach my $pr (@$projlist) {
6683                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6684                         my (@activity) = git_get_last_activity($pr->{'path'});
6685                         unless (@activity) {
6686                                 next PROJECT;
6687                         }
6688                         ($pr->{'age_epoch'}) = @activity;
6689                 }
6690                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6691                         my $descr = git_get_project_description($pr->{'path'}) || "";
6692                         $descr = to_utf8($descr);
6693                         $pr->{'descr_long'} = $descr;
6694                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6695                 }
6696                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6697                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6698                 }
6699                 if ($show_ctags &&
6700                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6701                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6702                 }
6703                 if ($projects_list_group_categories &&
6704                     project_info_needs_filling($pr, $filter_set->('category'))) {
6705                         my $cat = git_get_project_category($pr->{'path'}) ||
6706                                                            $project_list_default_category;
6707                         $pr->{'category'} = to_utf8($cat);
6708                 }
6709
6710                 push @projects, $pr;
6711         }
6712
6713         return @projects;
6714 }
6715
6716 sub sort_projects_list {
6717         my ($projlist, $order) = @_;
6718
6719         sub order_str {
6720                 my $key = shift;
6721                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6722         }
6723
6724         sub order_reverse_num_then_undef {
6725                 my $key = shift;
6726                 return sub {
6727                         defined $a->{$key} ?
6728                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6729                                 (defined $b->{$key} ? 1 : 0)
6730                 };
6731         }
6732
6733         my %orderings = (
6734                 project => order_str('path'),
6735                 descr => order_str('descr_long'),
6736                 owner => order_str('owner'),
6737                 age => order_reverse_num_then_undef('age_epoch'),
6738         );
6739
6740         my $ordering = $orderings{$order};
6741         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6742 }
6743
6744 # returns a hash of categories, containing the list of project
6745 # belonging to each category
6746 sub build_projlist_by_category {
6747         my ($projlist, $from, $to) = @_;
6748         my %categories;
6749
6750         $from = 0 unless defined $from;
6751         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6752
6753         for (my $i = $from; $i <= $to; $i++) {
6754                 my $pr = $projlist->[$i];
6755                 push @{$categories{ $pr->{'category'} }}, $pr;
6756         }
6757
6758         return wantarray ? %categories : \%categories;
6759 }
6760
6761 # print 'sort by' <th> element, generating 'sort by $name' replay link
6762 # if that order is not selected
6763 sub print_sort_th {
6764         print format_sort_th(@_);
6765 }
6766
6767 sub format_sort_th {
6768         my ($name, $order, $header) = @_;
6769         my $sort_th = "";
6770         $header ||= ucfirst($name);
6771
6772         if ($order eq $name) {
6773                 $sort_th .= "<th>$header</th>\n";
6774         } else {
6775                 $sort_th .= "<th>" .
6776                             $cgi->a({-href => href(-replay=>1, order=>$name),
6777                                      -class => "header"}, $header) .
6778                             "</th>\n";
6779         }
6780
6781         return $sort_th;
6782 }
6783
6784 sub git_project_list_rows {
6785         my ($projlist, $from, $to, $check_forks) = @_;
6786
6787         $from = 0 unless defined $from;
6788         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6789
6790         my $now = time;
6791         my $alternate = 1;
6792         for (my $i = $from; $i <= $to; $i++) {
6793                 my $pr = $projlist->[$i];
6794
6795                 if ($alternate) {
6796                         print "<tr class=\"dark\">\n";
6797                 } else {
6798                         print "<tr class=\"light\">\n";
6799                 }
6800                 $alternate ^= 1;
6801
6802                 if ($check_forks) {
6803                         print "<td>";
6804                         if ($pr->{'forks'}) {
6805                                 my $nforks = scalar @{$pr->{'forks'}};
6806                                 my $s = $nforks == 1 ? '' : 's';
6807                                 if ($nforks > 0) {
6808                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6809                                                        -title => "$nforks fork$s"}, "+");
6810                                 } else {
6811                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6812                                 }
6813                         }
6814                         print "</td>\n";
6815                 }
6816                 my $path = $pr->{'path'};
6817                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6818                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6819                                         -class => "list"},
6820                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6821                       "</td>\n" .
6822                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6823                                         -class => "list",
6824                                         -title => $pr->{'descr_long'}},
6825                                         $search_regexp
6826                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6827                                                                     $pr->{'descr'}, $search_regexp)
6828                                         : esc_html($pr->{'descr'})) .
6829                       "</td>\n";
6830                 unless ($omit_owner) {
6831                         print "<td><i>" . ($owner_link_hook
6832                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6833                                                     chop_and_escape_str($pr->{'owner'}, 15))
6834                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6835                 }
6836                 unless ($omit_age_column) {
6837                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6838                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6839                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6840                 }
6841                 print"<td class=\"link\">" .
6842                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
6843                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . " | " .
6844                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6845                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6846                       "</td>\n" .
6847                       "</tr>\n";
6848         }
6849 }
6850
6851 sub git_project_list_body {
6852         # actually uses global variable $project
6853         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
6854         my @projects = @$projlist;
6855
6856         my $check_forks = gitweb_check_feature('forks');
6857         my $show_ctags  = gitweb_check_feature('ctags');
6858         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6859         $check_forks = undef
6860                 if ($tagfilter || $search_regexp);
6861
6862         # filtering out forks before filling info allows us to do less work
6863         if ($check_forks) {
6864                 @projects = filter_forks_from_projects_list(\@projects);
6865                 push @projects, { 'path' => "$project_filter.git" }
6866                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
6867         }
6868         # search_projects_list pre-fills required info
6869         @projects = search_projects_list(\@projects,
6870                                          'search_regexp' => $search_regexp,
6871                                          'tagfilter'  => $tagfilter)
6872                 if ($tagfilter || $search_regexp);
6873         # fill the rest
6874         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6875         push @all_fields, 'age_epoch' unless($omit_age_column);
6876         push @all_fields, 'owner' unless($omit_owner);
6877         @projects = fill_project_list_info(\@projects, @all_fields);
6878
6879         $order ||= $default_projects_order;
6880         $from = 0 unless defined $from;
6881         $to = $#projects if (!defined $to || $#projects < $to);
6882
6883         # short circuit
6884         if ($from > $to) {
6885                 print "<center>\n".
6886                       "<b>No such projects found</b><br />\n".
6887                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
6888                       "</center>\n<br />\n";
6889                 return;
6890         }
6891
6892         @projects = sort_projects_list(\@projects, $order);
6893
6894         if ($show_ctags) {
6895                 my $ctags = git_gather_all_ctags(\@projects);
6896                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
6897                 print git_show_project_tagcloud($cloud, 64);
6898         }
6899
6900         print "<table class=\"project_list\">\n";
6901         unless ($no_header) {
6902                 print "<tr>\n";
6903                 if ($check_forks) {
6904                         print "<th></th>\n";
6905                 }
6906                 print_sort_th('project', $order, 'Project');
6907                 print_sort_th('descr', $order, 'Description');
6908                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
6909                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
6910                 print "<th></th>\n" . # for links
6911                       "</tr>\n";
6912         }
6913
6914         if ($projects_list_group_categories) {
6915                 # only display categories with projects in the $from-$to window
6916                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
6917                 my %categories = build_projlist_by_category(\@projects, $from, $to);
6918                 foreach my $cat (sort keys %categories) {
6919                         unless ($cat eq "") {
6920                                 print "<tr>\n";
6921                                 if ($check_forks) {
6922                                         print "<td></td>\n";
6923                                 }
6924                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
6925                                 print "</tr>\n";
6926                         }
6927
6928                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
6929                 }
6930         } else {
6931                 git_project_list_rows(\@projects, $from, $to, $check_forks);
6932         }
6933
6934         if (defined $extra) {
6935                 print "<tr>\n";
6936                 if ($check_forks) {
6937                         print "<td></td>\n";
6938                 }
6939                 print "<td colspan=\"5\">$extra</td>\n" .
6940                       "</tr>\n";
6941         }
6942         print "</table>\n";
6943 }
6944
6945 sub git_log_body {
6946         # uses global variable $project
6947         my ($commitlist, $from, $to, $refs, $extra) = @_;
6948
6949         $from = 0 unless defined $from;
6950         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6951
6952         for (my $i = 0; $i <= $to; $i++) {
6953                 my %co = %{$commitlist->[$i]};
6954                 next if !%co;
6955                 my $commit = $co{'id'};
6956                 my $ref = format_ref_marker($refs, $commit);
6957                 git_print_header_div('commit',
6958                                "<span class=\"age\">$co{'age_string'}</span>" .
6959                                esc_html($co{'title'}),
6960                                $commit, undef, $ref);
6961                 print "<div class=\"title_text\">\n" .
6962                       "<div class=\"log_link\">\n" .
6963                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
6964                       " | " .
6965                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
6966                       " | " .
6967                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
6968                       "<br/>\n" .
6969                       "</div>\n";
6970                       git_print_authorship(\%co, -tag => 'span');
6971                       print "<br/>\n</div>\n";
6972
6973                 print "<div class=\"log_body\">\n";
6974                 git_print_log($co{'comment'}, -final_empty_line=> 1);
6975                 print "</div>\n";
6976         }
6977         if ($extra) {
6978                 print "<div class=\"page_nav\">\n";
6979                 print "$extra\n";
6980                 print "</div>\n";
6981         }
6982 }
6983
6984 sub git_shortlog_body {
6985         # uses global variable $project
6986         my ($commitlist, $from, $to, $refs, $extra) = @_;
6987
6988         $from = 0 unless defined $from;
6989         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6990
6991         print "<table class=\"shortlog\">\n";
6992         my $alternate = 1;
6993         for (my $i = $from; $i <= $to; $i++) {
6994                 my %co = %{$commitlist->[$i]};
6995                 my $commit = $co{'id'};
6996                 my $ref = format_ref_marker($refs, $commit);
6997                 if ($alternate) {
6998                         print "<tr class=\"dark\">\n";
6999                 } else {
7000                         print "<tr class=\"light\">\n";
7001                 }
7002                 $alternate ^= 1;
7003                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
7004                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7005                       format_author_html('td', \%co, 10) . "<td>";
7006                 print format_subject_html($co{'title'}, $co{'title_short'},
7007                                           href(action=>"commit", hash=>$commit), $ref);
7008                 print "</td>\n" .
7009                       "<td class=\"link\">" .
7010                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
7011                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
7012                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7013                 my $snapshot_links = format_snapshot_links($commit);
7014                 if (defined $snapshot_links) {
7015                         print " | " . $snapshot_links;
7016                 }
7017                 print "</td>\n" .
7018                       "</tr>\n";
7019         }
7020         if (defined $extra) {
7021                 print "<tr>\n" .
7022                       "<td colspan=\"4\">$extra</td>\n" .
7023                       "</tr>\n";
7024         }
7025         print "</table>\n";
7026 }
7027
7028 sub git_history_body {
7029         # Warning: assumes constant type (blob or tree) during history
7030         my ($commitlist, $from, $to, $refs, $extra,
7031             $file_name, $file_hash, $ftype) = @_;
7032
7033         $from = 0 unless defined $from;
7034         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7035
7036         print "<table class=\"history\">\n";
7037         my $alternate = 1;
7038         for (my $i = $from; $i <= $to; $i++) {
7039                 my %co = %{$commitlist->[$i]};
7040                 if (!%co) {
7041                         next;
7042                 }
7043                 my $commit = $co{'id'};
7044
7045                 my $ref = format_ref_marker($refs, $commit);
7046
7047                 if ($alternate) {
7048                         print "<tr class=\"dark\">\n";
7049                 } else {
7050                         print "<tr class=\"light\">\n";
7051                 }
7052                 $alternate ^= 1;
7053                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7054         # shortlog:   format_author_html('td', \%co, 10)
7055                       format_author_html('td', \%co, 15, 3) . "<td>";
7056                 # originally git_history used chop_str($co{'title'}, 50)
7057                 print format_subject_html($co{'title'}, $co{'title_short'},
7058                                           href(action=>"commit", hash=>$commit), $ref);
7059                 print "</td>\n" .
7060                       "<td class=\"link\">" .
7061                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
7062                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7063
7064                 if ($ftype eq 'blob') {
7065                         my $blob_current = $file_hash;
7066                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7067                         if (defined $blob_current && defined $blob_parent &&
7068                                         $blob_current ne $blob_parent) {
7069                                 print " | " .
7070                                         $cgi->a({-href => href(action=>"blobdiff",
7071                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7072                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7073                                                                file_name=>$file_name)},
7074                                                 "diff to current");
7075                         }
7076                 }
7077                 print "</td>\n" .
7078                       "</tr>\n";
7079         }
7080         if (defined $extra) {
7081                 print "<tr>\n" .
7082                       "<td colspan=\"4\">$extra</td>\n" .
7083                       "</tr>\n";
7084         }
7085         print "</table>\n";
7086 }
7087
7088 sub git_tags_body {
7089         # uses global variable $project
7090         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7091         $from = 0 unless defined $from;
7092         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7093         $order ||= $default_refs_order;
7094
7095         print "<table class=\"tags\">\n";
7096         if ($full) {
7097                 print "<tr class=\"tags_header\">\n";
7098                 print_sort_th('age', $order, 'Last Change');
7099                 print_sort_th('name', $order, 'Name');
7100                 print "<th></th>\n" . # for comment
7101                       "<th></th>\n" . # for tag
7102                       "<th></th>\n" . # for links
7103                       "</tr>\n";
7104         }
7105         my $alternate = 1;
7106         for (my $i = $from; $i <= $to; $i++) {
7107                 my $entry = $taglist->[$i];
7108                 my %tag = %$entry;
7109                 my $comment = $tag{'subject'};
7110                 my $comment_short;
7111                 if (defined $comment) {
7112                         $comment_short = chop_str($comment, 30, 5);
7113                 }
7114                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7115                 if ($alternate) {
7116                         print "<tr class=\"dark\">\n";
7117                 } else {
7118                         print "<tr class=\"light\">\n";
7119                 }
7120                 $alternate ^= 1;
7121                 if (defined $tag{'age'}) {
7122                         print "<td><i>$tag{'age'}</i></td>\n";
7123                 } else {
7124                         print "<td></td>\n";
7125                 }
7126                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7127                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7128                                -class => "list name"}, esc_html($tag{'name'})) .
7129                       "</td>\n" .
7130                       "<td>");
7131                 if (defined $comment) {
7132                         print format_subject_html($comment, $comment_short,
7133                                                   href(action=>"tag", hash=>$tag{'id'}));
7134                 }
7135                 print "</td>\n" .
7136                       "<td class=\"selflink\">";
7137                 if ($tag{'type'} eq "tag") {
7138                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7139                 } else {
7140                         print "&#160;";
7141                 }
7142                 print "</td>\n" .
7143                       "<td class=\"link\">" . " | " .
7144                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7145                 if ($tag{'reftype'} eq "commit") {
7146                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7147                         print " | " . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7148                 } elsif ($tag{'reftype'} eq "blob") {
7149                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7150                 }
7151                 print "</td>\n" .
7152                       "</tr>";
7153         }
7154         if (defined $extra) {
7155                 print "<tr>\n" .
7156                       "<td colspan=\"5\">$extra</td>\n" .
7157                       "</tr>\n";
7158         }
7159         print "</table>\n";
7160 }
7161
7162 sub git_heads_body {
7163         # uses global variable $project
7164         my ($headlist, $head_at, $from, $to, $extra) = @_;
7165         $from = 0 unless defined $from;
7166         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7167
7168         print "<table class=\"heads\">\n";
7169         my $alternate = 1;
7170         for (my $i = $from; $i <= $to; $i++) {
7171                 my $entry = $headlist->[$i];
7172                 my %ref = %$entry;
7173                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7174                 if ($alternate) {
7175                         print "<tr class=\"dark\">\n";
7176                 } else {
7177                         print "<tr class=\"light\">\n";
7178                 }
7179                 $alternate ^= 1;
7180                 print "<td><i>$ref{'age'}</i></td>\n" .
7181                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7182                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7183                                -class => "list name"},esc_html($ref{'name'})) .
7184                       "</td>\n" .
7185                       "<td class=\"link\">" .
7186                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . " | " .
7187                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7188                       "</td>\n" .
7189                       "</tr>";
7190         }
7191         if (defined $extra) {
7192                 print "<tr>\n" .
7193                       "<td colspan=\"3\">$extra</td>\n" .
7194                       "</tr>\n";
7195         }
7196         print "</table>\n";
7197 }
7198
7199 # Display a single remote block
7200 sub git_remote_block {
7201         my ($remote, $rdata, $limit, $head) = @_;
7202
7203         my $heads = $rdata->{'heads'};
7204         my $fetch = $rdata->{'fetch'};
7205         my $push = $rdata->{'push'};
7206
7207         my $urls_table = "<table class=\"projects_list\">\n" ;
7208
7209         if (defined $fetch) {
7210                 if ($fetch eq $push) {
7211                         $urls_table .= format_repo_url("URL", $fetch);
7212                 } else {
7213                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7214                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7215                 }
7216         } elsif (defined $push) {
7217                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7218         } else {
7219                 $urls_table .= format_repo_url("", "No remote URL");
7220         }
7221
7222         $urls_table .= "</table>\n";
7223
7224         my $dots;
7225         if (defined $limit && $limit < @$heads) {
7226                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7227         }
7228
7229         print $urls_table;
7230         git_heads_body($heads, $head, 0, $limit, $dots);
7231 }
7232
7233 # Display a list of remote names with the respective fetch and push URLs
7234 sub git_remotes_list {
7235         my ($remotedata, $limit) = @_;
7236         print "<table class=\"heads\">\n";
7237         my $alternate = 1;
7238         my @remotes = sort keys %$remotedata;
7239
7240         my $limited = $limit && $limit < @remotes;
7241
7242         $#remotes = $limit - 1 if $limited;
7243
7244         while (my $remote = shift @remotes) {
7245                 my $rdata = $remotedata->{$remote};
7246                 my $fetch = $rdata->{'fetch'};
7247                 my $push = $rdata->{'push'};
7248                 if ($alternate) {
7249                         print "<tr class=\"dark\">\n";
7250                 } else {
7251                         print "<tr class=\"light\">\n";
7252                 }
7253                 $alternate ^= 1;
7254                 print "<td>" .
7255                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7256                                -class=> "list name"},esc_html($remote)) .
7257                       "</td>";
7258                 print "<td class=\"link\">" .
7259                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7260                       " | " .
7261                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7262                       "</td>";
7263
7264                 print "</tr>\n";
7265         }
7266
7267         if ($limited) {
7268                 print "<tr>\n" .
7269                       "<td colspan=\"3\">" .
7270                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7271                       "</td>\n" . "</tr>\n";
7272         }
7273
7274         print "</table>";
7275 }
7276
7277 # Display remote heads grouped by remote, unless there are too many
7278 # remotes, in which case we only display the remote names
7279 sub git_remotes_body {
7280         my ($remotedata, $limit, $head) = @_;
7281         if ($limit and $limit < keys %$remotedata) {
7282                 git_remotes_list($remotedata, $limit);
7283         } else {
7284                 fill_remote_heads($remotedata);
7285                 while (my ($remote, $rdata) = each %$remotedata) {
7286                         git_print_section({-class=>"remote", -id=>$remote},
7287                                 ["remotes", $remote, $remote], sub {
7288                                         git_remote_block($remote, $rdata, $limit, $head);
7289                                 });
7290                 }
7291         }
7292 }
7293
7294 sub git_search_message {
7295         my %co = @_;
7296
7297         my $greptype;
7298         if ($searchtype eq 'commit') {
7299                 $greptype = "--grep=";
7300         } elsif ($searchtype eq 'author') {
7301                 $greptype = "--author=";
7302         } elsif ($searchtype eq 'committer') {
7303                 $greptype = "--committer=";
7304         }
7305         $greptype .= $searchtext;
7306         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7307                                        $greptype, '--regexp-ignore-case',
7308                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7309
7310         my $paging_nav = '';
7311         if ($page > 0) {
7312                 $paging_nav .=
7313                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7314                                 "first") .
7315                         " &#183; " .
7316                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7317                                  -accesskey => "p", -title => "Alt-p"}, "prev");
7318         } else {
7319                 $paging_nav .= "first &#183; prev";
7320         }
7321         my $next_link = '';
7322         if ($#commitlist >= 100) {
7323                 $next_link =
7324                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7325                                  -accesskey => "n", -title => "Alt-n"}, "next");
7326                 $paging_nav .= " &#183; $next_link";
7327         } else {
7328                 $paging_nav .= " &#183; next";
7329         }
7330
7331         git_header_html();
7332
7333         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
7334         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7335         if ($page == 0 && !@commitlist) {
7336                 print "<p>No match.</p>\n";
7337         } else {
7338                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7339         }
7340
7341         git_footer_html();
7342 }
7343
7344 sub git_search_changes {
7345         my %co = @_;
7346
7347         local $/ = "\n";
7348         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7349                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7350                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7351                         or die_error(500, "Open git-log failed");
7352
7353         git_header_html();
7354
7355         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7356         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7357
7358         print "<table class=\"pickaxe search\">\n";
7359         my $alternate = 1;
7360         undef %co;
7361         my @files;
7362         while (my $line = to_utf8(scalar <$fd>)) {
7363                 chomp $line;
7364                 next unless $line;
7365
7366                 my %set = parse_difftree_raw_line($line);
7367                 if (defined $set{'commit'}) {
7368                         # finish previous commit
7369                         if (%co) {
7370                                 print "</td>\n" .
7371                                       "<td class=\"link\">" .
7372                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7373                                               "commit") .
7374                                       " | " .
7375                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7376                                                              hash_base=>$co{'id'})},
7377                                               "tree") .
7378                                       "</td>\n" .
7379                                       "</tr>\n";
7380                         }
7381
7382                         if ($alternate) {
7383                                 print "<tr class=\"dark\">\n";
7384                         } else {
7385                                 print "<tr class=\"light\">\n";
7386                         }
7387                         $alternate ^= 1;
7388                         %co = parse_commit($set{'commit'});
7389                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7390                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7391                               "<td><i>$author</i></td>\n" .
7392                               "<td>" .
7393                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7394                                       -class => "list subject"},
7395                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7396                 } elsif (defined $set{'to_id'}) {
7397                         next if ($set{'to_id'} =~ m/^0{40}$/);
7398
7399                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7400                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7401                                       -class => "list"},
7402                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7403                               "<br/>\n";
7404                 }
7405         }
7406         close $fd;
7407
7408         # finish last commit (warning: repetition!)
7409         if (%co) {
7410                 print "</td>\n" .
7411                       "<td class=\"link\">" .
7412                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7413                               "commit") .
7414                       " | " .
7415                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7416                                              hash_base=>$co{'id'})},
7417                               "tree") .
7418                       "</td>\n" .
7419                       "</tr>\n";
7420         }
7421
7422         print "</table>\n";
7423
7424         git_footer_html();
7425 }
7426
7427 sub git_search_files {
7428         my %co = @_;
7429
7430         local $/ = "\n";
7431         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7432                 $search_use_regexp ? ('-E', '-i') : '-F',
7433                 $searchtext, $co{'tree'})
7434                         or die_error(500, "Open git-grep failed");
7435
7436         git_header_html();
7437
7438         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7439         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7440
7441         print "<table class=\"grep_search\">\n";
7442         my $alternate = 1;
7443         my $matches = 0;
7444         my $lastfile = '';
7445         my $file_href;
7446         while (my $line = to_utf8(scalar <$fd>)) {
7447                 chomp $line;
7448                 my ($file, $lno, $ltext, $binary);
7449                 last if ($matches++ > 1000);
7450                 if ($line =~ /^Binary file (.+) matches$/) {
7451                         $file = $1;
7452                         $binary = 1;
7453                 } else {
7454                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7455                         $file =~ s/^$co{'tree'}://;
7456                 }
7457                 if ($file ne $lastfile) {
7458                         $lastfile and print "</td></tr>\n";
7459                         if ($alternate++) {
7460                                 print "<tr class=\"dark\">\n";
7461                         } else {
7462                                 print "<tr class=\"light\">\n";
7463                         }
7464                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7465                                           file_name=>$file);
7466                         print "<td class=\"list\">".
7467                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7468                         print "</td><td>\n";
7469                         $lastfile = $file;
7470                 }
7471                 if ($binary) {
7472                         print "<div class=\"binary\">Binary file</div>\n";
7473                 } else {
7474                         $ltext = untabify($ltext);
7475                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7476                                 $ltext = esc_html($1, -nbsp=>1);
7477                                 $ltext .= '<span class="match">';
7478                                 $ltext .= esc_html($2, -nbsp=>1);
7479                                 $ltext .= '</span>';
7480                                 $ltext .= esc_html($3, -nbsp=>1);
7481                         } else {
7482                                 $ltext = esc_html($ltext, -nbsp=>1);
7483                         }
7484                         print "<div class=\"pre\">" .
7485                                 $cgi->a({-href => $file_href.'#l'.$lno,
7486                                         -class => "linenr"}, sprintf('%4i', $lno)) .
7487                                 ' ' .  $ltext . "</div>\n";
7488                 }
7489         }
7490         if ($lastfile) {
7491                 print "</td></tr>\n";
7492                 if ($matches > 1000) {
7493                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7494                 }
7495         } else {
7496                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7497         }
7498         close $fd;
7499
7500         print "</table>\n";
7501
7502         git_footer_html();
7503 }
7504
7505 sub git_search_grep_body {
7506         my ($commitlist, $from, $to, $extra) = @_;
7507         $from = 0 unless defined $from;
7508         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7509
7510         print "<table class=\"commit_search\">\n";
7511         my $alternate = 1;
7512         for (my $i = $from; $i <= $to; $i++) {
7513                 my %co = %{$commitlist->[$i]};
7514                 if (!%co) {
7515                         next;
7516                 }
7517                 my $commit = $co{'id'};
7518                 if ($alternate) {
7519                         print "<tr class=\"dark\">\n";
7520                 } else {
7521                         print "<tr class=\"light\">\n";
7522                 }
7523                 $alternate ^= 1;
7524                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7525                       format_author_html('td', \%co, 15, 5) .
7526                       "<td>" .
7527                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7528                                -class => "list subject"},
7529                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7530                 my $comment = $co{'comment'};
7531                 foreach my $line (@$comment) {
7532                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7533                                 my ($lead, $match, $trail) = ($1, $2, $3);
7534                                 $match = chop_str($match, 70, 5, 'center');
7535                                 my $contextlen = int((80 - length($match))/2);
7536                                 $contextlen = 30 if ($contextlen > 30);
7537                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7538                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7539
7540                                 $lead  = esc_html($lead);
7541                                 $match = esc_html($match);
7542                                 $trail = esc_html($trail);
7543
7544                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7545                         }
7546                 }
7547                 print "</td>\n" .
7548                       "<td class=\"link\">" .
7549                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7550                       " | " .
7551                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7552                       " | " .
7553                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7554                 print "</td>\n" .
7555                       "</tr>\n";
7556         }
7557         if (defined $extra) {
7558                 print "<tr>\n" .
7559                       "<td colspan=\"3\">$extra</td>\n" .
7560                       "</tr>\n";
7561         }
7562         print "</table>\n";
7563 }
7564
7565 ## ======================================================================
7566 ## ======================================================================
7567 ## actions
7568
7569 sub git_project_list_load {
7570         my $empty_list_ok = shift;
7571         my $order = $input_params{'order'};
7572         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7573                 die_error(400, "Unknown order parameter");
7574         }
7575
7576         my @list = git_get_projects_list($project_filter, $strict_export);
7577         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7578                 push @list, { 'path' => "$project_filter.git" }
7579                         if is_valid_project("$project_filter.git");
7580         }
7581         if (!@list) {
7582                 die_error(404, "No projects found") unless $empty_list_ok;
7583         }
7584
7585         return (\@list, $order);
7586 }
7587
7588 sub git_frontpage {
7589         my ($projlist, $order);
7590
7591         if ($frontpage_no_project_list) {
7592                 $project = undef;
7593                 $project_filter = undef;
7594         } else {
7595                 ($projlist, $order) = git_project_list_load(1);
7596         }
7597         git_header_html();
7598         if (defined $home_text && -f $home_text) {
7599                 print "<div class=\"index_include\">\n";
7600                 insert_file($home_text);
7601                 print "</div>\n";
7602         }
7603         git_project_search_form($searchtext, $search_use_regexp);
7604         if ($frontpage_no_project_list) {
7605                 my $show_ctags = gitweb_check_feature('ctags');
7606                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7607                         my @projects = git_get_projects_list($project_filter, $strict_export);
7608                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7609                         @projects = fill_project_list_info(\@projects, 'ctags');
7610                         my $ctags = git_gather_all_ctags(\@projects);
7611                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7612                         print git_show_project_tagcloud($cloud, 64);
7613                 }
7614         } else {
7615                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7616         }
7617         git_footer_html();
7618 }
7619
7620 sub git_project_list {
7621         my ($projlist, $order) = git_project_list_load();
7622         git_header_html();
7623         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7624                 print "<div class=\"index_include\">\n";
7625                 insert_file($home_text);
7626                 print "</div>\n";
7627         }
7628         git_project_search_form();
7629         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7630         git_footer_html();
7631 }
7632
7633 sub git_forks {
7634         my $order = $input_params{'order'};
7635         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7636                 die_error(400, "Unknown order parameter");
7637         }
7638
7639         my $filter = $project;
7640         $filter =~ s/\.git$//;
7641         my @list = git_get_projects_list($filter);
7642         if (!@list) {
7643                 die_error(404, "No forks found");
7644         }
7645
7646         git_header_html();
7647         git_print_page_nav('','');
7648         git_print_header_div('summary', "$project forks");
7649         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7650         git_footer_html();
7651 }
7652
7653 sub git_project_index {
7654         my @projects = git_get_projects_list($project_filter, $strict_export);
7655         if (!@projects) {
7656                 die_error(404, "No projects found");
7657         }
7658
7659         print $cgi->header(
7660                 -type => 'text/plain',
7661                 -charset => 'utf-8',
7662                 -content_disposition => 'inline; filename="index.aux"');
7663
7664         foreach my $pr (@projects) {
7665                 if (!exists $pr->{'owner'}) {
7666                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7667                 }
7668
7669                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7670                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7671                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7672                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7673                 $path  =~ s/ /\+/g;
7674                 $owner =~ s/ /\+/g;
7675
7676                 print "$path $owner\n";
7677         }
7678 }
7679
7680 sub git_summary {
7681         my $descr = git_get_project_description($project) || "none";
7682         my %co = parse_commit("HEAD");
7683         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7684         my $head = $co{'id'};
7685         my $remote_heads = gitweb_check_feature('remote_heads');
7686
7687         my $owner = git_get_project_owner($project);
7688         my $homepage = git_get_project_config('homepage');
7689         my $base_url = git_get_project_config('baseurl');
7690
7691         my $refs = git_get_references();
7692         # These get_*_list functions return one more to allow us to see if
7693         # there are more ...
7694         my @taglist  = git_get_tags_list(16);
7695         my @headlist = git_get_heads_list(16);
7696         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7697         my @forklist;
7698         my $check_forks = gitweb_check_feature('forks');
7699
7700         if ($check_forks) {
7701                 # find forks of a project
7702                 my $filter = $project;
7703                 $filter =~ s/\.git$//;
7704                 @forklist = git_get_projects_list($filter);
7705                 # filter out forks of forks
7706                 @forklist = filter_forks_from_projects_list(\@forklist)
7707                         if (@forklist);
7708         }
7709
7710         git_header_html();
7711         git_print_page_nav('summary','', $head);
7712
7713         if ($check_forks and $project =~ m#/#) {
7714                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7715                 my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7716                 print <<EOT;
7717 <div class="forkinfo">
7718 This project is a fork of the $r project. If you have that one
7719 already cloned locally, you can use
7720 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7721 to save bandwidth during cloning.
7722 </div>
7723 EOT
7724         }
7725
7726         print "<div class=\"title\">&#160;</div>\n";
7727         print "<table class=\"projects_list\">\n" .
7728               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7729         if ($homepage) {
7730                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7731         }
7732         if ($base_url) {
7733                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7734         }
7735         if ($owner and not $omit_owner) {
7736                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7737                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7738                         : email_obfuscate($owner)) . "</td></tr>\n";
7739         }
7740         if (defined $cd{'rfc2822'}) {
7741                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7742                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7743         }
7744         print format_lastrefresh_row(), "\n";
7745
7746         # use per project git URL list in $projectroot/$project/cloneurl
7747         # or make project git URL from git base URL and project name
7748         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7749         my @url_list = git_get_project_url_list($project);
7750         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7751         foreach my $git_url (@url_list) {
7752                 next unless $git_url;
7753                 print format_repo_url($url_tag, $git_url);
7754                 $url_tag = "";
7755         }
7756         @url_list = map { "$_/$project" } @git_base_push_urls;
7757         if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7758             -f "$projectroot/$project/.nofetch") {
7759                 $url_tag = "push&#160;URL";
7760                 foreach my $git_push_url (@url_list) {
7761                         next unless $git_push_url;
7762                         my $hint = $https_hint_html && $git_push_url =~ /^https:/i ?
7763                                 "&#160;$https_hint_html" : '';
7764                         print "<tr class=\"metadata_pushurl\"><td>$url_tag</td><td>$git_push_url$hint</td></tr>\n";
7765                         $url_tag = "";
7766                 }
7767         }
7768
7769         if (defined($git_base_bundles_url) && -d "$projectroot/$project/bundles") {
7770                 my $projname = $project;
7771                 $projname =~ s|^.*/||;
7772                 my $url = "$git_base_bundles_url/$project/bundles";
7773                 print format_repo_url(
7774                         "bundle&#160;info",
7775                         "<a rel='nofollow' href='$url'>$projname downloadable bundles</a>");
7776         }
7777
7778         # Tag cloud
7779         my $show_ctags = gitweb_check_feature('ctags');
7780         if ($show_ctags) {
7781                 my $ctags = git_get_project_ctags($project);
7782                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7783                         # without ability to add tags, don't show if there are none
7784                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7785                         print "<tr id=\"metadata_ctags\">" .
7786                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7787                         print "</td>\n<td>" unless %$ctags;
7788                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7789                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7790                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7791                               unless $show_ctags =~ /^\d+$/;
7792                         print "</td>\n<td>" if %$ctags;
7793                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7794                               "</tr>\n";
7795                 }
7796         }
7797
7798         print "</table>\n";
7799
7800         # If XSS prevention is on, we don't include README.html.
7801         # TODO: Allow a readme in some safe format.
7802         if (!$prevent_xss && -s "$projectroot/$project/README.html") {
7803                 print "<div class=\"title\">readme</div>\n" .
7804                       "<div class=\"readme\">\n";
7805                 insert_file("$projectroot/$project/README.html");
7806                 print "\n</div>\n"; # class="readme"
7807         }
7808
7809         # we need to request one more than 16 (0..15) to check if
7810         # those 16 are all
7811         my @commitlist = $head ? parse_commits($head, 17) : ();
7812         if (@commitlist) {
7813                 git_print_header_div('shortlog');
7814                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7815                                   $#commitlist <=  15 ? undef :
7816                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7817         }
7818
7819         if (@taglist) {
7820                 git_print_header_div('tags');
7821                 git_tags_body(\@taglist, 0, 15,
7822                               $#taglist <=  15 ? undef :
7823                               $cgi->a({-href => href(action=>"tags")}, "..."));
7824         }
7825
7826         if (@headlist) {
7827                 git_print_header_div('heads');
7828                 git_heads_body(\@headlist, $head, 0, 15,
7829                                $#headlist <= 15 ? undef :
7830                                $cgi->a({-href => href(action=>"heads")}, "..."));
7831         }
7832
7833         if (%remotedata) {
7834                 git_print_header_div('remotes');
7835                 git_remotes_body(\%remotedata, 15, $head);
7836         }
7837
7838         if (@forklist) {
7839                 git_print_header_div('forks');
7840                 git_project_list_body(\@forklist, 'age', 0, 15,
7841                                       $#forklist <= 15 ? undef :
7842                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7843                                       'no_header', 'forks');
7844         }
7845
7846         git_footer_html();
7847 }
7848
7849 sub git_tag {
7850         my %tag = parse_tag($hash);
7851
7852         if (! %tag) {
7853                 die_error(404, "Unknown tag object");
7854         }
7855
7856         my $fullhash;
7857         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
7858         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
7859
7860         my $head = git_get_head_hash($project);
7861         git_header_html();
7862         git_print_page_nav('','', $head,undef,$head);
7863         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
7864         print "<div class=\"title_text\">\n" .
7865               "<table class=\"object_header\">\n" .
7866               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
7867               "<tr>\n" .
7868               "<td>object</td>\n" .
7869               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7870                                $tag{'object'}) . "</td>\n" .
7871               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7872                                               $tag{'type'}) . "</td>\n" .
7873               "</tr>\n";
7874         if (defined($tag{'author'})) {
7875                 git_print_authorship_rows(\%tag, 'author');
7876         }
7877         print "</table>\n\n" .
7878               "</div>\n";
7879         print "<div class=\"page_body\">";
7880         my $comment = $tag{'comment'};
7881         foreach my $line (@$comment) {
7882                 chomp $line;
7883                 print esc_html($line, -nbsp=>1) . "<br/>\n";
7884         }
7885         print "</div>\n";
7886         git_footer_html();
7887 }
7888
7889 sub git_blame_common {
7890         my $format = shift || 'porcelain';
7891         if ($format eq 'porcelain' && $input_params{'javascript'}) {
7892                 $format = 'incremental';
7893                 $action = 'blame_incremental'; # for page title etc
7894         }
7895
7896         # permissions
7897         gitweb_check_feature('blame')
7898                 or die_error(403, "Blame view not allowed");
7899
7900         # error checking
7901         die_error(400, "No file name given") unless $file_name;
7902         $hash_base ||= git_get_head_hash($project);
7903         die_error(404, "Couldn't find base commit") unless $hash_base;
7904         my %co = parse_commit($hash_base)
7905                 or die_error(404, "Commit not found");
7906         my $ftype = "blob";
7907         if (!defined $hash) {
7908                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
7909                         or die_error(404, "Error looking up file");
7910         } else {
7911                 $ftype = git_get_type($hash);
7912                 if ($ftype !~ "blob") {
7913                         die_error(400, "Object is not a blob");
7914                 }
7915         }
7916
7917         my $fd;
7918         if ($format eq 'incremental') {
7919                 # get file contents (as base)
7920                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
7921                         or die_error(500, "Open git-cat-file failed");
7922         } elsif ($format eq 'data') {
7923                 # run git-blame --incremental
7924                 defined($fd = git_cmd_pipe "blame", "--incremental",
7925                         $hash_base, "--", $file_name)
7926                         or die_error(500, "Open git-blame --incremental failed");
7927         } else {
7928                 # run git-blame --porcelain
7929                 defined($fd = git_cmd_pipe "blame", '-p',
7930                         $hash_base, '--', $file_name)
7931                         or die_error(500, "Open git-blame --porcelain failed");
7932         }
7933
7934         # incremental blame data returns early
7935         if ($format eq 'data') {
7936                 print $cgi->header(
7937                         -type=>"text/plain", -charset => "utf-8",
7938                         -status=> "200 OK");
7939                 local $| = 1; # output autoflush
7940                 while (<$fd>) {
7941                         print to_utf8($_);
7942                 }
7943                 close $fd
7944                         or print "ERROR $!\n";
7945
7946                 print 'END';
7947                 if (defined $t0 && gitweb_check_feature('timed')) {
7948                         print ' '.
7949                               tv_interval($t0, [ gettimeofday() ]).
7950                               ' '.$number_of_git_cmds;
7951                 }
7952                 print "\n";
7953
7954                 return;
7955         }
7956
7957         # page header
7958         git_header_html();
7959         my $formats_nav =
7960                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
7961                         "blob");
7962         $formats_nav .=
7963                 " | " .
7964                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7965                         "history") .
7966                 " | " .
7967                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
7968                         "HEAD");
7969         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7970         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7971         git_print_page_path($file_name, $ftype, $hash_base);
7972
7973         # page body
7974         if ($format eq 'incremental') {
7975                 print "<noscript>\n<div class=\"error\"><center><b>\n".
7976                       "This page requires JavaScript to run.\n Use ".
7977                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
7978                               'this page').
7979                       " instead.\n".
7980                       "</b></center></div>\n</noscript>\n";
7981
7982                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
7983         }
7984
7985         print qq!<div class="page_body">\n!;
7986         print qq!<div id="progress_info">... / ...</div>\n!
7987                 if ($format eq 'incremental');
7988         print qq!<table id="blame_table" class="blame" width="100%">\n!.
7989               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
7990               qq!<thead>\n!.
7991               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
7992               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
7993               qq!title="toggles blame author information display">[+]</a></th>!.
7994               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
7995               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
7996               qq!</thead>\n!.
7997               qq!<tbody>\n!;
7998
7999         my @rev_color = qw(light dark);
8000         my $num_colors = scalar(@rev_color);
8001         my $current_color = 0;
8002
8003         if ($format eq 'incremental') {
8004                 my $color_class = $rev_color[$current_color];
8005
8006                 #contents of a file
8007                 my $linenr = 0;
8008         LINE:
8009                 while (my $line = to_utf8(scalar <$fd>)) {
8010                         chomp $line;
8011                         $linenr++;
8012
8013                         print qq!<tr id="l$linenr" class="$color_class">!.
8014                               qq!<td class="sha1"><a href=""> </a></td>!.
8015                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8016                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8017                               qq!<td class="linenr">!.
8018                               qq!<a class="linenr" href="">$linenr</a></td>!;
8019                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8020                         print qq!</tr>\n!;
8021                 }
8022
8023         } else { # porcelain, i.e. ordinary blame
8024                 my %metainfo = (); # saves information about commits
8025
8026                 # blame data
8027         LINE:
8028                 while (my $line = to_utf8(scalar <$fd>)) {
8029                         chomp $line;
8030                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8031                         # no <lines in group> for subsequent lines in group of lines
8032                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8033                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8034                         if (!exists $metainfo{$full_rev}) {
8035                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8036                         }
8037                         my $meta = $metainfo{$full_rev};
8038                         my $data;
8039                         while ($data = to_utf8(scalar <$fd>)) {
8040                                 chomp $data;
8041                                 last if ($data =~ s/^\t//); # contents of line
8042                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8043                                         $meta->{$1} = $2 unless exists $meta->{$1};
8044                                 }
8045                                 if ($data =~ /^previous /) {
8046                                         $meta->{'nprevious'}++;
8047                                 }
8048                         }
8049                         my $short_rev = substr($full_rev, 0, 8);
8050                         my $author = $meta->{'author'};
8051                         my %date =
8052                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8053                         my $date = $date{'iso-tz'};
8054                         if ($group_size) {
8055                                 $current_color = ($current_color + 1) % $num_colors;
8056                         }
8057                         my $tr_class = $rev_color[$current_color];
8058                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8059                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8060                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8061                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8062                         if ($group_size) {
8063                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8064                                 print "<td class=\"sha1\"";
8065                                 print " title=\"". esc_html($author) . ", $date\"";
8066                                 print "$rowspan>";
8067                                 print $cgi->a({-href => href(action=>"commit",
8068                                                              hash=>$full_rev,
8069                                                              file_name=>$file_name)},
8070                                               esc_html($short_rev));
8071                                 if ($group_size >= 2) {
8072                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8073                                         if (@author_initials) {
8074                                                 print "<br />" .
8075                                                       esc_html(join('', @author_initials));
8076                                                 #           or join('.', ...)
8077                                         }
8078                                 }
8079                                 print "</td>\n";
8080                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8081                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8082                         }
8083                         # 'previous' <sha1 of parent commit> <filename at commit>
8084                         if (exists $meta->{'previous'} &&
8085                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8086                                 $meta->{'parent'} = $1;
8087                                 $meta->{'file_parent'} = unquote($2);
8088                         }
8089                         my $linenr_commit =
8090                                 exists($meta->{'parent'}) ?
8091                                 $meta->{'parent'} : $full_rev;
8092                         my $linenr_filename =
8093                                 exists($meta->{'file_parent'}) ?
8094                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8095                         my $blamed = href(action => 'blame',
8096                                           file_name => $linenr_filename,
8097                                           hash_base => $linenr_commit);
8098                         print "<td class=\"linenr\">";
8099                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8100                                         -class => "linenr" },
8101                                       esc_html($lineno));
8102                         print "</td>";
8103                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8104                         print "</tr>\n";
8105                 } # end while
8106
8107         }
8108
8109         # footer
8110         print "</tbody>\n".
8111               "</table>\n"; # class="blame"
8112         print "</div>\n";   # class="blame_body"
8113         close $fd
8114                 or print "Reading blob failed\n";
8115
8116         git_footer_html();
8117 }
8118
8119 sub git_blame {
8120         git_blame_common();
8121 }
8122
8123 sub git_blame_incremental {
8124         git_blame_common('incremental');
8125 }
8126
8127 sub git_blame_data {
8128         git_blame_common('data');
8129 }
8130
8131 sub git_tags {
8132         my $head = git_get_head_hash($project);
8133         git_header_html();
8134         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8135         git_print_header_div('summary', $project);
8136
8137         my @tagslist = git_get_tags_list();
8138         if (@tagslist) {
8139                 git_tags_body(\@tagslist);
8140         }
8141         git_footer_html();
8142 }
8143
8144 sub git_refs {
8145         my $order = $input_params{'order'};
8146         if (defined $order && $order !~ m/age|name/) {
8147                 die_error(400, "Unknown order parameter");
8148         }
8149
8150         my $head = git_get_head_hash($project);
8151         git_header_html();
8152         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8153         git_print_header_div('summary', $project);
8154
8155         my @refslist = git_get_tags_list(undef, 1, $order);
8156         if (@refslist) {
8157                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8158         }
8159         git_footer_html();
8160 }
8161
8162 sub git_heads {
8163         my $head = git_get_head_hash($project);
8164         git_header_html();
8165         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8166         git_print_header_div('summary', $project);
8167
8168         my @headslist = git_get_heads_list();
8169         if (@headslist) {
8170                 git_heads_body(\@headslist, $head);
8171         }
8172         git_footer_html();
8173 }
8174
8175 # used both for single remote view and for list of all the remotes
8176 sub git_remotes {
8177         gitweb_check_feature('remote_heads')
8178                 or die_error(403, "Remote heads view is disabled");
8179
8180         my $head = git_get_head_hash($project);
8181         my $remote = $input_params{'hash'};
8182
8183         my $remotedata = git_get_remotes_list($remote);
8184         die_error(500, "Unable to get remote information") unless defined $remotedata;
8185
8186         unless (%$remotedata) {
8187                 die_error(404, defined $remote ?
8188                         "Remote $remote not found" :
8189                         "No remotes found");
8190         }
8191
8192         git_header_html(undef, undef, -action_extra => $remote);
8193         git_print_page_nav('', '',  $head, undef, $head,
8194                 format_ref_views($remote ? '' : 'remotes'));
8195
8196         fill_remote_heads($remotedata);
8197         if (defined $remote) {
8198                 git_print_header_div('remotes', "$remote remote for $project");
8199                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8200         } else {
8201                 git_print_header_div('summary', "$project remotes");
8202                 git_remotes_body($remotedata, undef, $head);
8203         }
8204
8205         git_footer_html();
8206 }
8207
8208 sub git_blob_plain {
8209         my $type = shift;
8210         my $expires;
8211
8212         if (!defined $hash) {
8213                 if (defined $file_name) {
8214                         my $base = $hash_base || git_get_head_hash($project);
8215                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8216                                 or die_error(404, "Cannot find file");
8217                 } else {
8218                         die_error(400, "No file name defined");
8219                 }
8220         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8221                 # blobs defined by non-textual hash id's can be cached
8222                 $expires = "+1d";
8223         }
8224
8225         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8226                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8227         binmode($fd);
8228
8229         # content-type (can include charset)
8230         my $leader;
8231         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8232
8233         # "save as" filename, even when no $file_name is given
8234         my $save_as = "$hash";
8235         if (defined $file_name) {
8236                 $save_as = $file_name;
8237         } elsif ($type =~ m/^text\//) {
8238                 $save_as .= '.txt';
8239         }
8240
8241         # With XSS prevention on, blobs of all types except a few known safe
8242         # ones are served with "Content-Disposition: attachment" to make sure
8243         # they don't run in our security domain.  For certain image types,
8244         # blob view writes an <img> tag referring to blob_plain view, and we
8245         # want to be sure not to break that by serving the image as an
8246         # attachment (though Firefox 3 doesn't seem to care).
8247         my $sandbox = $prevent_xss &&
8248                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8249
8250         # serve text/* as text/plain
8251         if ($prevent_xss &&
8252             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8253              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8254                 my $rest = $1;
8255                 $rest = defined $rest ? $rest : '';
8256                 $type = "text/plain$rest";
8257         }
8258
8259         print $cgi->header(
8260                 -type => $type,
8261                 -expires => $expires,
8262                 -content_disposition =>
8263                         ($sandbox ? 'attachment' : 'inline')
8264                         . '; filename="' . $save_as . '"');
8265         binmode STDOUT, ':raw';
8266         $fcgi_raw_mode = 1;
8267         print $leader if defined $leader;
8268         my $buf;
8269         while (read($fd, $buf, 32768)) {
8270                 print $buf;
8271         }
8272         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8273         $fcgi_raw_mode = 0;
8274         close $fd;
8275 }
8276
8277 sub git_blob {
8278         my $expires;
8279
8280         my $fullhash;
8281         if (!defined $hash) {
8282                 if (defined $file_name) {
8283                         my $base = $hash_base || git_get_head_hash($project);
8284                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8285                                 or die_error(404, "Cannot find file");
8286                         $fullhash = $hash;
8287                 } else {
8288                         die_error(400, "No file name defined");
8289                 }
8290         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8291                 # blobs defined by non-textual hash id's can be cached
8292                 $expires = "+1d";
8293                 $fullhash = $hash;
8294         }
8295         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8296
8297         my $have_blame = gitweb_check_feature('blame');
8298         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8299                 or die_error(500, "Couldn't cat $file_name, $hash");
8300         binmode($fd);
8301         my $mimetype = blob_mimetype($fd, $file_name);
8302         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8303         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8304                 close $fd;
8305                 return git_blob_plain($mimetype);
8306         }
8307         # we can have blame only for text/* mimetype
8308         $have_blame &&= ($mimetype =~ m!^text/!);
8309
8310         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8311         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8312         my $highlight_mode_active;
8313         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8314
8315         git_header_html(undef, $expires);
8316         my $formats_nav = '';
8317         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8318                 if (defined $file_name) {
8319                         if ($have_blame) {
8320                                 $formats_nav .=
8321                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8322                                                 -class => "blamelink"},
8323                                                 "blame") .
8324                                         " | ";
8325                         }
8326                         $formats_nav .=
8327                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8328                                         "history") .
8329                                 " | " .
8330                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8331                                         "raw") .
8332                                 " | " .
8333                                 $cgi->a({-href => href(action=>"blob",
8334                                                        hash_base=>"HEAD", file_name=>$file_name)},
8335                                         "HEAD");
8336                 } else {
8337                         $formats_nav .=
8338                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8339                                         "raw");
8340                 }
8341                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8342                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8343         } else {
8344                 print "<div class=\"page_nav\">\n" .
8345                       "<br/><br/></div>\n" .
8346                       "<div class=\"title\">".esc_html($hash)."</div>\n";
8347         }
8348         git_print_page_path($file_name, "blob", $hash_base);
8349         print "<div class=\"title_text\">\n" .
8350               "<table class=\"object_header\">\n";
8351         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8352         print "</table>".
8353               "</div>\n";
8354         print "<div class=\"page_body\">\n";
8355         if ($mimetype =~ m!^image/!) {
8356                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8357                 if ($file_name) {
8358                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8359                 }
8360                 print qq! src="! .
8361                       href(action=>"blob_plain", hash=>$hash,
8362                            hash_base=>$hash_base, file_name=>$file_name) .
8363                       qq!" />\n!;
8364         } else {
8365                 my $nr;
8366                 while (my $line = to_utf8(scalar <$fd>)) {
8367                         chomp $line;
8368                         $nr++;
8369                         $line = untabify($line);
8370                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
8371                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8372                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8373                 }
8374         }
8375         close $fd
8376                 or print "Reading blob failed.\n";
8377         print "</div>";
8378         git_footer_html();
8379 }
8380
8381 sub git_tree {
8382         my $fullhash;
8383         if (!defined $hash_base) {
8384                 $hash_base = "HEAD";
8385         }
8386         if (!defined $hash) {
8387                 if (defined $file_name) {
8388                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8389                         $fullhash = $hash;
8390                 } else {
8391                         $hash = $hash_base;
8392                 }
8393         }
8394         die_error(404, "No such tree") unless defined($hash);
8395         $fullhash = $hash if !$fullhash && $hash =~ m/^[0-9a-fA-F]{40}$/;
8396         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8397
8398         my $show_sizes = gitweb_check_feature('show-sizes');
8399         my $have_blame = gitweb_check_feature('blame');
8400
8401         my @entries = ();
8402         {
8403                 local $/ = "\0";
8404                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8405                         ($show_sizes ? '-l' : ()), @extra_options, $hash)
8406                         or die_error(500, "Open git-ls-tree failed");
8407                 @entries = map { chomp; to_utf8($_) } <$fd>;
8408                 close $fd
8409                         or die_error(404, "Reading tree failed");
8410         }
8411
8412         git_header_html();
8413         my $basedir = '';
8414         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8415                 my $refs = git_get_references();
8416                 my $ref = format_ref_marker($refs, $co{'id'});
8417                 my @views_nav = ();
8418                 if (defined $file_name) {
8419                         push @views_nav,
8420                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8421                                         "history"),
8422                                 $cgi->a({-href => href(action=>"tree",
8423                                                        hash_base=>"HEAD", file_name=>$file_name)},
8424                                         "HEAD"),
8425                 }
8426                 my $snapshot_links = format_snapshot_links($hash);
8427                 if (defined $snapshot_links) {
8428                         # FIXME: Should be available when we have no hash base as well.
8429                         push @views_nav, $snapshot_links;
8430                 }
8431                 git_print_page_nav('tree','', $hash_base, undef, undef,
8432                                    join(' | ', @views_nav));
8433                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8434         } else {
8435                 undef $hash_base;
8436                 print "<div class=\"page_nav\">\n";
8437                 print "<br/><br/></div>\n";
8438                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8439         }
8440         if (defined $file_name) {
8441                 $basedir = $file_name;
8442                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8443                         $basedir .= '/';
8444                 }
8445                 git_print_page_path($file_name, 'tree', $hash_base);
8446         }
8447         print "<div class=\"title_text\">\n" .
8448               "<table class=\"object_header\">\n";
8449         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8450         print "</table>".
8451               "</div>\n";
8452         print "<div class=\"page_body\">\n";
8453         print "<table class=\"tree\">\n";
8454         my $alternate = 1;
8455         # '..' (top directory) link if possible
8456         if (defined $hash_base &&
8457             defined $file_name && $file_name =~ m![^/]+$!) {
8458                 if ($alternate) {
8459                         print "<tr class=\"dark\">\n";
8460                 } else {
8461                         print "<tr class=\"light\">\n";
8462                 }
8463                 $alternate ^= 1;
8464
8465                 my $up = $file_name;
8466                 $up =~ s!/?[^/]+$!!;
8467                 undef $up unless $up;
8468                 # based on git_print_tree_entry
8469                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8470                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8471                 print '<td class="list">';
8472                 print $cgi->a({-href => href(action=>"tree",
8473                                              hash_base=>$hash_base,
8474                                              file_name=>$up)},
8475                               "..");
8476                 print "</td>\n";
8477                 print "<td class=\"link\"></td>\n";
8478
8479                 print "</tr>\n";
8480         }
8481         foreach my $line (@entries) {
8482                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8483
8484                 if ($alternate) {
8485                         print "<tr class=\"dark\">\n";
8486                 } else {
8487                         print "<tr class=\"light\">\n";
8488                 }
8489                 $alternate ^= 1;
8490
8491                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8492
8493                 print "</tr>\n";
8494         }
8495         print "</table>\n" .
8496               "</div>";
8497         git_footer_html();
8498 }
8499
8500 sub sanitize_for_filename {
8501     my $name = shift;
8502
8503     $name =~ s!/!-!g;
8504     $name =~ s/[^[:alnum:]_.-]//g;
8505
8506     return $name;
8507 }
8508
8509 sub snapshot_name {
8510         my ($project, $hash) = @_;
8511
8512         # path/to/project.git  -> project
8513         # path/to/project/.git -> project
8514         my $name = to_utf8($project);
8515         $name =~ s,([^/])/*\.git$,$1,;
8516         $name = sanitize_for_filename(basename($name));
8517
8518         my $ver = $hash;
8519         if ($hash =~ /^[0-9a-fA-F]+$/) {
8520                 # shorten SHA-1 hash
8521                 my $full_hash = git_get_full_hash($project, $hash);
8522                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8523                         $ver = git_get_short_hash($project, $hash);
8524                 }
8525         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8526                 # tags don't need shortened SHA-1 hash
8527                 $ver = $1;
8528         } else {
8529                 # branches and other need shortened SHA-1 hash
8530                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8531                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8532                         my $ref_dir = (defined $1) ? $1 : '';
8533                         $ver = $2;
8534
8535                         $ref_dir = sanitize_for_filename($ref_dir);
8536                         # for refs neither in heads nor remotes we want to
8537                         # add a ref dir to archive name
8538                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8539                                 $ver = $ref_dir . '-' . $ver;
8540                         }
8541                 }
8542                 $ver .= '-' . git_get_short_hash($project, $hash);
8543         }
8544         # special case of sanitization for filename - we change
8545         # slashes to dots instead of dashes
8546         # in case of hierarchical branch names
8547         $ver =~ s!/!.!g;
8548         $ver =~ s/[^[:alnum:]_.-]//g;
8549
8550         # name = project-version_string
8551         $name = "$name-$ver";
8552
8553         return wantarray ? ($name, $name) : $name;
8554 }
8555
8556 sub exit_if_unmodified_since {
8557         my ($latest_epoch) = @_;
8558         our $cgi;
8559
8560         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8561         if (defined $if_modified) {
8562                 my $since;
8563                 if (eval { require HTTP::Date; 1; }) {
8564                         $since = HTTP::Date::str2time($if_modified);
8565                 } elsif (eval { require Time::ParseDate; 1; }) {
8566                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8567                 }
8568                 if (defined $since && $latest_epoch <= $since) {
8569                         my %latest_date = parse_date($latest_epoch);
8570                         print $cgi->header(
8571                                 -last_modified => $latest_date{'rfc2822'},
8572                                 -status => '304 Not Modified');
8573                         goto DONE_GITWEB;
8574                 }
8575         }
8576 }
8577
8578 sub git_snapshot {
8579         my $format = $input_params{'snapshot_format'};
8580         if (!@snapshot_fmts) {
8581                 die_error(403, "Snapshots not allowed");
8582         }
8583         # default to first supported snapshot format
8584         $format ||= $snapshot_fmts[0];
8585         if ($format !~ m/^[a-z0-9]+$/) {
8586                 die_error(400, "Invalid snapshot format parameter");
8587         } elsif (!exists($known_snapshot_formats{$format})) {
8588                 die_error(400, "Unknown snapshot format");
8589         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8590                 die_error(403, "Snapshot format not allowed");
8591         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8592                 die_error(403, "Unsupported snapshot format");
8593         }
8594
8595         my $type = git_get_type("$hash^{}");
8596         if (!$type) {
8597                 die_error(404, 'Object does not exist');
8598         }  elsif ($type eq 'blob') {
8599                 die_error(400, 'Object is not a tree-ish');
8600         }
8601
8602         my ($name, $prefix) = snapshot_name($project, $hash);
8603         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8604
8605         my %co = parse_commit($hash);
8606         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8607
8608         my @cmd = (
8609                 git_cmd(), 'archive',
8610                 "--format=$known_snapshot_formats{$format}{'format'}",
8611                 "--prefix=$prefix/", $hash);
8612         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8613                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8614                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8615         }
8616
8617         $filename =~ s/(["\\])/\\$1/g;
8618         my %latest_date;
8619         if (%co) {
8620                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8621         }
8622
8623         print $cgi->header(
8624                 -type => $known_snapshot_formats{$format}{'type'},
8625                 -content_disposition => 'inline; filename="' . $filename . '"',
8626                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8627                 -status => '200 OK');
8628
8629         defined(my $fd = cmd_pipe @cmd)
8630                 or die_error(500, "Execute git-archive failed");
8631         binmode($fd);
8632         binmode STDOUT, ':raw';
8633         $fcgi_raw_mode = 1;
8634         my $buf;
8635         while (read($fd, $buf, 32768)) {
8636                 print $buf;
8637         }
8638         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8639         $fcgi_raw_mode = 0;
8640         close $fd;
8641 }
8642
8643 sub git_log_generic {
8644         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8645
8646         my $head = git_get_head_hash($project);
8647         if (!defined $base) {
8648                 $base = $head;
8649         }
8650         if (!defined $page) {
8651                 $page = 0;
8652         }
8653         my $refs = git_get_references();
8654
8655         my $commit_hash = $base;
8656         if (defined $parent) {
8657                 $commit_hash = "$parent..$base";
8658         }
8659         my @commitlist =
8660                 parse_commits($commit_hash, 101, (100 * $page),
8661                               defined $file_name ? ($file_name, "--full-history") : ());
8662
8663         my $ftype;
8664         if (!defined $file_hash && defined $file_name) {
8665                 # some commits could have deleted file in question,
8666                 # and not have it in tree, but one of them has to have it
8667                 for (my $i = 0; $i < @commitlist; $i++) {
8668                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8669                         last if defined $file_hash;
8670                 }
8671         }
8672         if (defined $file_hash) {
8673                 $ftype = git_get_type($file_hash);
8674         }
8675         if (defined $file_name && !defined $ftype) {
8676                 die_error(500, "Unknown type of object");
8677         }
8678         my %co;
8679         if (defined $file_name) {
8680                 %co = parse_commit($base)
8681                         or die_error(404, "Unknown commit object");
8682         }
8683
8684
8685         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100);
8686         my $next_link = '';
8687         if ($#commitlist >= 100) {
8688                 $next_link =
8689                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8690                                  -accesskey => "n", -title => "Alt-n"}, "next");
8691         }
8692         my ($patch_max) = gitweb_get_feature('patches');
8693         if ($patch_max && !defined $file_name) {
8694                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8695                         $paging_nav .= " &#183; " .
8696                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
8697                                         "patches");
8698                 }
8699         }
8700
8701         {
8702                 local $action = 'fulllog';
8703                 git_header_html();
8704         }
8705         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8706         if (defined $file_name) {
8707                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8708         } else {
8709                 git_print_header_div('summary', $project)
8710         }
8711         git_print_page_path($file_name, $ftype, $hash_base)
8712                 if (defined $file_name);
8713
8714         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8715                      $file_name, $file_hash, $ftype);
8716
8717         git_footer_html();
8718 }
8719
8720 sub git_log {
8721         git_log_generic('log', \&git_log_body,
8722                         $hash, $hash_parent);
8723 }
8724
8725 sub git_commit {
8726         $hash ||= $hash_base || "HEAD";
8727         my %co = parse_commit($hash)
8728             or die_error(404, "Unknown commit object");
8729
8730         my $parent  = $co{'parent'};
8731         my $parents = $co{'parents'}; # listref
8732
8733         # we need to prepare $formats_nav before any parameter munging
8734         my $formats_nav;
8735         if (!defined $parent) {
8736                 # --root commitdiff
8737                 $formats_nav .= '(initial)';
8738         } elsif (@$parents == 1) {
8739                 # single parent commit
8740                 $formats_nav .=
8741                         '(parent: ' .
8742                         $cgi->a({-href => href(action=>"commit",
8743                                                hash=>$parent)},
8744                                 esc_html(substr($parent, 0, 7))) .
8745                         ')';
8746         } else {
8747                 # merge commit
8748                 $formats_nav .=
8749                         '(merge: ' .
8750                         join(' ', map {
8751                                 $cgi->a({-href => href(action=>"commit",
8752                                                        hash=>$_)},
8753                                         esc_html(substr($_, 0, 7)));
8754                         } @$parents ) .
8755                         ')';
8756         }
8757         if (gitweb_check_feature('patches') && @$parents <= 1) {
8758                 $formats_nav .= " | " .
8759                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8760                                 "patch");
8761         }
8762
8763         if (!defined $parent) {
8764                 $parent = "--root";
8765         }
8766         my @difftree;
8767         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8768                 @diff_opts,
8769                 (@$parents <= 1 ? $parent : '-c'),
8770                 $hash, "--")
8771                 or die_error(500, "Open git-diff-tree failed");
8772         @difftree = map { chomp; to_utf8($_) } <$fd>;
8773         close $fd or die_error(404, "Reading git-diff-tree failed");
8774
8775         # non-textual hash id's can be cached
8776         my $expires;
8777         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8778                 $expires = "+1d";
8779         }
8780         my $refs = git_get_references();
8781         my $ref = format_ref_marker($refs, $co{'id'});
8782
8783         git_header_html(undef, $expires);
8784         git_print_page_nav('commit', '',
8785                            $hash, $co{'tree'}, $hash,
8786                            $formats_nav);
8787
8788         if (defined $co{'parent'}) {
8789                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
8790         } else {
8791                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
8792         }
8793         print "<div class=\"title_text\">\n" .
8794               "<table class=\"object_header\">\n";
8795         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8796         git_print_authorship_rows(\%co);
8797         print "<tr>" .
8798               "<td>tree</td>" .
8799               "<td class=\"sha1\">" .
8800               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8801                        class => "list"}, $co{'tree'}) .
8802               "</td>" .
8803               "<td class=\"link\">" .
8804               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8805                       "tree");
8806         my $snapshot_links = format_snapshot_links($hash);
8807         if (defined $snapshot_links) {
8808                 print " | " . $snapshot_links;
8809         }
8810         print "</td>" .
8811               "</tr>\n";
8812
8813         foreach my $par (@$parents) {
8814                 print "<tr>" .
8815                       "<td>parent</td>" .
8816                       "<td class=\"sha1\">" .
8817                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8818                                class => "list"}, $par) .
8819                       "</td>" .
8820                       "<td class=\"link\">" .
8821                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8822                       " | " .
8823                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8824                       "</td>" .
8825                       "</tr>\n";
8826         }
8827         print "</table>".
8828               "</div>\n";
8829
8830         print "<div class=\"page_body\">\n";
8831         git_print_log($co{'comment'});
8832         print "</div>\n";
8833
8834         git_difftree_body(\@difftree, $hash, @$parents);
8835
8836         git_footer_html();
8837 }
8838
8839 sub git_object {
8840         # object is defined by:
8841         # - hash or hash_base alone
8842         # - hash_base and file_name
8843         my $type;
8844
8845         # - hash or hash_base alone
8846         if ($hash || ($hash_base && !defined $file_name)) {
8847                 my $object_id = $hash || $hash_base;
8848
8849                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8850                         or die_error(404, "Object does not exist");
8851                 $type = <$fd>;
8852                 chomp $type;
8853                 close $fd
8854                         or die_error(404, "Object does not exist");
8855
8856         # - hash_base and file_name
8857         } elsif ($hash_base && defined $file_name) {
8858                 $file_name =~ s,/+$,,;
8859
8860                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
8861                         or die_error(404, "Base object does not exist");
8862
8863                 # here errors should not happen
8864                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
8865                         or die_error(500, "Open git-ls-tree failed");
8866                 my $line = to_utf8(scalar <$fd>);
8867                 close $fd;
8868
8869                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
8870                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
8871                         die_error(404, "File or directory for given base does not exist");
8872                 }
8873                 $type = $2;
8874                 $hash = $3;
8875         } else {
8876                 die_error(400, "Not enough information to find object");
8877         }
8878
8879         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
8880                                           hash=>$hash, hash_base=>$hash_base,
8881                                           file_name=>$file_name),
8882                              -status => '302 Found');
8883 }
8884
8885 sub git_blobdiff {
8886         my $format = shift || 'html';
8887         my $diff_style = $input_params{'diff_style'} || 'inline';
8888
8889         my $fd;
8890         my @difftree;
8891         my %diffinfo;
8892         my $expires;
8893
8894         # preparing $fd and %diffinfo for git_patchset_body
8895         # new style URI
8896         if (defined $hash_base && defined $hash_parent_base) {
8897                 if (defined $file_name) {
8898                         # read raw output
8899                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8900                                 $hash_parent_base, $hash_base,
8901                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
8902                                 or die_error(500, "Open git-diff-tree failed");
8903                         @difftree = map { chomp; to_utf8($_) } <$fd>;
8904                         close $fd
8905                                 or die_error(404, "Reading git-diff-tree failed");
8906                         @difftree
8907                                 or die_error(404, "Blob diff not found");
8908
8909                 } elsif (defined $hash &&
8910                          $hash =~ /[0-9a-fA-F]{40}/) {
8911                         # try to find filename from $hash
8912
8913                         # read filtered raw output
8914                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8915                                 $hash_parent_base, $hash_base, "--")
8916                                 or die_error(500, "Open git-diff-tree failed");
8917                         @difftree =
8918                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
8919                                 # $hash == to_id
8920                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
8921                                 map { chomp; to_utf8($_) } <$fd>;
8922                         close $fd
8923                                 or die_error(404, "Reading git-diff-tree failed");
8924                         @difftree
8925                                 or die_error(404, "Blob diff not found");
8926
8927                 } else {
8928                         die_error(400, "Missing one of the blob diff parameters");
8929                 }
8930
8931                 if (@difftree > 1) {
8932                         die_error(400, "Ambiguous blob diff specification");
8933                 }
8934
8935                 %diffinfo = parse_difftree_raw_line($difftree[0]);
8936                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
8937                 $file_name   ||= $diffinfo{'to_file'};
8938
8939                 $hash_parent ||= $diffinfo{'from_id'};
8940                 $hash        ||= $diffinfo{'to_id'};
8941
8942                 # non-textual hash id's can be cached
8943                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
8944                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
8945                         $expires = '+1d';
8946                 }
8947
8948                 # open patch output
8949                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8950                         '-p', ($format eq 'html' ? "--full-index" : ()),
8951                         $hash_parent_base, $hash_base,
8952                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
8953                         or die_error(500, "Open git-diff-tree failed");
8954         }
8955
8956         # old/legacy style URI -- not generated anymore since 1.4.3.
8957         if (!%diffinfo) {
8958                 die_error('404 Not Found', "Missing one of the blob diff parameters")
8959         }
8960
8961         # header
8962         if ($format eq 'html') {
8963                 my $formats_nav =
8964                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
8965                                 "raw");
8966                 $formats_nav .= diff_style_nav($diff_style);
8967                 git_header_html(undef, $expires);
8968                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8969                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8970                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8971                 } else {
8972                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
8973                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
8974                 }
8975                 if (defined $file_name) {
8976                         git_print_page_path($file_name, "blob", $hash_base);
8977                 } else {
8978                         print "<div class=\"page_path\"></div>\n";
8979                 }
8980
8981         } elsif ($format eq 'plain') {
8982                 print $cgi->header(
8983                         -type => 'text/plain',
8984                         -charset => 'utf-8',
8985                         -expires => $expires,
8986                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
8987
8988                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8989
8990         } else {
8991                 die_error(400, "Unknown blobdiff format");
8992         }
8993
8994         # patch
8995         if ($format eq 'html') {
8996                 print "<div class=\"page_body\">\n";
8997
8998                 git_patchset_body($fd, $diff_style,
8999                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
9000                 close $fd;
9001
9002                 print "</div>\n"; # class="page_body"
9003                 git_footer_html();
9004
9005         } else {
9006                 while (my $line = to_utf8(scalar <$fd>)) {
9007                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
9008                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
9009
9010                         print $line;
9011
9012                         last if $line =~ m!^\+\+\+!;
9013                 }
9014                 while (<$fd>) {
9015                         print to_utf8($_);
9016                 }
9017                 close $fd;
9018         }
9019 }
9020
9021 sub git_blobdiff_plain {
9022         git_blobdiff('plain');
9023 }
9024
9025 # assumes that it is added as later part of already existing navigation,
9026 # so it returns "| foo | bar" rather than just "foo | bar"
9027 sub diff_style_nav {
9028         my ($diff_style, $is_combined) = @_;
9029         $diff_style ||= 'inline';
9030
9031         return "" if ($is_combined);
9032
9033         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
9034         my %styles = @styles;
9035         @styles =
9036                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9037
9038         return join '',
9039                 map { " | ".$_ }
9040                 map {
9041                         $_ eq $diff_style ? $styles{$_} :
9042                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
9043                 } @styles;
9044 }
9045
9046 sub git_commitdiff {
9047         my %params = @_;
9048         my $format = $params{-format} || 'html';
9049         my $diff_style = $input_params{'diff_style'} || 'inline';
9050
9051         my ($patch_max) = gitweb_get_feature('patches');
9052         if ($format eq 'patch') {
9053                 die_error(403, "Patch view not allowed") unless $patch_max;
9054         }
9055
9056         $hash ||= $hash_base || "HEAD";
9057         my %co = parse_commit($hash)
9058             or die_error(404, "Unknown commit object");
9059
9060         # choose format for commitdiff for merge
9061         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9062                 $hash_parent = '--cc';
9063         }
9064         # we need to prepare $formats_nav before almost any parameter munging
9065         my $formats_nav;
9066         if ($format eq 'html') {
9067                 $formats_nav =
9068                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9069                                 "raw");
9070                 if ($patch_max && @{$co{'parents'}} <= 1) {
9071                         $formats_nav .= " | " .
9072                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9073                                         "patch");
9074                 }
9075                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9076
9077                 if (defined $hash_parent &&
9078                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9079                         # commitdiff with two commits given
9080                         my $hash_parent_short = $hash_parent;
9081                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9082                                 $hash_parent_short = substr($hash_parent, 0, 7);
9083                         }
9084                         $formats_nav .=
9085                                 ' (from';
9086                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9087                                 if ($co{'parents'}[$i] eq $hash_parent) {
9088                                         $formats_nav .= ' parent ' . ($i+1);
9089                                         last;
9090                                 }
9091                         }
9092                         $formats_nav .= ': ' .
9093                                 $cgi->a({-href => href(-replay=>1,
9094                                                        hash=>$hash_parent, hash_base=>undef)},
9095                                         esc_html($hash_parent_short)) .
9096                                 ')';
9097                 } elsif (!$co{'parent'}) {
9098                         # --root commitdiff
9099                         $formats_nav .= ' (initial)';
9100                 } elsif (scalar @{$co{'parents'}} == 1) {
9101                         # single parent commit
9102                         $formats_nav .=
9103                                 ' (parent: ' .
9104                                 $cgi->a({-href => href(-replay=>1,
9105                                                        hash=>$co{'parent'}, hash_base=>undef)},
9106                                         esc_html(substr($co{'parent'}, 0, 7))) .
9107                                 ')';
9108                 } else {
9109                         # merge commit
9110                         if ($hash_parent eq '--cc') {
9111                                 $formats_nav .= ' | ' .
9112                                         $cgi->a({-href => href(-replay=>1,
9113                                                                hash=>$hash, hash_parent=>'-c')},
9114                                                 'combined');
9115                         } else { # $hash_parent eq '-c'
9116                                 $formats_nav .= ' | ' .
9117                                         $cgi->a({-href => href(-replay=>1,
9118                                                                hash=>$hash, hash_parent=>'--cc')},
9119                                                 'compact');
9120                         }
9121                         $formats_nav .=
9122                                 ' (merge: ' .
9123                                 join(' ', map {
9124                                         $cgi->a({-href => href(-replay=>1,
9125                                                                hash=>$_, hash_base=>undef)},
9126                                                 esc_html(substr($_, 0, 7)));
9127                                 } @{$co{'parents'}} ) .
9128                                 ')';
9129                 }
9130         }
9131
9132         my $hash_parent_param = $hash_parent;
9133         if (!defined $hash_parent_param) {
9134                 # --cc for multiple parents, --root for parentless
9135                 $hash_parent_param =
9136                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9137         }
9138
9139         # read commitdiff
9140         my $fd;
9141         my @difftree;
9142         if ($format eq 'html') {
9143                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9144                         "--no-commit-id", "--patch-with-raw", "--full-index",
9145                         $hash_parent_param, $hash, "--")
9146                         or die_error(500, "Open git-diff-tree failed");
9147
9148                 while (my $line = to_utf8(scalar <$fd>)) {
9149                         chomp $line;
9150                         # empty line ends raw part of diff-tree output
9151                         last unless $line;
9152                         push @difftree, scalar parse_difftree_raw_line($line);
9153                 }
9154
9155         } elsif ($format eq 'plain') {
9156                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9157                         '-p', $hash_parent_param, $hash, "--")
9158                         or die_error(500, "Open git-diff-tree failed");
9159         } elsif ($format eq 'patch') {
9160                 # For commit ranges, we limit the output to the number of
9161                 # patches specified in the 'patches' feature.
9162                 # For single commits, we limit the output to a single patch,
9163                 # diverging from the git-format-patch default.
9164                 my @commit_spec = ();
9165                 if ($hash_parent) {
9166                         if ($patch_max > 0) {
9167                                 push @commit_spec, "-$patch_max";
9168                         }
9169                         push @commit_spec, '-n', "$hash_parent..$hash";
9170                 } else {
9171                         if ($params{-single}) {
9172                                 push @commit_spec, '-1';
9173                         } else {
9174                                 if ($patch_max > 0) {
9175                                         push @commit_spec, "-$patch_max";
9176                                 }
9177                                 push @commit_spec, "-n";
9178                         }
9179                         push @commit_spec, '--root', $hash;
9180                 }
9181                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9182                         '--encoding=utf8', '--stdout', @commit_spec)
9183                         or die_error(500, "Open git-format-patch failed");
9184         } else {
9185                 die_error(400, "Unknown commitdiff format");
9186         }
9187
9188         # non-textual hash id's can be cached
9189         my $expires;
9190         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9191                 $expires = "+1d";
9192         }
9193
9194         # write commit message
9195         if ($format eq 'html') {
9196                 my $refs = git_get_references();
9197                 my $ref = format_ref_marker($refs, $co{'id'});
9198
9199                 git_header_html(undef, $expires);
9200                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9201                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9202                 print "<div class=\"title_text\">\n" .
9203                       "<table class=\"object_header\">\n";
9204                 git_print_authorship_rows(\%co);
9205                 print "</table>".
9206                       "</div>\n";
9207                 print "<div class=\"page_body\">\n";
9208                 if (@{$co{'comment'}} > 1) {
9209                         print "<div class=\"log\">\n";
9210                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9211                         print "</div>\n"; # class="log"
9212                 }
9213
9214         } elsif ($format eq 'plain') {
9215                 my $refs = git_get_references("tags");
9216                 my $tagname = git_get_rev_name_tags($hash);
9217                 my $filename = basename($project) . "-$hash.patch";
9218
9219                 print $cgi->header(
9220                         -type => 'text/plain',
9221                         -charset => 'utf-8',
9222                         -expires => $expires,
9223                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9224                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9225                 print "From: " . to_utf8($co{'author'}) . "\n";
9226                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9227                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9228
9229                 print "X-Git-Tag: $tagname\n" if $tagname;
9230                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9231
9232                 foreach my $line (@{$co{'comment'}}) {
9233                         print to_utf8($line) . "\n";
9234                 }
9235                 print "---\n\n";
9236         } elsif ($format eq 'patch') {
9237                 my $filename = basename($project) . "-$hash.patch";
9238
9239                 print $cgi->header(
9240                         -type => 'text/plain',
9241                         -charset => 'utf-8',
9242                         -expires => $expires,
9243                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9244         }
9245
9246         # write patch
9247         if ($format eq 'html') {
9248                 my $use_parents = !defined $hash_parent ||
9249                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9250                 git_difftree_body(\@difftree, $hash,
9251                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9252                 print "<br/>\n";
9253
9254                 git_patchset_body($fd, $diff_style,
9255                                   \@difftree, $hash,
9256                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9257                 close $fd;
9258                 print "</div>\n"; # class="page_body"
9259                 git_footer_html();
9260
9261         } elsif ($format eq 'plain') {
9262                 while (<$fd>) {
9263                         print to_utf8($_);
9264                 }
9265                 close $fd
9266                         or print "Reading git-diff-tree failed\n";
9267         } elsif ($format eq 'patch') {
9268                 while (<$fd>) {
9269                         print to_utf8($_);
9270                 }
9271                 close $fd
9272                         or print "Reading git-format-patch failed\n";
9273         }
9274 }
9275
9276 sub git_commitdiff_plain {
9277         git_commitdiff(-format => 'plain');
9278 }
9279
9280 # format-patch-style patches
9281 sub git_patch {
9282         git_commitdiff(-format => 'patch', -single => 1);
9283 }
9284
9285 sub git_patches {
9286         git_commitdiff(-format => 'patch');
9287 }
9288
9289 sub git_history {
9290         git_log_generic('history', \&git_history_body,
9291                         $hash_base, $hash_parent_base,
9292                         $file_name, $hash);
9293 }
9294
9295 sub git_search {
9296         $searchtype ||= 'commit';
9297
9298         # check if appropriate features are enabled
9299         gitweb_check_feature('search')
9300                 or die_error(403, "Search is disabled");
9301         if ($searchtype eq 'pickaxe') {
9302                 # pickaxe may take all resources of your box and run for several minutes
9303                 # with every query - so decide by yourself how public you make this feature
9304                 gitweb_check_feature('pickaxe')
9305                         or die_error(403, "Pickaxe search is disabled");
9306         }
9307         if ($searchtype eq 'grep') {
9308                 # grep search might be potentially CPU-intensive, too
9309                 gitweb_check_feature('grep')
9310                         or die_error(403, "Grep search is disabled");
9311         }
9312
9313         if (!defined $searchtext) {
9314                 die_error(400, "Text field is empty");
9315         }
9316         if (!defined $hash) {
9317                 $hash = git_get_head_hash($project);
9318         }
9319         my %co = parse_commit($hash);
9320         if (!%co) {
9321                 die_error(404, "Unknown commit object");
9322         }
9323         if (!defined $page) {
9324                 $page = 0;
9325         }
9326
9327         if ($searchtype eq 'commit' ||
9328             $searchtype eq 'author' ||
9329             $searchtype eq 'committer') {
9330                 git_search_message(%co);
9331         } elsif ($searchtype eq 'pickaxe') {
9332                 git_search_changes(%co);
9333         } elsif ($searchtype eq 'grep') {
9334                 git_search_files(%co);
9335         } else {
9336                 die_error(400, "Unknown search type");
9337         }
9338 }
9339
9340 sub git_search_help {
9341         git_header_html();
9342         git_print_page_nav('','', $hash,$hash,$hash);
9343         print <<EOT;
9344 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9345 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9346 the pattern entered is recognized as the POSIX extended
9347 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9348 insensitive).</p>
9349 <dl>
9350 <dt><b>commit</b></dt>
9351 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9352 EOT
9353         my $have_grep = gitweb_check_feature('grep');
9354         if ($have_grep) {
9355                 print <<EOT;
9356 <dt><b>grep</b></dt>
9357 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9358     a different one) are searched for the given pattern. On large trees, this search can take
9359 a while and put some strain on the server, so please use it with some consideration. Note that
9360 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9361 case-sensitive.</dd>
9362 EOT
9363         }
9364         print <<EOT;
9365 <dt><b>author</b></dt>
9366 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9367 <dt><b>committer</b></dt>
9368 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9369 EOT
9370         my $have_pickaxe = gitweb_check_feature('pickaxe');
9371         if ($have_pickaxe) {
9372                 print <<EOT;
9373 <dt><b>pickaxe</b></dt>
9374 <dd>All commits that caused the string to appear or disappear from any file (changes that
9375 added, removed or "modified" the string) will be listed. This search can take a while and
9376 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9377 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9378 EOT
9379         }
9380         print "</dl>\n";
9381         git_footer_html();
9382 }
9383
9384 sub git_shortlog {
9385         git_log_generic('shortlog', \&git_shortlog_body,
9386                         $hash, $hash_parent);
9387 }
9388
9389 ## ......................................................................
9390 ## feeds (RSS, Atom; OPML)
9391
9392 sub git_feed {
9393         my $format = shift || 'atom';
9394         my $have_blame = gitweb_check_feature('blame');
9395
9396         # Atom: http://www.atomenabled.org/developers/syndication/
9397         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9398         if ($format ne 'rss' && $format ne 'atom') {
9399                 die_error(400, "Unknown web feed format");
9400         }
9401
9402         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9403         my $head = $hash || 'HEAD';
9404         my @commitlist = parse_commits($head, 150, 0, $file_name);
9405
9406         my %latest_commit;
9407         my %latest_date;
9408         my $content_type = "application/$format+xml";
9409         if (defined $cgi->http('HTTP_ACCEPT') &&
9410                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9411                 # browser (feed reader) prefers text/xml
9412                 $content_type = 'text/xml';
9413         }
9414         if (defined($commitlist[0])) {
9415                 %latest_commit = %{$commitlist[0]};
9416                 my $latest_epoch = $latest_commit{'committer_epoch'};
9417                 exit_if_unmodified_since($latest_epoch);
9418                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9419         }
9420         print $cgi->header(
9421                 -type => $content_type,
9422                 -charset => 'utf-8',
9423                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9424                 -status => '200 OK');
9425
9426         # Optimization: skip generating the body if client asks only
9427         # for Last-Modified date.
9428         return if ($cgi->request_method() eq 'HEAD');
9429
9430         # header variables
9431         my $title = "$site_name - $project/$action";
9432         my $feed_type = 'log';
9433         if (defined $hash) {
9434                 $title .= " - '$hash'";
9435                 $feed_type = 'branch log';
9436                 if (defined $file_name) {
9437                         $title .= " :: $file_name";
9438                         $feed_type = 'history';
9439                 }
9440         } elsif (defined $file_name) {
9441                 $title .= " - $file_name";
9442                 $feed_type = 'history';
9443         }
9444         $title .= " $feed_type";
9445         $title = esc_html($title);
9446         my $descr = git_get_project_description($project);
9447         if (defined $descr) {
9448                 $descr = esc_html($descr);
9449         } else {
9450                 $descr = "$project " .
9451                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9452                          " feed";
9453         }
9454         my $owner = git_get_project_owner($project);
9455         $owner = esc_html($owner);
9456
9457         #header
9458         my $alt_url;
9459         if (defined $file_name) {
9460                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9461         } elsif (defined $hash) {
9462                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9463         } else {
9464                 $alt_url = href(-full=>1, action=>"summary");
9465         }
9466         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9467         if ($format eq 'rss') {
9468                 print <<XML;
9469 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9470 <channel>
9471 XML
9472                 print "<title>$title</title>\n" .
9473                       "<link>$alt_url</link>\n" .
9474                       "<description>$descr</description>\n" .
9475                       "<language>en</language>\n" .
9476                       # project owner is responsible for 'editorial' content
9477                       "<managingEditor>$owner</managingEditor>\n";
9478                 if (defined $logo || defined $favicon) {
9479                         # prefer the logo to the favicon, since RSS
9480                         # doesn't allow both
9481                         my $img = esc_url($logo || $favicon);
9482                         print "<image>\n" .
9483                               "<url>$img</url>\n" .
9484                               "<title>$title</title>\n" .
9485                               "<link>$alt_url</link>\n" .
9486                               "</image>\n";
9487                 }
9488                 if (%latest_date) {
9489                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9490                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9491                 }
9492                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9493         } elsif ($format eq 'atom') {
9494                 print <<XML;
9495 <feed xmlns="http://www.w3.org/2005/Atom">
9496 XML
9497                 print "<title>$title</title>\n" .
9498                       "<subtitle>$descr</subtitle>\n" .
9499                       '<link rel="alternate" type="text/html" href="' .
9500                       $alt_url . '" />' . "\n" .
9501                       '<link rel="self" type="' . $content_type . '" href="' .
9502                       $cgi->self_url() . '" />' . "\n" .
9503                       "<id>" . href(-full=>1) . "</id>\n" .
9504                       # use project owner for feed author
9505                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9506                 if (defined $favicon) {
9507                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9508                 }
9509                 if (defined $logo) {
9510                         # not twice as wide as tall: 72 x 27 pixels
9511                         print "<logo>" . esc_url($logo) . "</logo>\n";
9512                 }
9513                 if (! %latest_date) {
9514                         # dummy date to keep the feed valid until commits trickle in:
9515                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9516                 } else {
9517                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9518                 }
9519                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9520         }
9521
9522         # contents
9523         for (my $i = 0; $i <= $#commitlist; $i++) {
9524                 my %co = %{$commitlist[$i]};
9525                 my $commit = $co{'id'};
9526                 # we read 150, we always show 30 and the ones more recent than 48 hours
9527                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9528                         last;
9529                 }
9530                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9531
9532                 # get list of changed files
9533                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9534                         $co{'parent'} || "--root",
9535                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9536                         or next;
9537                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9538                 close $fd
9539                         or next;
9540
9541                 # print element (entry, item)
9542                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9543                 if ($format eq 'rss') {
9544                         print "<item>\n" .
9545                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9546                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9547                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9548                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9549                               "<link>$co_url</link>\n" .
9550                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9551                               "<content:encoded>" .
9552                               "<![CDATA[\n";
9553                 } elsif ($format eq 'atom') {
9554                         print "<entry>\n" .
9555                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9556                               "<updated>$cd{'iso-8601'}</updated>\n" .
9557                               "<author>\n" .
9558                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9559                         if ($co{'author_email'}) {
9560                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9561                         }
9562                         print "</author>\n" .
9563                               # use committer for contributor
9564                               "<contributor>\n" .
9565                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9566                         if ($co{'committer_email'}) {
9567                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9568                         }
9569                         print "</contributor>\n" .
9570                               "<published>$cd{'iso-8601'}</published>\n" .
9571                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9572                               "<id>$co_url</id>\n" .
9573                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9574                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9575                 }
9576                 my $comment = $co{'comment'};
9577                 print "<pre>\n";
9578                 foreach my $line (@$comment) {
9579                         $line = esc_html($line);
9580                         print "$line\n";
9581                 }
9582                 print "</pre><ul>\n";
9583                 foreach my $difftree_line (@difftree) {
9584                         my %difftree = parse_difftree_raw_line($difftree_line);
9585                         next if !$difftree{'from_id'};
9586
9587                         my $file = $difftree{'file'} || $difftree{'to_file'};
9588
9589                         print "<li>" .
9590                               "[" .
9591                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9592                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9593                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9594                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9595                                       -title => "diff"}, 'D');
9596                         if ($have_blame) {
9597                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9598                                                              file_name=>$file, hash_base=>$commit),
9599                                               -class => "blamelink",
9600                                               -title => "blame"}, 'B');
9601                         }
9602                         # if this is not a feed of a file history
9603                         if (!defined $file_name || $file_name ne $file) {
9604                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9605                                                              file_name=>$file, hash=>$commit),
9606                                               -title => "history"}, 'H');
9607                         }
9608                         $file = esc_path($file);
9609                         print "] ".
9610                               "$file</li>\n";
9611                 }
9612                 if ($format eq 'rss') {
9613                         print "</ul>]]>\n" .
9614                               "</content:encoded>\n" .
9615                               "</item>\n";
9616                 } elsif ($format eq 'atom') {
9617                         print "</ul>\n</div>\n" .
9618                               "</content>\n" .
9619                               "</entry>\n";
9620                 }
9621         }
9622
9623         # end of feed
9624         if ($format eq 'rss') {
9625                 print "</channel>\n</rss>\n";
9626         } elsif ($format eq 'atom') {
9627                 print "</feed>\n";
9628         }
9629 }
9630
9631 sub git_rss {
9632         git_feed('rss');
9633 }
9634
9635 sub git_atom {
9636         git_feed('atom');
9637 }
9638
9639 sub git_opml {
9640         my @list = git_get_projects_list($project_filter, $strict_export);
9641         if (!@list) {
9642                 die_error(404, "No projects found");
9643         }
9644
9645         print $cgi->header(
9646                 -type => 'text/xml',
9647                 -charset => 'utf-8',
9648                 -content_disposition => 'inline; filename="opml.xml"');
9649
9650         my $title = esc_html($site_name);
9651         my $filter = " within subdirectory ";
9652         if (defined $project_filter) {
9653                 $filter .= esc_html($project_filter);
9654         } else {
9655                 $filter = "";
9656         }
9657         print <<XML;
9658 <?xml version="1.0" encoding="utf-8"?>
9659 <opml version="1.0">
9660 <head>
9661   <title>$title OPML Export$filter</title>
9662 </head>
9663 <body>
9664 <outline text="git RSS feeds">
9665 XML
9666
9667         foreach my $pr (@list) {
9668                 my %proj = %$pr;
9669                 my $head = git_get_head_hash($proj{'path'});
9670                 if (!defined $head) {
9671                         next;
9672                 }
9673                 $git_dir = "$projectroot/$proj{'path'}";
9674                 my %co = parse_commit($head);
9675                 if (!%co) {
9676                         next;
9677                 }
9678
9679                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9680                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9681                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9682                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9683         }
9684         print <<XML;
9685 </outline>
9686 </body>
9687 </opml>
9688 XML
9689 }