gitweb/gitweb.perl

   1 #!/usr/bin/perl
   2
   3 # gitweb - simple web interface to track changes in git repositories
   4 #
   5 # (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
   6 # (C) 2005, Christian Gierke
   7 #
   8 # This program is licensed under the GPLv2
   9
  10 use 5.008;
  11 use strict;
  12 use warnings;
  13 use CGI qw(:standard :escapeHTML -nosticky);
  14 use CGI::Util qw(unescape);
  15 use CGI::Carp qw(fatalsToBrowser set_message);
  16 use Encode;
  17 use Fcntl ':mode';
  18 use File::Find qw();
  19 use File::Basename qw(basename);
  20 use File::Spec;
  21 use Time::HiRes qw(gettimeofday tv_interval);
  22 use Time::Local;
  23 use constant GITWEB_CACHE_FORMAT => "Gitweb Cache Format 3";
  24 binmode STDOUT, ':utf8';
  25
  26 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
  27         eval 'sub CGI::multi_param { CGI::param(@_) }'
  28 }
  29
  30 our $t0 = [ gettimeofday() ];
  31 our $number_of_git_cmds = 0;
  32
  33 BEGIN {
  34         CGI->compile() if $ENV{'MOD_PERL'};
  35 }
  36
  37 our $version = "++GIT_VERSION++";
  38
  39 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  40 sub evaluate_uri {
  41         our $cgi;
  42
  43         our $my_url = $cgi->url();
  44         our $my_uri = $cgi->url(-absolute => 1);
  45
  46         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  47         # needed and used only for URLs with nonempty PATH_INFO
  48         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  49         our $base_url = $my_uri || '/';
  50
  51         # When the script is used as DirectoryIndex, the URL does not contain the name
  52         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  53         # have to do it ourselves. We make $path_info global because it's also used
  54         # later on.
  55         #
  56         # Another issue with the script being the DirectoryIndex is that the resulting
  57         # $my_url data is not the full script URL: this is good, because we want
  58         # generated links to keep implying the script name if it wasn't explicitly
  59         # indicated in the URL we're handling, but it means that $my_url cannot be used
  60         # as base URL.
  61         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  62         # to build the base URL ourselves:
  63         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  64         if ($path_info) {
  65                 # $path_info has already been URL-decoded by the web server, but
  66                 # $my_url and $my_uri have not. URL-decode them so we can properly
  67                 # strip $path_info.
  68                 $my_url = unescape($my_url);
  69                 $my_uri = unescape($my_uri);
  70                 if ($my_url =~ s,\Q$path_info\E$,, &&
  71                     $my_uri =~ s,\Q$path_info\E$,, &&
  72                     defined $ENV{'SCRIPT_NAME'}) {
  73                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  74                 }
  75         }
  76
  77         # target of the home link on top of all pages
  78         our $home_link = $my_uri || "/";
  79 }
  80
  81 # core git executable to use
  82 # this can just be "git" if your webserver has a sensible PATH
  83 our $GIT = "++GIT_BINDIR++/git";
  84
  85 # absolute fs-path which will be prepended to the project path
  86 #our $projectroot = "/pub/scm";
  87 our $projectroot = "++GITWEB_PROJECTROOT++";
  88
  89 # fs traversing limit for getting project list
  90 # the number is relative to the projectroot
  91 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  92
  93 # string of the home link on top of all pages
  94 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  95
  96 # extra breadcrumbs preceding the home link
  97 our @extra_breadcrumbs = ();
  98
  99 # name of your site or organization to appear in page titles
 100 # replace this with something more descriptive for clearer bookmarks
 101 our $site_name = "++GITWEB_SITENAME++"
 102                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 103
 104 # html snippet to include in the <head> section of each page
 105 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 106 # filename of html text to include at top of each page
 107 our $site_header = "++GITWEB_SITE_HEADER++";
 108 # html text to include at home page
 109 our $home_text = "++GITWEB_HOMETEXT++";
 110 # filename of html text to include at bottom of each page
 111 our $site_footer = "++GITWEB_SITE_FOOTER++";
 112
 113 # URI of stylesheets
 114 our @stylesheets = ("++GITWEB_CSS++");
 115 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 116 our $stylesheet = undef;
 117 # URI of GIT logo (72x27 size)
 118 our $logo = "++GITWEB_LOGO++";
 119 # URI of GIT favicon, assumed to be image/png type
 120 our $favicon = "++GITWEB_FAVICON++";
 121 # URI of gitweb.js (JavaScript code for gitweb)
 122 our $javascript = "++GITWEB_JS++";
 123
 124 # URI and label (title) of GIT logo link
 125 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 126 #our $logo_label = "git documentation";
 127 our $logo_url = "http://git-scm.com/";
 128 our $logo_label = "git homepage";
 129
 130 # source of projects list
 131 our $projects_list = "++GITWEB_LIST++";
 132
 133 # the width (in characters) of the projects list "Description" column
 134 our $projects_list_description_width = 25;
 135
 136 # group projects by category on the projects list
 137 # (enabled if this variable evaluates to true)
 138 our $projects_list_group_categories = 0;
 139
 140 # default category if none specified
 141 # (leave the empty string for no category)
 142 our $project_list_default_category = "";
 143
 144 # default order of projects list
 145 # valid values are none, project, descr, owner, and age
 146 our $default_projects_order = "project";
 147
 148 # default order of refs list
 149 # valid values are age and name
 150 our $default_refs_order = "age";
 151
 152 # show repository only if this file exists
 153 # (only effective if this variable evaluates to true)
 154 our $export_ok = "++GITWEB_EXPORT_OK++";
 155
 156 # don't generate age column on the projects list page
 157 our $omit_age_column = 0;
 158
 159 # use contents of this file (in iso, iso-strict or raw format) as
 160 # the last activity data if it exists and is a valid date
 161 our $lastactivity_file = undef;
 162
 163 # don't generate information about owners of repositories
 164 our $omit_owner=0;
 165
 166 # owner link hook given owner name (full and NOT obfuscated)
 167 # should return full URL-escaped link to attach to owner, for example:
 168 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 169 our $owner_link_hook = undef;
 170
 171 # show repository only if this subroutine returns true
 172 # when given the path to the project, for example:
 173 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 174 our $export_auth_hook = undef;
 175
 176 # only allow viewing of repositories also shown on the overview page
 177 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 178
 179 # list of git base URLs used for URL to where fetch project from,
 180 # i.e. full URL is "$git_base_url/$project"
 181 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 182
 183 # URLs designated for pushing new changes, extended by the
 184 # project name (i.e. "$git_base_push_url[0]/$project")
 185 our @git_base_push_urls = ();
 186
 187 # https hint html inserted right after any https push URL (undef for none)
 188 our $https_hint_html = undef;
 189
 190 # default blob_plain mimetype and default charset for text/plain blob
 191 our $default_blob_plain_mimetype = 'application/octet-stream';
 192 our $default_text_plain_charset  = undef;
 193
 194 # file to use for guessing MIME types before trying /etc/mime.types
 195 # (relative to the current git repository)
 196 our $mimetypes_file = undef;
 197
 198 # assume this charset if line contains non-UTF-8 characters;
 199 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 200 # for which encoding all byte sequences are valid, for example
 201 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 202 # could be even 'utf-8' for the old behavior)
 203 our $fallback_encoding = 'latin1';
 204
 205 # rename detection options for git-diff and git-diff-tree
 206 # - default is '-M', with the cost proportional to
 207 #   (number of removed files) * (number of new files).
 208 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 209 #   (number of changed files + number of removed files) * (number of new files)
 210 # - even more costly is '-C', '--find-copies-harder' with cost
 211 #   (number of files in the original tree) * (number of new files)
 212 # - one might want to include '-B' option, e.g. '-B', '-M'
 213 our @diff_opts = ('-M'); # taken from git_commit
 214
 215 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 216 # the directory must exist and be writable by the process running gitweb.
 217 # additionally some actions must be selected for caching in %html_cache_actions
 218 # - default is 'htmlcache'
 219 our $html_cache_dir = 'htmlcache';
 220
 221 # which actions to cache in $html_cache_dir
 222 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 223 # process running gitweb, then any actions selected here will have their output
 224 # cached and the cache file will be returned instead of regenerating the page
 225 # if it exists.  For this to be useful, an external process must create the
 226 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 227 # the project information has been changed.  Alternatively it may create a
 228 # "$action.changed" file (if it does not exist) instead to limit the changes
 229 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 230 # exist, then the cached version will never be used for "$action" and a new
 231 # cache page will be regenerated (and the "changed" files removed as appropriate).
 232 #
 233 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 234 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 235 # process must create the 'forkchange' file or update its timestamp if it already
 236 # exists whenever a fork is added to or removed from the project (as well as
 237 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 238 # section on the summary page may remain out-of-date indefinately.
 239 #
 240 # - default is none
 241 #   currently only caching of the summary page is supported
 242 # - to enable caching of the summary page use:
 243 #   $html_cache_actions{'summary'} = 1;
 244 our %html_cache_actions = ();
 245
 246 # Disables features that would allow repository owners to inject script into
 247 # the gitweb domain.
 248 our $prevent_xss = 0;
 249
 250 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 251 # Only used when highlight is enabled or snapshots with compressors are enabled.
 252 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 253
 254 # Path to the highlight executable to use (must be the one from
 255 # http://www.andre-simon.de due to assumptions about parameters and output).
 256 # Useful if highlight is not installed on your webserver's PATH.
 257 # [Default: highlight]
 258 our $highlight_bin = "++HIGHLIGHT_BIN++";
 259
 260 # Whether to include project list on the gitweb front page; 0 means yes,
 261 # 1 means no list but show tag cloud if enabled (all projects still need
 262 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 263 # (very fast)
 264 our $frontpage_no_project_list = 0;
 265
 266 # projects list cache for busy sites with many projects;
 267 # if you set this to non-zero, it will be used as the cached
 268 # index lifetime in minutes
 269 #
 270 # the cached list version is stored in $cache_dir/$cache_name and can
 271 # be tweaked by other scripts running with the same uid as gitweb -
 272 # use this ONLY at secure installations; only single gitweb project
 273 # root per system is supported, unless you tweak configuration!
 274 our $projlist_cache_lifetime = 0; # in minutes
 275 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 276 our $cache_dir =
 277         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 278 our $projlist_cache_name = 'gitweb.index.cache';
 279 our $cache_grpshared = 0;
 280
 281 # information about snapshot formats that gitweb is capable of serving
 282 our %known_snapshot_formats = (
 283         # name => {
 284         #       'display' => display name,
 285         #       'type' => mime type,
 286         #       'suffix' => filename suffix,
 287         #       'format' => --format for git-archive,
 288         #       'compressor' => [compressor command and arguments]
 289         #                       (array reference, optional)
 290         #       'disabled' => boolean (optional)}
 291         #
 292         'tgz' => {
 293                 'display' => 'tar.gz',
 294                 'type' => 'application/x-gzip',
 295                 'suffix' => '.tar.gz',
 296                 'format' => 'tar',
 297                 'compressor' => ['gzip', '-n']},
 298
 299         'tbz2' => {
 300                 'display' => 'tar.bz2',
 301                 'type' => 'application/x-bzip2',
 302                 'suffix' => '.tar.bz2',
 303                 'format' => 'tar',
 304                 'compressor' => ['bzip2']},
 305
 306         'txz' => {
 307                 'display' => 'tar.xz',
 308                 'type' => 'application/x-xz',
 309                 'suffix' => '.tar.xz',
 310                 'format' => 'tar',
 311                 'compressor' => ['xz'],
 312                 'disabled' => 1},
 313
 314         'zip' => {
 315                 'display' => 'zip',
 316                 'type' => 'application/x-zip',
 317                 'suffix' => '.zip',
 318                 'format' => 'zip'},
 319 );
 320
 321 # Aliases so we understand old gitweb.snapshot values in repository
 322 # configuration.
 323 our %known_snapshot_format_aliases = (
 324         'gzip'  => 'tgz',
 325         'bzip2' => 'tbz2',
 326         'xz'    => 'txz',
 327
 328         # backward compatibility: legacy gitweb config support
 329         'x-gzip' => undef, 'gz' => undef,
 330         'x-bzip2' => undef, 'bz2' => undef,
 331         'x-zip' => undef, '' => undef,
 332 );
 333
 334 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 335 # are changed, it may be appropriate to change these values too via
 336 # $GITWEB_CONFIG.
 337 our %avatar_size = (
 338         'default' => 16,
 339         'double'  => 32
 340 );
 341
 342 # Used to set the maximum load that we will still respond to gitweb queries.
 343 # If server load exceed this value then return "503 server busy" error.
 344 # If gitweb cannot determined server load, it is taken to be 0.
 345 # Leave it undefined (or set to 'undef') to turn off load checking.
 346 our $maxload = 300;
 347
 348 # configuration for 'highlight' (http://www.andre-simon.de/)
 349 # match by basename
 350 our %highlight_basename = (
 351         #'Program' => 'py',
 352         #'Library' => 'py',
 353         'SConstruct' => 'py', # SCons equivalent of Makefile
 354         'Makefile' => 'make',
 355         'makefile' => 'make',
 356         'GNUmakefile' => 'make',
 357         'BSDmakefile' => 'make',
 358 );
 359 # match by shebang regex
 360 our %highlight_shebang = (
 361         # Each entry has a key which is the syntax to use and
 362         # a value which is either a qr regex or an array of qr regexs to match
 363         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 364         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 365         # allow a limited subset of NAME=value items to appear.
 366         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 367                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 368         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 369                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 370         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 371                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 372         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 373                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 374         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 375                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 376         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 377                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 378         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 379                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 380 );
 381 # match by extension
 382 our %highlight_ext = (
 383         # main extensions, defining name of syntax;
 384         # see files in /usr/share/highlight/langDefs/ directory
 385         (map { $_ => $_ } qw(
 386                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 387                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 388                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 389                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 390                 go haskell hcl html httpd hx icl icn idl idlang ili
 391                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 392                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 393                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 394                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 395                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 396                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 397                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 398                 yaiff znn)),
 399         # alternate extensions, see /etc/highlight/filetypes.conf
 400         (map { $_ => '4gl' } qw(informix)),
 401         (map { $_ => 'a4c' } qw(ascend)),
 402         (map { $_ => 'abp' } qw(abp4)),
 403         (map { $_ => 'ada' } qw(a adb ads gnad)),
 404         (map { $_ => 'ahk' } qw(autohotkey)),
 405         (map { $_ => 'ampl' } qw(dat run)),
 406         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 407         (map { $_ => 'as' } qw(actionscript)),
 408         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 409         (map { $_ => 'asp' } qw(asa)),
 410         (map { $_ => 'aspect' } qw(was wud)),
 411         (map { $_ => 'ats' } qw(dats)),
 412         (map { $_ => 'au3' } qw(autoit)),
 413         (map { $_ => 'bat' } qw(cmd)),
 414         (map { $_ => 'bb' } qw(blitzbasic)),
 415         (map { $_ => 'bib' } qw(bibtex)),
 416         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 417         (map { $_ => 'cb' } qw(clearbasic)),
 418         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 419         (map { $_ => 'chl' } qw(chill)),
 420         (map { $_ => 'cob' } qw(cbl cobol)),
 421         (map { $_ => 'cs' } qw(csharp)),
 422         (map { $_ => 'diff' } qw(patch)),
 423         (map { $_ => 'dot' } qw(graphviz)),
 424         (map { $_ => 'e' } qw(eiffel se)),
 425         (map { $_ => 'erl' } qw(erlang hrl)),
 426         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 427         (map { $_ => 'exp' } qw(express)),
 428         (map { $_ => 'f90' } qw(f95)),
 429         (map { $_ => 'flx' } qw(felix)),
 430         (map { $_ => 'for' } qw(f f77 ftn)),
 431         (map { $_ => 'fs' } qw(fsharp fsx)),
 432         (map { $_ => 'haskell' } qw(hs)),
 433         (map { $_ => 'html' } qw(htm xhtml)),
 434         (map { $_ => 'hx' } qw(haxe)),
 435         (map { $_ => 'icl' } qw(clean)),
 436         (map { $_ => 'icn' } qw(icon)),
 437         (map { $_ => 'ili' } qw(interlis)),
 438         (map { $_ => 'inp' } qw(fame)),
 439         (map { $_ => 'iss' } qw(innosetup)),
 440         (map { $_ => 'j' } qw(jasmin)),
 441         (map { $_ => 'java' } qw(groovy grv)),
 442         (map { $_ => 'lbn' } qw(luban)),
 443         (map { $_ => 'lgt' } qw(logtalk)),
 444         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 445         (map { $_ => 'ls' } qw(lotus)),
 446         (map { $_ => 'lsl' } qw(lindenscript)),
 447         (map { $_ => 'ly' } qw(lilypond)),
 448         (map { $_ => 'make' } qw(mak mk kmk)),
 449         (map { $_ => 'mel' } qw(maya)),
 450         (map { $_ => 'mib' } qw(smi snmp)),
 451         (map { $_ => 'ml' } qw(mli ocaml)),
 452         (map { $_ => 'mo' } qw(modelica)),
 453         (map { $_ => 'mod2' } qw(def mod)),
 454         (map { $_ => 'mod3' } qw(i3 m3)),
 455         (map { $_ => 'mpl' } qw(maple)),
 456         (map { $_ => 'n' } qw(nemerle)),
 457         (map { $_ => 'nas' } qw(nasal)),
 458         (map { $_ => 'nrx' } qw(netrexx)),
 459         (map { $_ => 'nsi' } qw(nsis)),
 460         (map { $_ => 'nut' } qw(squirrel)),
 461         (map { $_ => 'oberon' } qw(ooc)),
 462         (map { $_ => 'objc' } qw(M m mm)),
 463         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 464         (map { $_ => 'pike' } qw(pmod)),
 465         (map { $_ => 'pl' } qw(perl plex plx pm)),
 466         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 467         (map { $_ => 'progress' } qw(i p w)),
 468         (map { $_ => 'py' } qw(python)),
 469         (map { $_ => 'pyx' } qw(pyrex)),
 470         (map { $_ => 'rb' } qw(pp rjs ruby)),
 471         (map { $_ => 'rexx' } qw(rex rx the)),
 472         (map { $_ => 'sc' } qw(paradox)),
 473         (map { $_ => 'scilab' } qw(sce sci)),
 474         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 475         (map { $_ => 'sma' } qw(small)),
 476         (map { $_ => 'smalltalk' } qw(gst sq st)),
 477         (map { $_ => 'sno' } qw(snobal)),
 478         (map { $_ => 'sybase' } qw(sp)),
 479         (map { $_ => 'tcl' } qw(itcl wish)),
 480         (map { $_ => 'tex' } qw(cls sty)),
 481         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 482         (map { $_ => 'verilog' } qw(v)),
 483         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 484         (map { $_ => 'y' } qw(bison)),
 485 );
 486
 487 # You define site-wide feature defaults here; override them with
 488 # $GITWEB_CONFIG as necessary.
 489 our %feature = (
 490         # feature => {
 491         #       'sub' => feature-sub (subroutine),
 492         #       'override' => allow-override (boolean),
 493         #       'default' => [ default options...] (array reference)}
 494         #
 495         # if feature is overridable (it means that allow-override has true value),
 496         # then feature-sub will be called with default options as parameters;
 497         # return value of feature-sub indicates if to enable specified feature
 498         #
 499         # if there is no 'sub' key (no feature-sub), then feature cannot be
 500         # overridden
 501         #
 502         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 503         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 504         # is enabled
 505
 506         # Enable the 'blame' blob view, showing the last commit that modified
 507         # each line in the file. This can be very CPU-intensive.
 508
 509         # To enable system wide have in $GITWEB_CONFIG
 510         # $feature{'blame'}{'default'} = [1];
 511         # To have project specific config enable override in $GITWEB_CONFIG
 512         # $feature{'blame'}{'override'} = 1;
 513         # and in project config gitweb.blame = 0|1;
 514         'blame' => {
 515                 'sub' => sub { feature_bool('blame', @_) },
 516                 'override' => 0,
 517                 'default' => [0]},
 518
 519         # Enable the 'incremental blame' blob view, which uses javascript to
 520         # incrementally show the revisions of lines as they are discovered
 521         # in the history. It is better for large histories, files and slow
 522         # servers, but requires javascript in the client and can slow down the
 523         # browser on large files.
 524
 525         # To enable system wide have in $GITWEB_CONFIG
 526         # $feature{'blame_incremental'}{'default'} = [1];
 527         # To have project specific config enable override in $GITWEB_CONFIG
 528         # $feature{'blame_incremental'}{'override'} = 1;
 529         # and in project config gitweb.blame_incremental = 0|1;
 530         'blame_incremental' => {
 531                 'sub' => sub { feature_bool('blame_incremental', @_) },
 532                 'override' => 0,
 533                 'default' => [0]},
 534
 535         # Enable the 'snapshot' link, providing a compressed archive of any
 536         # tree. This can potentially generate high traffic if you have large
 537         # project.
 538
 539         # Value is a list of formats defined in %known_snapshot_formats that
 540         # you wish to offer.
 541         # To disable system wide have in $GITWEB_CONFIG
 542         # $feature{'snapshot'}{'default'} = [];
 543         # To have project specific config enable override in $GITWEB_CONFIG
 544         # $feature{'snapshot'}{'override'} = 1;
 545         # and in project config, a comma-separated list of formats or "none"
 546         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 547         'snapshot' => {
 548                 'sub' => \&feature_snapshot,
 549                 'override' => 0,
 550                 'default' => ['tgz']},
 551
 552         # Enable text search, which will list the commits which match author,
 553         # committer or commit text to a given string.  Enabled by default.
 554         # Project specific override is not supported.
 555         #
 556         # Note that this controls all search features, which means that if
 557         # it is disabled, then 'grep' and 'pickaxe' search would also be
 558         # disabled.
 559         'search' => {
 560                 'override' => 0,
 561                 'default' => [1]},
 562
 563         # Enable grep search, which will list the files in currently selected
 564         # tree containing the given string. Enabled by default. This can be
 565         # potentially CPU-intensive, of course.
 566         # Note that you need to have 'search' feature enabled too.
 567
 568         # To enable system wide have in $GITWEB_CONFIG
 569         # $feature{'grep'}{'default'} = [1];
 570         # To have project specific config enable override in $GITWEB_CONFIG
 571         # $feature{'grep'}{'override'} = 1;
 572         # and in project config gitweb.grep = 0|1;
 573         'grep' => {
 574                 'sub' => sub { feature_bool('grep', @_) },
 575                 'override' => 0,
 576                 'default' => [1]},
 577
 578         # Enable the pickaxe search, which will list the commits that modified
 579         # a given string in a file. This can be practical and quite faster
 580         # alternative to 'blame', but still potentially CPU-intensive.
 581         # Note that you need to have 'search' feature enabled too.
 582
 583         # To enable system wide have in $GITWEB_CONFIG
 584         # $feature{'pickaxe'}{'default'} = [1];
 585         # To have project specific config enable override in $GITWEB_CONFIG
 586         # $feature{'pickaxe'}{'override'} = 1;
 587         # and in project config gitweb.pickaxe = 0|1;
 588         'pickaxe' => {
 589                 'sub' => sub { feature_bool('pickaxe', @_) },
 590                 'override' => 0,
 591                 'default' => [1]},
 592
 593         # Enable showing size of blobs in a 'tree' view, in a separate
 594         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 595
 596         # To disable system wide have in $GITWEB_CONFIG
 597         # $feature{'show-sizes'}{'default'} = [0];
 598         # To have project specific config enable override in $GITWEB_CONFIG
 599         # $feature{'show-sizes'}{'override'} = 1;
 600         # and in project config gitweb.showsizes = 0|1;
 601         'show-sizes' => {
 602                 'sub' => sub { feature_bool('showsizes', @_) },
 603                 'override' => 0,
 604                 'default' => [1]},
 605
 606         # Make gitweb use an alternative format of the URLs which can be
 607         # more readable and natural-looking: project name is embedded
 608         # directly in the path and the query string contains other
 609         # auxiliary information. All gitweb installations recognize
 610         # URL in either format; this configures in which formats gitweb
 611         # generates links.
 612
 613         # To enable system wide have in $GITWEB_CONFIG
 614         # $feature{'pathinfo'}{'default'} = [1];
 615         # Project specific override is not supported.
 616
 617         # Note that you will need to change the default location of CSS,
 618         # favicon, logo and possibly other files to an absolute URL. Also,
 619         # if gitweb.cgi serves as your indexfile, you will need to force
 620         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 621         # will also likely want to set $home_link if you're setting $my_uri).
 622         'pathinfo' => {
 623                 'override' => 0,
 624                 'default' => [0]},
 625
 626         # Make gitweb consider projects in project root subdirectories
 627         # to be forks of existing projects. Given project $projname.git,
 628         # projects matching $projname/*.git will not be shown in the main
 629         # projects list, instead a '+' mark will be added to $projname
 630         # there and a 'forks' view will be enabled for the project, listing
 631         # all the forks. If project list is taken from a file, forks have
 632         # to be listed after the main project.
 633
 634         # To enable system wide have in $GITWEB_CONFIG
 635         # $feature{'forks'}{'default'} = [1];
 636         # Project specific override is not supported.
 637         'forks' => {
 638                 'override' => 0,
 639                 'default' => [0]},
 640
 641         # Insert custom links to the action bar of all project pages.
 642         # This enables you mainly to link to third-party scripts integrating
 643         # into gitweb; e.g. git-browser for graphical history representation
 644         # or custom web-based repository administration interface.
 645
 646         # The 'default' value consists of a list of triplets in the form
 647         # (label, link, position) where position is the label after which
 648         # to insert the link and link is a format string where %n expands
 649         # to the project name, %f to the project path within the filesystem,
 650         # %h to the current hash (h gitweb parameter) and %b to the current
 651         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 652         # project name where all '+' characters have been replaced with '%2B'.
 653
 654         # To enable system wide have in $GITWEB_CONFIG e.g.
 655         # $feature{'actions'}{'default'} = [('graphiclog',
 656         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 657         # Project specific override is not supported.
 658         'actions' => {
 659                 'override' => 0,
 660                 'default' => []},
 661
 662         # Allow gitweb scan project content tags of project repository,
 663         # and display the popular Web 2.0-ish "tag cloud" near the projects
 664         # list.  Note that this is something COMPLETELY different from the
 665         # normal Git tags.
 666
 667         # gitweb by itself can show existing tags, but it does not handle
 668         # tagging itself; you need to do it externally, outside gitweb.
 669         # The format is described in git_get_project_ctags() subroutine.
 670         # You may want to install the HTML::TagCloud Perl module to get
 671         # a pretty tag cloud instead of just a list of tags.
 672
 673         # To enable system wide have in $GITWEB_CONFIG
 674         # $feature{'ctags'}{'default'} = [1];
 675         # Project specific override is not supported.
 676
 677         # A value of 0 means no ctags display or editing.  A value of
 678         # 1 enables ctags display but never editing.  A non-empty value
 679         # that is not a string of digits enables ctags display AND the
 680         # ability to add tags using a form that uses method POST and
 681         # an action value set to the configured 'ctags' value.
 682         'ctags' => {
 683                 'override' => 0,
 684                 'default' => [0]},
 685
 686         # The maximum number of patches in a patchset generated in patch
 687         # view. Set this to 0 or undef to disable patch view, or to a
 688         # negative number to remove any limit.
 689
 690         # To disable system wide have in $GITWEB_CONFIG
 691         # $feature{'patches'}{'default'} = [0];
 692         # To have project specific config enable override in $GITWEB_CONFIG
 693         # $feature{'patches'}{'override'} = 1;
 694         # and in project config gitweb.patches = 0|n;
 695         # where n is the maximum number of patches allowed in a patchset.
 696         'patches' => {
 697                 'sub' => \&feature_patches,
 698                 'override' => 0,
 699                 'default' => [16]},
 700
 701         # Avatar support. When this feature is enabled, views such as
 702         # shortlog or commit will display an avatar associated with
 703         # the email of the committer(s) and/or author(s).
 704
 705         # Currently available providers are gravatar and picon.
 706         # If an unknown provider is specified, the feature is disabled.
 707
 708         # Gravatar depends on Digest::MD5.
 709         # Picon currently relies on the indiana.edu database.
 710
 711         # To enable system wide have in $GITWEB_CONFIG
 712         # $feature{'avatar'}{'default'} = ['<provider>'];
 713         # where <provider> is either gravatar or picon.
 714         # To have project specific config enable override in $GITWEB_CONFIG
 715         # $feature{'avatar'}{'override'} = 1;
 716         # and in project config gitweb.avatar = <provider>;
 717         'avatar' => {
 718                 'sub' => \&feature_avatar,
 719                 'override' => 0,
 720                 'default' => ['']},
 721
 722         # Enable displaying how much time and how many git commands
 723         # it took to generate and display page.  Disabled by default.
 724         # Project specific override is not supported.
 725         'timed' => {
 726                 'override' => 0,
 727                 'default' => [0]},
 728
 729         # Enable turning some links into links to actions which require
 730         # JavaScript to run (like 'blame_incremental').  Not enabled by
 731         # default.  Project specific override is currently not supported.
 732         'javascript-actions' => {
 733                 'override' => 0,
 734                 'default' => [0]},
 735
 736         # Enable and configure ability to change common timezone for dates
 737         # in gitweb output via JavaScript.  Enabled by default.
 738         # Project specific override is not supported.
 739         'javascript-timezone' => {
 740                 'override' => 0,
 741                 'default' => [
 742                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 743                                      # or undef to turn off this feature
 744                         'gitweb_tz', # name of cookie where to store selected timezone
 745                         'datetime',  # CSS class used to mark up dates for manipulation
 746                 ]},
 747
 748         # Syntax highlighting support. This is based on Daniel Svensson's
 749         # and Sham Chukoury's work in gitweb-xmms2.git.
 750         # It requires the 'highlight' program present in $PATH,
 751         # and therefore is disabled by default.
 752
 753         # To enable system wide have in $GITWEB_CONFIG
 754         # $feature{'highlight'}{'default'} = [1];
 755
 756         'highlight' => {
 757                 'sub' => sub { feature_bool('highlight', @_) },
 758                 'override' => 0,
 759                 'default' => [0]},
 760
 761         # Enable displaying of remote heads in the heads list
 762
 763         # To enable system wide have in $GITWEB_CONFIG
 764         # $feature{'remote_heads'}{'default'} = [1];
 765         # To have project specific config enable override in $GITWEB_CONFIG
 766         # $feature{'remote_heads'}{'override'} = 1;
 767         # and in project config gitweb.remoteheads = 0|1;
 768         'remote_heads' => {
 769                 'sub' => sub { feature_bool('remote_heads', @_) },
 770                 'override' => 0,
 771                 'default' => [0]},
 772
 773         # Enable showing branches under other refs in addition to heads
 774
 775         # To set system wide extra branch refs have in $GITWEB_CONFIG
 776         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 777         # To have project specific config enable override in $GITWEB_CONFIG
 778         # $feature{'extra-branch-refs'}{'override'} = 1;
 779         # and in project config gitweb.extrabranchrefs = dirs of choice
 780         # Every directory is separated with whitespace.
 781
 782         'extra-branch-refs' => {
 783                 'sub' => \&feature_extra_branch_refs,
 784                 'override' => 0,
 785                 'default' => []},
 786 );
 787
 788 sub gitweb_get_feature {
 789         my ($name) = @_;
 790         return unless exists $feature{$name};
 791         my ($sub, $override, @defaults) = (
 792                 $feature{$name}{'sub'},
 793                 $feature{$name}{'override'},
 794                 @{$feature{$name}{'default'}});
 795         # project specific override is possible only if we have project
 796         our $git_dir; # global variable, declared later
 797         if (!$override || !defined $git_dir) {
 798                 return @defaults;
 799         }
 800         if (!defined $sub) {
 801                 warn "feature $name is not overridable";
 802                 return @defaults;
 803         }
 804         return $sub->(@defaults);
 805 }
 806
 807 # A wrapper to check if a given feature is enabled.
 808 # With this, you can say
 809 #
 810 #   my $bool_feat = gitweb_check_feature('bool_feat');
 811 #   gitweb_check_feature('bool_feat') or somecode;
 812 #
 813 # instead of
 814 #
 815 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 816 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 817 #
 818 sub gitweb_check_feature {
 819         return (gitweb_get_feature(@_))[0];
 820 }
 821
 822
 823 sub feature_bool {
 824         my $key = shift;
 825         my ($val) = git_get_project_config($key, '--bool');
 826
 827         if (!defined $val) {
 828                 return ($_[0]);
 829         } elsif ($val eq 'true') {
 830                 return (1);
 831         } elsif ($val eq 'false') {
 832                 return (0);
 833         }
 834 }
 835
 836 sub feature_snapshot {
 837         my (@fmts) = @_;
 838
 839         my ($val) = git_get_project_config('snapshot');
 840
 841         if ($val) {
 842                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 843         }
 844
 845         return @fmts;
 846 }
 847
 848 sub feature_patches {
 849         my @val = (git_get_project_config('patches', '--int'));
 850
 851         if (@val) {
 852                 return @val;
 853         }
 854
 855         return ($_[0]);
 856 }
 857
 858 sub feature_avatar {
 859         my @val = (git_get_project_config('avatar'));
 860
 861         return @val ? @val : @_;
 862 }
 863
 864 sub feature_extra_branch_refs {
 865         my (@branch_refs) = @_;
 866         my $values = git_get_project_config('extrabranchrefs');
 867
 868         if ($values) {
 869                 $values = config_to_multi ($values);
 870                 @branch_refs = ();
 871                 foreach my $value (@{$values}) {
 872                         push @branch_refs, split /\s+/, $value;
 873                 }
 874         }
 875
 876         return @branch_refs;
 877 }
 878
 879 # checking HEAD file with -e is fragile if the repository was
 880 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 881 # and then pruned.
 882 sub check_head_link {
 883         my ($dir) = @_;
 884         my $headfile = "$dir/HEAD";
 885         return ((-e $headfile) ||
 886                 (-l $headfile && readlink($headfile) =~ /^refs\/heads\//));
 887 }
 888
 889 sub check_export_ok {
 890         my ($dir) = @_;
 891         return (check_head_link($dir) &&
 892                 (!$export_ok || -e "$dir/$export_ok") &&
 893                 (!$export_auth_hook || $export_auth_hook->($dir)));
 894 }
 895
 896 # process alternate names for backward compatibility
 897 # filter out unsupported (unknown) snapshot formats
 898 sub filter_snapshot_fmts {
 899         my @fmts = @_;
 900
 901         @fmts = map {
 902                 exists $known_snapshot_format_aliases{$_} ?
 903                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 904         @fmts = grep {
 905                 exists $known_snapshot_formats{$_} &&
 906                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 907 }
 908
 909 sub filter_and_validate_refs {
 910         my @refs = @_;
 911         my %unique_refs = ();
 912
 913         foreach my $ref (@refs) {
 914                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 915                 # 'heads' are added implicitly in get_branch_refs().
 916                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 917         }
 918         return sort keys %unique_refs;
 919 }
 920
 921 # If it is set to code reference, it is code that it is to be run once per
 922 # request, allowing updating configurations that change with each request,
 923 # while running other code in config file only once.
 924 #
 925 # Otherwise, if it is false then gitweb would process config file only once;
 926 # if it is true then gitweb config would be run for each request.
 927 our $per_request_config = 1;
 928
 929 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 930 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 931 # same way as though the --fcgi option had been given instead.
 932 our $auto_fcgi = 0;
 933
 934 # read and parse gitweb config file given by its parameter.
 935 # returns true on success, false on recoverable error, allowing
 936 # to chain this subroutine, using first file that exists.
 937 # dies on errors during parsing config file, as it is unrecoverable.
 938 sub read_config_file {
 939         my $filename = shift;
 940         return unless defined $filename;
 941         # die if there are errors parsing config file
 942         if (-e $filename) {
 943                 do $filename;
 944                 die $@ if $@;
 945                 return 1;
 946         }
 947         return;
 948 }
 949
 950 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
 951 sub evaluate_gitweb_config {
 952         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
 953         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
 954         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
 955
 956         # Protect against duplications of file names, to not read config twice.
 957         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
 958         # there possibility of duplication of filename there doesn't matter.
 959         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
 960         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
 961
 962         # Common system-wide settings for convenience.
 963         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
 964         read_config_file($GITWEB_CONFIG_COMMON);
 965
 966         # Use first config file that exists.  This means use the per-instance
 967         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
 968         read_config_file($GITWEB_CONFIG) and return;
 969         read_config_file($GITWEB_CONFIG_SYSTEM);
 970 }
 971
 972 our $encode_object;
 973
 974 sub evaluate_encoding {
 975         my $requested = $fallback_encoding || 'ISO-8859-1';
 976         my $obj = Encode::find_encoding($requested) or
 977                 die_error(400, "Requested fallback encoding not found");
 978         if ($obj->name eq 'iso-8859-1') {
 979                 # Use Windows-1252 instead as required by the HTML 5 standard
 980                 my $altobj = Encode::find_encoding('Windows-1252');
 981                 $obj = $altobj if $altobj;
 982         }
 983         $encode_object = $obj;
 984 }
 985
 986 sub evaluate_email_obfuscate {
 987         # email obfuscation
 988         our $email;
 989         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
 990                 $email = HTML::Email::Obfuscate->new(lite => 1);
 991         }
 992 }
 993
 994 # Get loadavg of system, to compare against $maxload.
 995 # Currently it requires '/proc/loadavg' present to get loadavg;
 996 # if it is not present it returns 0, which means no load checking.
 997 sub get_loadavg {
 998         if( -e '/proc/loadavg' ){
 999                 open my $fd, '<', '/proc/loadavg'
1000                         or return 0;
1001                 my @load = split(/\s+/, scalar <$fd>);
1002                 close $fd;
1003
1004                 # The first three columns measure CPU and IO utilization of the last one,
1005                 # five, and 10 minute periods.  The fourth column shows the number of
1006                 # currently running processes and the total number of processes in the m/n
1007                 # format.  The last column displays the last process ID used.
1008                 return $load[0] || 0;
1009         }
1010         # additional checks for load average should go here for things that don't export
1011         # /proc/loadavg
1012
1013         return 0;
1014 }
1015
1016 # version of the core git binary
1017 our $git_version;
1018 sub evaluate_git_version {
1019         our $git_version = $version;
1020 }
1021
1022 sub check_loadavg {
1023         if (defined $maxload && get_loadavg() > $maxload) {
1024                 die_error(503, "The load average on the server is too high");
1025         }
1026 }
1027
1028 # ======================================================================
1029 # input validation and dispatch
1030
1031 # input parameters can be collected from a variety of sources (presently, CGI
1032 # and PATH_INFO), so we define an %input_params hash that collects them all
1033 # together during validation: this allows subsequent uses (e.g. href()) to be
1034 # agnostic of the parameter origin
1035
1036 our %input_params = ();
1037
1038 # input parameters are stored with the long parameter name as key. This will
1039 # also be used in the href subroutine to convert parameters to their CGI
1040 # equivalent, and since the href() usage is the most frequent one, we store
1041 # the name -> CGI key mapping here, instead of the reverse.
1042 #
1043 # XXX: Warning: If you touch this, check the search form for updating,
1044 # too.
1045
1046 our @cgi_param_mapping = (
1047         project => "p",
1048         action => "a",
1049         file_name => "f",
1050         file_parent => "fp",
1051         hash => "h",
1052         hash_parent => "hp",
1053         hash_base => "hb",
1054         hash_parent_base => "hpb",
1055         page => "pg",
1056         order => "o",
1057         searchtext => "s",
1058         searchtype => "st",
1059         snapshot_format => "sf",
1060         ctag_filter => 't',
1061         extra_options => "opt",
1062         search_use_regexp => "sr",
1063         ctag => "by_tag",
1064         diff_style => "ds",
1065         project_filter => "pf",
1066         # this must be last entry (for manipulation from JavaScript)
1067         javascript => "js"
1068 );
1069 our %cgi_param_mapping = @cgi_param_mapping;
1070
1071 # we will also need to know the possible actions, for validation
1072 our %actions = (
1073         "blame" => \&git_blame,
1074         "blame_incremental" => \&git_blame_incremental,
1075         "blame_data" => \&git_blame_data,
1076         "blobdiff" => \&git_blobdiff,
1077         "blobdiff_plain" => \&git_blobdiff_plain,
1078         "blob" => \&git_blob,
1079         "blob_plain" => \&git_blob_plain,
1080         "commitdiff" => \&git_commitdiff,
1081         "commitdiff_plain" => \&git_commitdiff_plain,
1082         "commit" => \&git_commit,
1083         "forks" => \&git_forks,
1084         "heads" => \&git_heads,
1085         "history" => \&git_history,
1086         "log" => \&git_log,
1087         "patch" => \&git_patch,
1088         "patches" => \&git_patches,
1089         "refs" => \&git_refs,
1090         "remotes" => \&git_remotes,
1091         "rss" => \&git_rss,
1092         "atom" => \&git_atom,
1093         "search" => \&git_search,
1094         "search_help" => \&git_search_help,
1095         "shortlog" => \&git_shortlog,
1096         "summary" => \&git_summary,
1097         "tag" => \&git_tag,
1098         "tags" => \&git_tags,
1099         "tree" => \&git_tree,
1100         "snapshot" => \&git_snapshot,
1101         "object" => \&git_object,
1102         # those below don't need $project
1103         "opml" => \&git_opml,
1104         "frontpage" => \&git_frontpage,
1105         "project_list" => \&git_project_list,
1106         "project_index" => \&git_project_index,
1107 );
1108
1109 # the only actions we will allow to be cached
1110 my %supported_cache_actions;
1111 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1112
1113 # finally, we have the hash of allowed extra_options for the commands that
1114 # allow them
1115 our %allowed_options = (
1116         "--no-merges" => [ qw(rss atom log shortlog history) ],
1117 );
1118
1119 # fill %input_params with the CGI parameters. All values except for 'opt'
1120 # should be single values, but opt can be an array. We should probably
1121 # build an array of parameters that can be multi-valued, but since for the time
1122 # being it's only this one, we just single it out
1123 sub evaluate_query_params {
1124         our $cgi;
1125
1126         while (my ($name, $symbol) = each %cgi_param_mapping) {
1127                 if ($symbol eq 'opt') {
1128                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1129                 } else {
1130                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1131                 }
1132         }
1133
1134         # Backwards compatibility - by_tag= <=> t=
1135         if ($input_params{'ctag'}) {
1136                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1137         }
1138 }
1139
1140 # now read PATH_INFO and update the parameter list for missing parameters
1141 sub evaluate_path_info {
1142         return if defined $input_params{'project'};
1143         return if !$path_info;
1144         $path_info =~ s,^/+,,;
1145         return if !$path_info;
1146
1147         # find which part of PATH_INFO is project
1148         my $project = $path_info;
1149         $project =~ s,/+$,,;
1150         while ($project && !check_head_link("$projectroot/$project")) {
1151                 $project =~ s,/*[^/]*$,,;
1152         }
1153         return unless $project;
1154         $input_params{'project'} = $project;
1155
1156         # do not change any parameters if an action is given using the query string
1157         return if $input_params{'action'};
1158         $path_info =~ s,^\Q$project\E/*,,;
1159
1160         # next, check if we have an action
1161         my $action = $path_info;
1162         $action =~ s,/.*$,,;
1163         if (exists $actions{$action}) {
1164                 $path_info =~ s,^$action/*,,;
1165                 $input_params{'action'} = $action;
1166         }
1167
1168         # list of actions that want hash_base instead of hash, but can have no
1169         # pathname (f) parameter
1170         my @wants_base = (
1171                 'tree',
1172                 'history',
1173         );
1174
1175         # we want to catch, among others
1176         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1177         my ($parentrefname, $parentpathname, $refname, $pathname) =
1178                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1179
1180         # first, analyze the 'current' part
1181         if (defined $pathname) {
1182                 # we got "branch:filename" or "branch:dir/"
1183                 # we could use git_get_type(branch:pathname), but:
1184                 # - it needs $git_dir
1185                 # - it does a git() call
1186                 # - the convention of terminating directories with a slash
1187                 #   makes it superfluous
1188                 # - embedding the action in the PATH_INFO would make it even
1189                 #   more superfluous
1190                 $pathname =~ s,^/+,,;
1191                 if (!$pathname || substr($pathname, -1) eq "/") {
1192                         $input_params{'action'} ||= "tree";
1193                         $pathname =~ s,/$,,;
1194                 } else {
1195                         # the default action depends on whether we had parent info
1196                         # or not
1197                         if ($parentrefname) {
1198                                 $input_params{'action'} ||= "blobdiff_plain";
1199                         } else {
1200                                 $input_params{'action'} ||= "blob_plain";
1201                         }
1202                 }
1203                 $input_params{'hash_base'} ||= $refname;
1204                 $input_params{'file_name'} ||= $pathname;
1205         } elsif (defined $refname) {
1206                 # we got "branch". In this case we have to choose if we have to
1207                 # set hash or hash_base.
1208                 #
1209                 # Most of the actions without a pathname only want hash to be
1210                 # set, except for the ones specified in @wants_base that want
1211                 # hash_base instead. It should also be noted that hand-crafted
1212                 # links having 'history' as an action and no pathname or hash
1213                 # set will fail, but that happens regardless of PATH_INFO.
1214                 if (defined $parentrefname) {
1215                         # if there is parent let the default be 'shortlog' action
1216                         # (for http://git.example.com/repo.git/A..B links); if there
1217                         # is no parent, dispatch will detect type of object and set
1218                         # action appropriately if required (if action is not set)
1219                         $input_params{'action'} ||= "shortlog";
1220                 }
1221                 if ($input_params{'action'} &&
1222                     grep { $_ eq $input_params{'action'} } @wants_base) {
1223                         $input_params{'hash_base'} ||= $refname;
1224                 } else {
1225                         $input_params{'hash'} ||= $refname;
1226                 }
1227         }
1228
1229         # next, handle the 'parent' part, if present
1230         if (defined $parentrefname) {
1231                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1232                 # someproject/blobdiff/oldrev..newrev:/filename
1233                 if ($parentpathname) {
1234                         $parentpathname =~ s,^/+,,;
1235                         $parentpathname =~ s,/$,,;
1236                         $input_params{'file_parent'} ||= $parentpathname;
1237                 } else {
1238                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1239                 }
1240                 # we assume that hash_parent_base is wanted if a path was specified,
1241                 # or if the action wants hash_base instead of hash
1242                 if (defined $input_params{'file_parent'} ||
1243                         grep { $_ eq $input_params{'action'} } @wants_base) {
1244                         $input_params{'hash_parent_base'} ||= $parentrefname;
1245                 } else {
1246                         $input_params{'hash_parent'} ||= $parentrefname;
1247                 }
1248         }
1249
1250         # for the snapshot action, we allow URLs in the form
1251         # $project/snapshot/$hash.ext
1252         # where .ext determines the snapshot and gets removed from the
1253         # passed $refname to provide the $hash.
1254         #
1255         # To be able to tell that $refname includes the format extension, we
1256         # require the following two conditions to be satisfied:
1257         # - the hash input parameter MUST have been set from the $refname part
1258         #   of the URL (i.e. they must be equal)
1259         # - the snapshot format MUST NOT have been defined already (e.g. from
1260         #   CGI parameter sf)
1261         # It's also useless to try any matching unless $refname has a dot,
1262         # so we check for that too
1263         if (defined $input_params{'action'} &&
1264                 $input_params{'action'} eq 'snapshot' &&
1265                 defined $refname && index($refname, '.') != -1 &&
1266                 $refname eq $input_params{'hash'} &&
1267                 !defined $input_params{'snapshot_format'}) {
1268                 # We loop over the known snapshot formats, checking for
1269                 # extensions. Allowed extensions are both the defined suffix
1270                 # (which includes the initial dot already) and the snapshot
1271                 # format key itself, with a prepended dot
1272                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1273                         my $hash = $refname;
1274                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1275                                 next;
1276                         }
1277                         my $sfx = $1;
1278                         # a valid suffix was found, so set the snapshot format
1279                         # and reset the hash parameter
1280                         $input_params{'snapshot_format'} = $fmt;
1281                         $input_params{'hash'} = $hash;
1282                         # we also set the format suffix to the one requested
1283                         # in the URL: this way a request for e.g. .tgz returns
1284                         # a .tgz instead of a .tar.gz
1285                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1286                         last;
1287                 }
1288         }
1289 }
1290
1291 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1292      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1293      $searchtext, $search_regexp, $project_filter);
1294 sub evaluate_and_validate_params {
1295         our $action = $input_params{'action'};
1296         if (defined $action) {
1297                 if (!is_valid_action($action)) {
1298                         die_error(400, "Invalid action parameter");
1299                 }
1300         }
1301
1302         # parameters which are pathnames
1303         our $project = $input_params{'project'};
1304         if (defined $project) {
1305                 if (!is_valid_project($project)) {
1306                         undef $project;
1307                         die_error(404, "No such project");
1308                 }
1309         }
1310
1311         our $project_filter = $input_params{'project_filter'};
1312         if (defined $project_filter) {
1313                 if (!is_valid_pathname($project_filter)) {
1314                         die_error(404, "Invalid project_filter parameter");
1315                 }
1316         }
1317
1318         our $file_name = $input_params{'file_name'};
1319         if (defined $file_name) {
1320                 if (!is_valid_pathname($file_name)) {
1321                         die_error(400, "Invalid file parameter");
1322                 }
1323         }
1324
1325         our $file_parent = $input_params{'file_parent'};
1326         if (defined $file_parent) {
1327                 if (!is_valid_pathname($file_parent)) {
1328                         die_error(400, "Invalid file parent parameter");
1329                 }
1330         }
1331
1332         # parameters which are refnames
1333         our $hash = $input_params{'hash'};
1334         if (defined $hash) {
1335                 if (!is_valid_refname($hash)) {
1336                         die_error(400, "Invalid hash parameter");
1337                 }
1338         }
1339
1340         our $hash_parent = $input_params{'hash_parent'};
1341         if (defined $hash_parent) {
1342                 if (!is_valid_refname($hash_parent)) {
1343                         die_error(400, "Invalid hash parent parameter");
1344                 }
1345         }
1346
1347         our $hash_base = $input_params{'hash_base'};
1348         if (defined $hash_base) {
1349                 if (!is_valid_refname($hash_base)) {
1350                         die_error(400, "Invalid hash base parameter");
1351                 }
1352         }
1353
1354         our @extra_options = @{$input_params{'extra_options'}};
1355         # @extra_options is always defined, since it can only be (currently) set from
1356         # CGI, and $cgi->param() returns the empty array in array context if the param
1357         # is not set
1358         foreach my $opt (@extra_options) {
1359                 if (not exists $allowed_options{$opt}) {
1360                         die_error(400, "Invalid option parameter");
1361                 }
1362                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1363                         die_error(400, "Invalid option parameter for this action");
1364                 }
1365         }
1366
1367         our $hash_parent_base = $input_params{'hash_parent_base'};
1368         if (defined $hash_parent_base) {
1369                 if (!is_valid_refname($hash_parent_base)) {
1370                         die_error(400, "Invalid hash parent base parameter");
1371                 }
1372         }
1373
1374         # other parameters
1375         our $page = $input_params{'page'};
1376         if (defined $page) {
1377                 if ($page =~ m/[^0-9]/) {
1378                         die_error(400, "Invalid page parameter");
1379                 }
1380         }
1381
1382         our $searchtype = $input_params{'searchtype'};
1383         if (defined $searchtype) {
1384                 if ($searchtype =~ m/[^a-z]/) {
1385                         die_error(400, "Invalid searchtype parameter");
1386                 }
1387         }
1388
1389         our $search_use_regexp = $input_params{'search_use_regexp'};
1390
1391         our $searchtext = $input_params{'searchtext'};
1392         our $search_regexp = undef;
1393         if (defined $searchtext) {
1394                 if (length($searchtext) < 2) {
1395                         die_error(403, "At least two characters are required for search parameter");
1396                 }
1397                 if ($search_use_regexp) {
1398                         $search_regexp = $searchtext;
1399                         if (!eval { qr/$search_regexp/; 1; }) {
1400                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1401                                 die_error(400, "Invalid search regexp '$search_regexp'",
1402                                           esc_html($error));
1403                         }
1404                 } else {
1405                         $search_regexp = quotemeta $searchtext;
1406                 }
1407         }
1408 }
1409
1410 # path to the current git repository
1411 our $git_dir;
1412 sub evaluate_git_dir {
1413         our $git_dir = $project ? "$projectroot/$project" : undef;
1414 }
1415
1416 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1417 sub configure_gitweb_features {
1418         # list of supported snapshot formats
1419         our @snapshot_fmts = gitweb_get_feature('snapshot');
1420         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1421
1422         # check that the avatar feature is set to a known provider name,
1423         # and for each provider check if the dependencies are satisfied.
1424         # if the provider name is invalid or the dependencies are not met,
1425         # reset $git_avatar to the empty string.
1426         our ($git_avatar) = gitweb_get_feature('avatar');
1427         if ($git_avatar eq 'gravatar') {
1428                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1429         } elsif ($git_avatar eq 'picon') {
1430                 # no dependencies
1431         } else {
1432                 $git_avatar = '';
1433         }
1434
1435         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1436         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1437 }
1438
1439 sub get_branch_refs {
1440         return ('heads', @extra_branch_refs);
1441 }
1442
1443 # custom error handler: 'die <message>' is Internal Server Error
1444 sub handle_errors_html {
1445         my $msg = shift; # it is already HTML escaped
1446
1447         # to avoid infinite loop where error occurs in die_error,
1448         # change handler to default handler, disabling handle_errors_html
1449         set_message("Error occurred when inside die_error:\n$msg");
1450
1451         # you cannot jump out of die_error when called as error handler;
1452         # the subroutine set via CGI::Carp::set_message is called _after_
1453         # HTTP headers are already written, so it cannot write them itself
1454         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1455 }
1456 set_message(\&handle_errors_html);
1457
1458 our $shown_stale_message = 0;
1459 our $cache_dump = undef;
1460 our $cache_dump_mtime = undef;
1461
1462 # dispatch
1463 my $cache_mode_active;
1464 sub dispatch {
1465         $shown_stale_message = 0;
1466         if (!defined $action) {
1467                 if (defined $hash) {
1468                         $action = git_get_type($hash);
1469                         $action or die_error(404, "Object does not exist");
1470                 } elsif (defined $hash_base && defined $file_name) {
1471                         $action = git_get_type("$hash_base:$file_name");
1472                         $action or die_error(404, "File or directory does not exist");
1473                 } elsif (defined $project) {
1474                         $action = 'summary';
1475                 } else {
1476                         $action = 'frontpage';
1477                 }
1478         }
1479         if (!defined($actions{$action})) {
1480                 die_error(400, "Unknown action");
1481         }
1482         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1483             !$project) {
1484                 die_error(400, "Project needed");
1485         }
1486
1487         my $cached_page = $supported_cache_actions{$action}
1488                 ? cached_action_page($action)
1489                 : undef;
1490         goto DUMPCACHE if $cached_page;
1491         local *SAVEOUT = *STDOUT;
1492         $cache_mode_active = $supported_cache_actions{$action}
1493                 ? cached_action_start($action)
1494                 : undef;
1495
1496         configure_gitweb_features();
1497         $actions{$action}->();
1498
1499         return unless $cache_mode_active;
1500
1501         $cached_page = cached_action_finish($action);
1502         *STDOUT = *SAVEOUT;
1503
1504         DUMPCACHE:
1505
1506         $cache_mode_active = 0;
1507         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1508         binmode STDOUT, ':raw';
1509         our $fcgi_raw_mode = 1;
1510         print expand_gitweb_pi($cached_page, time);
1511         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1512         $fcgi_raw_mode = 0;
1513 }
1514
1515 sub reset_timer {
1516         our $t0 = [ gettimeofday() ]
1517                 if defined $t0;
1518         our $number_of_git_cmds = 0;
1519 }
1520
1521 our $first_request = 1;
1522 our $evaluate_uri_force = undef;
1523 sub run_request {
1524         reset_timer();
1525
1526         # do not reuse stale config or project list from prior FCGI request
1527         our $config_file = '';
1528         our $gitweb_project_owner = undef;
1529
1530         # Only allow GET and HEAD methods
1531         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1532                 print <<EOT;
1533 Status: 405 Method Not Allowed
1534 Content-Type: text/plain
1535 Allow: GET,HEAD
1536
1537 405 Method Not Allowed
1538 EOT
1539                 return;
1540         }
1541
1542         evaluate_uri();
1543         &$evaluate_uri_force() if $evaluate_uri_force;
1544         if ($per_request_config) {
1545                 if (ref($per_request_config) eq 'CODE') {
1546                         $per_request_config->();
1547                 } elsif (!$first_request) {
1548                         evaluate_gitweb_config();
1549                         evaluate_email_obfuscate();
1550                 }
1551         }
1552         check_loadavg();
1553
1554         # $projectroot and $projects_list might be set in gitweb config file
1555         $projects_list ||= $projectroot;
1556
1557         evaluate_query_params();
1558         evaluate_path_info();
1559         evaluate_and_validate_params();
1560         evaluate_git_dir();
1561
1562         dispatch();
1563 }
1564
1565 our $is_last_request = sub { 1 };
1566 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1567 our $CGI = 'CGI';
1568 our $cgi;
1569 our $fcgi_mode = 0;
1570 our $fcgi_nproc_active = 0;
1571 our $fcgi_raw_mode = 0;
1572 sub is_fcgi {
1573         use Errno;
1574         my $stdinfno = fileno STDIN;
1575         return 0 unless defined $stdinfno && $stdinfno == 0;
1576         return 0 unless getsockname STDIN;
1577         return 0 if getpeername STDIN;
1578         return $!{ENOTCONN}?1:0;
1579 }
1580 sub configure_as_fcgi {
1581         return if $fcgi_mode;
1582
1583         require FCGI;
1584         require CGI::Fast;
1585
1586         # We have gone to great effort to make sure that all incoming data has
1587         # been converted from whatever format it was in into UTF-8.  We have
1588         # even taken care to make sure the output handle is in ':utf8' mode.
1589         # Now along comes FCGI and blows it with:
1590         #
1591         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1592         #      and will stop wprking[sic] in a future version of FCGI
1593         #
1594         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1595         # first encodes everything and then calls the original routine, but
1596         # not if $fcgi_raw_mode is true (then we just call the original routine).
1597         #
1598         # Note that we could do this by using utf8::is_utf8 to check instead
1599         # of having a $fcgi_raw_mode global, but that would be slower to run
1600         # the test on each element and much slower than skipping the conversion
1601         # entirely when we know we're outputting raw bytes.
1602         my $orig = \&FCGI::Stream::PRINT;
1603         undef *FCGI::Stream::PRINT;
1604         *FCGI::Stream::PRINT = sub {
1605                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1606                         unless $fcgi_raw_mode;
1607                 goto $orig;
1608         };
1609
1610         our $CGI = 'CGI::Fast';
1611
1612         $fcgi_mode = 1;
1613         $first_request = 0;
1614         my $request_number = 0;
1615         # let each child service 100 requests
1616         our $is_last_request = sub { ++$request_number > 100 };
1617 }
1618 sub evaluate_argv {
1619         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1620         configure_as_fcgi()
1621                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1622
1623         my $nproc_sub = sub {
1624                 my ($arg, $val) = @_;
1625                 return unless eval { require FCGI::ProcManager; 1; };
1626                 $fcgi_nproc_active = 1;
1627                 my $proc_manager = FCGI::ProcManager->new({
1628                         n_processes => $val,
1629                 });
1630                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1631                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1632                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1633         };
1634         if (@ARGV) {
1635                 require Getopt::Long;
1636                 Getopt::Long::GetOptions(
1637                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1638                         'nproc|n=i' => $nproc_sub,
1639                 );
1640         };
1641         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1642                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1643         }
1644 }
1645
1646 sub run {
1647         evaluate_gitweb_config();
1648         evaluate_encoding();
1649         evaluate_email_obfuscate();
1650         evaluate_git_version();
1651         my ($mu, $hl, $subroutine) = ($my_uri, $home_link, '');
1652         $subroutine .= '$my_uri = $mu;' if defined $my_uri && $my_uri ne '';
1653         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1654         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1655         $first_request = 1;
1656         evaluate_argv();
1657
1658         $pre_listen_hook->()
1659                 if $pre_listen_hook;
1660
1661  REQUEST:
1662         while ($cgi = $CGI->new()) {
1663                 $pre_dispatch_hook->()
1664                         if $pre_dispatch_hook;
1665
1666                 run_request();
1667
1668                 $post_dispatch_hook->()
1669                         if $post_dispatch_hook;
1670                 $first_request = 0;
1671
1672                 last REQUEST if ($is_last_request->());
1673         }
1674
1675  DONE_GITWEB:
1676         1;
1677 }
1678
1679 run();
1680
1681 if (defined caller) {
1682         # wrapped in a subroutine processing requests,
1683         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1684         return;
1685 } else {
1686         # pure CGI script, serving single request
1687         exit;
1688 }
1689
1690 ## ======================================================================
1691 ## action links
1692
1693 # possible values of extra options
1694 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1695 # -replay => 1      - start from a current view (replay with modifications)
1696 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1697 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1698 sub href {
1699         my %params = @_;
1700         # default is to use -absolute url() i.e. $my_uri
1701         my $href = $params{-full} ? $my_url : $my_uri;
1702
1703         # implicit -replay, must be first of implicit params
1704         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1705
1706         $params{'project'} = $project unless exists $params{'project'};
1707
1708         if ($params{-replay}) {
1709                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1710                         if (!exists $params{$name}) {
1711                                 $params{$name} = $input_params{$name};
1712                         }
1713                 }
1714         }
1715
1716         my $use_pathinfo = gitweb_check_feature('pathinfo');
1717         if (defined $params{'project'} &&
1718             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1719                 # try to put as many parameters as possible in PATH_INFO:
1720                 #   - project name
1721                 #   - action
1722                 #   - hash_parent or hash_parent_base:/file_parent
1723                 #   - hash or hash_base:/filename
1724                 #   - the snapshot_format as an appropriate suffix
1725
1726                 # When the script is the root DirectoryIndex for the domain,
1727                 # $href here would be something like http://gitweb.example.com/
1728                 # Thus, we strip any trailing / from $href, to spare us double
1729                 # slashes in the final URL
1730                 $href =~ s,/$,,;
1731
1732                 # Then add the project name, if present
1733                 $href .= "/".esc_path_info($params{'project'});
1734                 delete $params{'project'};
1735
1736                 # since we destructively absorb parameters, we keep this
1737                 # boolean that remembers if we're handling a snapshot
1738                 my $is_snapshot = $params{'action'} eq 'snapshot';
1739
1740                 # Summary just uses the project path URL, any other action is
1741                 # added to the URL
1742                 if (defined $params{'action'}) {
1743                         $href .= "/".esc_path_info($params{'action'})
1744                                 unless $params{'action'} eq 'summary';
1745                         delete $params{'action'};
1746                 }
1747
1748                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1749                 # stripping nonexistent or useless pieces
1750                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1751                         || $params{'hash_parent'} || $params{'hash'});
1752                 if (defined $params{'hash_base'}) {
1753                         if (defined $params{'hash_parent_base'}) {
1754                                 $href .= esc_path_info($params{'hash_parent_base'});
1755                                 # skip the file_parent if it's the same as the file_name
1756                                 if (defined $params{'file_parent'}) {
1757                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1758                                                 delete $params{'file_parent'};
1759                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1760                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1761                                                 delete $params{'file_parent'};
1762                                         }
1763                                 }
1764                                 $href .= "..";
1765                                 delete $params{'hash_parent'};
1766                                 delete $params{'hash_parent_base'};
1767                         } elsif (defined $params{'hash_parent'}) {
1768                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1769                                 delete $params{'hash_parent'};
1770                         }
1771
1772                         $href .= esc_path_info($params{'hash_base'});
1773                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1774                                 $href .= ":/".esc_path_info($params{'file_name'});
1775                                 delete $params{'file_name'};
1776                         }
1777                         delete $params{'hash'};
1778                         delete $params{'hash_base'};
1779                 } elsif (defined $params{'hash'}) {
1780                         $href .= esc_path_info($params{'hash'});
1781                         delete $params{'hash'};
1782                 }
1783
1784                 # If the action was a snapshot, we can absorb the
1785                 # snapshot_format parameter too
1786                 if ($is_snapshot) {
1787                         my $fmt = $params{'snapshot_format'};
1788                         # snapshot_format should always be defined when href()
1789                         # is called, but just in case some code forgets, we
1790                         # fall back to the default
1791                         $fmt ||= $snapshot_fmts[0];
1792                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1793                         delete $params{'snapshot_format'};
1794                 }
1795         }
1796
1797         # now encode the parameters explicitly
1798         my @result = ();
1799         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1800                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1801                 if (defined $params{$name}) {
1802                         if (ref($params{$name}) eq "ARRAY") {
1803                                 foreach my $par (@{$params{$name}}) {
1804                                         push @result, $symbol . "=" . esc_param($par);
1805                                 }
1806                         } else {
1807                                 push @result, $symbol . "=" . esc_param($params{$name});
1808                         }
1809                 }
1810         }
1811         $href .= "?" . join(';', @result) if scalar @result;
1812
1813         # final transformation: trailing spaces must be escaped (URI-encoded)
1814         $href =~ s/(\s+)$/CGI::escape($1)/e;
1815
1816         if ($params{-anchor}) {
1817                 $href .= "#".esc_param($params{-anchor});
1818         }
1819
1820         return $href;
1821 }
1822
1823
1824 ## ======================================================================
1825 ## validation, quoting/unquoting and escaping
1826
1827 sub is_valid_action {
1828         my $input = shift;
1829         return undef unless exists $actions{$input};
1830         return 1;
1831 }
1832
1833 sub is_valid_project {
1834         my $input = shift;
1835
1836         return unless defined $input;
1837         if (!is_valid_pathname($input) ||
1838                 !(-d "$projectroot/$input") ||
1839                 !check_export_ok("$projectroot/$input") ||
1840                 ($strict_export && !project_in_list($input))) {
1841                 return undef;
1842         } else {
1843                 return 1;
1844         }
1845 }
1846
1847 sub is_valid_pathname {
1848         my $input = shift;
1849
1850         return undef unless defined $input;
1851         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1852         # at the beginning, at the end, and between slashes.
1853         # also this catches doubled slashes
1854         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1855                 return undef;
1856         }
1857         # no null characters
1858         if ($input =~ m!\0!) {
1859                 return undef;
1860         }
1861         return 1;
1862 }
1863
1864 sub is_valid_ref_format {
1865         my $input = shift;
1866
1867         return undef unless defined $input;
1868         # restrictions on ref name according to git-check-ref-format
1869         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1870                 return undef;
1871         }
1872         return 1;
1873 }
1874
1875 sub is_valid_refname {
1876         my $input = shift;
1877
1878         return undef unless defined $input;
1879         # textual hashes are O.K.
1880         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1881                 return 1;
1882         }
1883         # it must be correct pathname
1884         is_valid_pathname($input) or return undef;
1885         # check git-check-ref-format restrictions
1886         is_valid_ref_format($input) or return undef;
1887         return 1;
1888 }
1889
1890 # decode sequences of octets in utf8 into Perl's internal form,
1891 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1892 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1893 sub to_utf8 {
1894         my $str = shift;
1895         return undef unless defined $str;
1896
1897         if (utf8::is_utf8($str) || utf8::decode($str)) {
1898                 return $str;
1899         } else {
1900                 return $encode_object->decode($str, Encode::FB_DEFAULT);
1901         }
1902 }
1903
1904 # quote unsafe chars, but keep the slash, even when it's not
1905 # correct, but quoted slashes look too horrible in bookmarks
1906 sub esc_param {
1907         my $str = shift;
1908         return undef unless defined $str;
1909         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1910         $str =~ s/ /\+/g;
1911         return $str;
1912 }
1913
1914 # the quoting rules for path_info fragment are slightly different
1915 sub esc_path_info {
1916         my $str = shift;
1917         return undef unless defined $str;
1918
1919         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1920         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1921
1922         return $str;
1923 }
1924
1925 # quote unsafe chars in whole URL, so some characters cannot be quoted
1926 sub esc_url {
1927         my $str = shift;
1928         return undef unless defined $str;
1929         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1930         $str =~ s/ /\+/g;
1931         return $str;
1932 }
1933
1934 # quote unsafe characters in HTML attributes
1935 sub esc_attr {
1936
1937         # for XHTML conformance escaping '"' to '&quot;' is not enough
1938         return esc_html(@_);
1939 }
1940
1941 # replace invalid utf8 character with SUBSTITUTION sequence
1942 sub esc_html {
1943         my $str = shift;
1944         my %opts = @_;
1945
1946         return undef unless defined $str;
1947
1948         $str = to_utf8($str);
1949         $str = $cgi->escapeHTML($str);
1950         if ($opts{'-nbsp'}) {
1951                 $str =~ s/ /&#160;/g;
1952         }
1953         use bytes;
1954         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
1955         return $str;
1956 }
1957
1958 # quote control characters and escape filename to HTML
1959 sub esc_path {
1960         my $str = shift;
1961         my %opts = @_;
1962
1963         return undef unless defined $str;
1964
1965         $str = to_utf8($str);
1966         $str = $cgi->escapeHTML($str);
1967         if ($opts{'-nbsp'}) {
1968                 $str =~ s/ /&#160;/g;
1969         }
1970         use bytes;
1971         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
1972         return $str;
1973 }
1974
1975 # Sanitize for use in XHTML + application/xml+xhtm (valid XML 1.0)
1976 sub sanitize {
1977         my $str = shift;
1978
1979         return undef unless defined $str;
1980
1981         $str = to_utf8($str);
1982         use bytes;
1983         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
1984         return $str;
1985 }
1986
1987 # Make control characters "printable", using character escape codes (CEC)
1988 sub quot_cec {
1989         my $cntrl = shift;
1990         my %opts = @_;
1991         my %es = ( # character escape codes, aka escape sequences
1992                 "\t" => '\t',   # tab            (HT)
1993                 "\n" => '\n',   # line feed      (LF)
1994                 "\r" => '\r',   # carrige return (CR)
1995                 "\f" => '\f',   # form feed      (FF)
1996                 "\b" => '\b',   # backspace      (BS)
1997                 "\a" => '\a',   # alarm (bell)   (BEL)
1998                 "\e" => '\e',   # escape         (ESC)
1999                 "\013" => '\v', # vertical tab   (VT)
2000                 "\000" => '\0', # nul character  (NUL)
2001         );
2002         my $chr = ( (exists $es{$cntrl})
2003                     ? $es{$cntrl}
2004                     : sprintf('\x%02x', ord($cntrl)) );
2005         if ($opts{-nohtml}) {
2006                 return $chr;
2007         } else {
2008                 return "<span class=\"cntrl\">$chr</span>";
2009         }
2010 }
2011
2012 # Alternatively use unicode control pictures codepoints,
2013 # Unicode "printable representation" (PR)
2014 sub quot_upr {
2015         my $cntrl = shift;
2016         my %opts = @_;
2017
2018         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2019         if ($opts{-nohtml}) {
2020                 return $chr;
2021         } else {
2022                 return "<span class=\"cntrl\">$chr</span>";
2023         }
2024 }
2025
2026 # git may return quoted and escaped filenames
2027 sub unquote {
2028         my $str = shift;
2029
2030         sub unq {
2031                 my $seq = shift;
2032                 my %es = ( # character escape codes, aka escape sequences
2033                         't' => "\t",   # tab            (HT, TAB)
2034                         'n' => "\n",   # newline        (NL)
2035                         'r' => "\r",   # return         (CR)
2036                         'f' => "\f",   # form feed      (FF)
2037                         'b' => "\b",   # backspace      (BS)
2038                         'a' => "\a",   # alarm (bell)   (BEL)
2039                         'e' => "\e",   # escape         (ESC)
2040                         'v' => "\013", # vertical tab   (VT)
2041                 );
2042
2043                 if ($seq =~ m/^[0-7]{1,3}$/) {
2044                         # octal char sequence
2045                         return chr(oct($seq));
2046                 } elsif (exists $es{$seq}) {
2047                         # C escape sequence, aka character escape code
2048                         return $es{$seq};
2049                 }
2050                 # quoted ordinary character
2051                 return $seq;
2052         }
2053
2054         if ($str =~ m/^"(.*)"$/) {
2055                 # needs unquoting
2056                 $str = $1;
2057                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2058         }
2059         return $str;
2060 }
2061
2062 # escape tabs (convert tabs to spaces)
2063 sub untabify {
2064         my $line = shift;
2065
2066         while ((my $pos = index($line, "\t")) != -1) {
2067                 if (my $count = (8 - ($pos % 8))) {
2068                         my $spaces = ' ' x $count;
2069                         $line =~ s/\t/$spaces/;
2070                 }
2071         }
2072
2073         return $line;
2074 }
2075
2076 sub project_in_list {
2077         my $project = shift;
2078         my @list = git_get_projects_list();
2079         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2080 }
2081
2082 sub cached_page_precondition_check {
2083         my $action = shift;
2084         return 1 unless
2085                 $action eq 'summary' &&
2086                 $projlist_cache_lifetime > 0 &&
2087                 gitweb_check_feature('forks');
2088
2089         # Note that ALL the 'forkchange' logic is in this function.
2090         # It does NOT belong in cached_action_page NOR in cached_action_start
2091         # NOR in cached_action_finish.  None of those functions should know anything
2092         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2093
2094         # besides the basic 'changed' "$action.changed" check, we may only use
2095         # a summary cache if:
2096         #
2097         #   1) we are not using a project list cache file
2098         #   -OR-
2099         #   2) we are not using the 'forks' feature
2100         #   -OR-
2101         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2102         #   -OR-
2103         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2104         #   -OR-
2105         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2106         #
2107         # Otherwise we must re-generate the cache because we've had a fork change
2108         # (either a fork was added or a fork was removed) AND the change has been
2109         # picked up in the cache file AND we've not got that in our cached copy
2110         #
2111         # For (5) regenerating the cached page wouldn't get us anything if the project
2112         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2113         # forks information comes from the project cache file and it's clearly not
2114         # picked up the changes yet so we may continue to use a cached page until it does.
2115
2116         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2117         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2118         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2119         return 1 unless defined($fc_mt) || defined($afc_mt);
2120         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2121         return 1 unless $prj_mt;
2122         my $old_mt = $fc_mt;
2123         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2124         return 1 if $old_mt > $prj_mt;
2125
2126         # We're going to regenerate the cached page because we know the project cache
2127         # has new fork information that we cannot possibly have in our cached copy.
2128         #
2129         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2130         # them is older than the project cache and one of them is newer, we still
2131         # need to regenerate the page cache, but we will also need to do it again
2132         # in the future because there's yet another fork update not yet in the cache.
2133         #
2134         # So we make sure to touch "$action.changed" to force a cache regeneration
2135         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2136         # they're older than the project cache (they've served their purpose, we're
2137         # forcing a page regeneration by touching "$action.changed" but the project
2138         # cache was rebuilt since then so there are no more pending fork updates to
2139         # pick up in the future and they need to go).
2140
2141         # For best results, the external code that touches 'forkchange' should always
2142         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2143         # if it does not already exist.  That way the cached page will be regenerated
2144         # each time it's requested and ANY fork updates are available in the proj
2145         # cache rather than waiting until they all are before updating.
2146
2147         # Note that we take a shortcut here and will zap 'forkchange' since we know
2148         # that it only affects the 'summary' cache.  If, in the future, it affects
2149         # other cache types, it will first need to be propogated down to
2150         # "$action.forkchange" for those types before we zap it.
2151
2152         my $fd;
2153         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2154         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2155         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2156
2157         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2158         # one and not the other.
2159
2160         if (defined $fc_mt && ! defined $afc_mt) {
2161                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2162                 -e "$htmlcd/$action.forkchange" and
2163                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2164                 unlink "$htmlcd/forkchange";
2165         }
2166
2167         return 0;
2168 }
2169
2170 sub cached_action_page {
2171         my $action = shift;
2172
2173         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2174         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2175         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2176         return undef unless cached_page_precondition_check($action);
2177         open my $fd, '<', "$htmlcd/$action" or return undef;
2178         binmode $fd;
2179         local $/;
2180         my $cached_page = <$fd>;
2181         close $fd or return undef;
2182         return $cached_page;
2183 }
2184
2185 package Git::Gitweb::CacheFile;
2186
2187 sub TIEHANDLE {
2188         use POSIX qw(:fcntl_h);
2189         my $class = shift;
2190         my $cachefile = shift;
2191
2192         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2193                 or return undef;
2194         $$self->{'cachefile'} = $cachefile;
2195         $$self->{'opened'} = 1;
2196         $$self->{'contents'} = '';
2197         return bless $self, $class;
2198 }
2199
2200 sub CLOSE {
2201         my $self = shift;
2202         if ($$self->{'opened'}) {
2203                 $$self->{'opened'} = 0;
2204                 my $result = close $self;
2205                 unlink $$self->{'cachefile'} unless $result;
2206                 return $result;
2207         }
2208         return 0;
2209 }
2210
2211 sub DESTROY {
2212         my $self = shift;
2213         if ($$self->{'opened'}) {
2214                 $self->CLOSE() and unlink $$self->{'cachefile'};
2215         }
2216 }
2217
2218 sub PRINT {
2219         my $self = shift;
2220         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2221         print $self @_ if $$self->{'opened'};
2222         $$self->{'contents'} .= join('', @_);
2223         return 1;
2224 }
2225
2226 sub PRINTF {
2227         my $self = shift;
2228         my $template = shift;
2229         return $self->PRINT(sprintf $template, @_);
2230 }
2231
2232 sub contents {
2233         my $self = shift;
2234         return $$self->{'contents'};
2235 }
2236
2237 package main;
2238
2239 # Caller is responsible for preserving STDOUT beforehand if needed
2240 sub cached_action_start {
2241         my $action = shift;
2242
2243         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2244         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2245         return undef unless -d $htmlcd;
2246         if (-e "$htmlcd/changed") {
2247                 foreach my $cacheable (keys(%html_cache_actions)) {
2248                         next unless $supported_cache_actions{$cacheable} &&
2249                                     $html_cache_actions{$cacheable};
2250                         my $fd;
2251                         open $fd, '>', "$htmlcd/$cacheable.changed"
2252                         and close $fd;
2253                 }
2254                 unlink "$htmlcd/changed";
2255         }
2256         local *CACHEFILE;
2257         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2258         *STDOUT = *CACHEFILE;
2259         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2260         return 1;
2261 }
2262
2263 # Caller is responsible for restoring STDOUT afterward if needed
2264 sub cached_action_finish {
2265         my $action = shift;
2266
2267         use File::Spec;
2268
2269         my $obj = tied *STDOUT;
2270         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2271         my $cached_page = $obj->contents;
2272         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2273         # Do not leave STDOUT file descriptor invalid!
2274         local *NULL;
2275         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2276         *STDOUT = *NULL;
2277         return $cached_page unless $result;
2278         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2279         return $cached_page unless -d $htmlcd;
2280         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2281         return $cached_page;
2282 }
2283
2284 my %expand_pi_subs;
2285 BEGIN {%expand_pi_subs = (
2286         'age_string'              => \&age_string,
2287         'age_string_date'         => \&age_string_date,
2288         'age_string_age'          => \&age_string_age,
2289         'compute_timed_interval'  => \&compute_timed_interval,
2290         'compute_commands_count'  => \&compute_commands_count,
2291 )}
2292
2293 # Expands any <?gitweb...> processing instructions and returns the result
2294 sub expand_gitweb_pi {
2295         my $page = shift;
2296         $page .= '';
2297         my @time_now = gettimeofday();
2298         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2299                   {defined($1) ?
2300                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2301                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2302                                   '') :
2303                           '' }goes;
2304         return $page;
2305 }
2306
2307 ## ----------------------------------------------------------------------
2308 ## HTML aware string manipulation
2309
2310 # Try to chop given string on a word boundary between position
2311 # $len and $len+$add_len. If there is no word boundary there,
2312 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2313 # (marking chopped part) would be longer than given string.
2314 sub chop_str {
2315         my $str = shift;
2316         my $len = shift;
2317         my $add_len = shift || 10;
2318         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2319
2320         # Make sure perl knows it is utf8 encoded so we don't
2321         # cut in the middle of a utf8 multibyte char.
2322         $str = to_utf8($str);
2323
2324         # allow only $len chars, but don't cut a word if it would fit in $add_len
2325         # if it doesn't fit, cut it if it's still longer than the dots we would add
2326         # remove chopped character entities entirely
2327
2328         # when chopping in the middle, distribute $len into left and right part
2329         # return early if chopping wouldn't make string shorter
2330         if ($where eq 'center') {
2331                 return $str if ($len + 5 >= length($str)); # filler is length 5
2332                 $len = int($len/2);
2333         } else {
2334                 return $str if ($len + 4 >= length($str)); # filler is length 4
2335         }
2336
2337         # regexps: ending and beginning with word part up to $add_len
2338         my $endre = qr/.{$len}\w{0,$add_len}/;
2339         my $begre = qr/\w{0,$add_len}.{$len}/;
2340
2341         if ($where eq 'left') {
2342                 $str =~ m/^(.*?)($begre)$/;
2343                 my ($lead, $body) = ($1, $2);
2344                 if (length($lead) > 4) {
2345                         $lead = " ...";
2346                 }
2347                 return "$lead$body";
2348
2349         } elsif ($where eq 'center') {
2350                 $str =~ m/^($endre)(.*)$/;
2351                 my ($left, $str)  = ($1, $2);
2352                 $str =~ m/^(.*?)($begre)$/;
2353                 my ($mid, $right) = ($1, $2);
2354                 if (length($mid) > 5) {
2355                         $mid = " ... ";
2356                 }
2357                 return "$left$mid$right";
2358
2359         } else {
2360                 $str =~ m/^($endre)(.*)$/;
2361                 my $body = $1;
2362                 my $tail = $2;
2363                 if (length($tail) > 4) {
2364                         $tail = "... ";
2365                 }
2366                 return "$body$tail";
2367         }
2368 }
2369
2370 # pass-through email filter, obfuscating it when possible
2371 sub email_obfuscate {
2372         our $email;
2373         my ($str) = @_;
2374         if ($email) {
2375                 $str = $email->escape_html($str);
2376                 # Stock HTML::Email::Obfuscate version likes to produce
2377                 # invalid XHTML...
2378                 $str =~ s#<(/?)B>#<$1b>#g;
2379                 return $str;
2380         } else {
2381                 $str = esc_html($str);
2382                 $str =~ s/@/&#x40;/;
2383                 return $str;
2384         }
2385 }
2386
2387 # takes the same arguments as chop_str, but also wraps a <span> around the
2388 # result with a title attribute if it does get chopped. Additionally, the
2389 # string is HTML-escaped.
2390 sub chop_and_escape_str {
2391         my ($str) = @_;
2392
2393         my $chopped = chop_str(@_);
2394         $str = to_utf8($str);
2395         if ($chopped eq $str) {
2396                 return email_obfuscate($chopped);
2397         } else {
2398                 use bytes;
2399                 $str =~ s/[[:cntrl:]]/?/g;
2400                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2401         }
2402 }
2403
2404 # Highlight selected fragments of string, using given CSS class,
2405 # and escape HTML.  It is assumed that fragments do not overlap.
2406 # Regions are passed as list of pairs (array references).
2407 #
2408 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2409 # '<span class="mark">foo</span>bar'
2410 sub esc_html_hl_regions {
2411         my ($str, $css_class, @sel) = @_;
2412         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2413         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2414         return esc_html($str, %opts) unless @sel;
2415
2416         my $out = '';
2417         my $pos = 0;
2418
2419         for my $s (@sel) {
2420                 my ($begin, $end) = @$s;
2421
2422                 # Don't create empty <span> elements.
2423                 next if $end <= $begin;
2424
2425                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2426                                        %opts);
2427
2428                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2429                         if ($begin - $pos > 0);
2430                 $out .= $cgi->span({-class => $css_class}, $escaped);
2431
2432                 $pos = $end;
2433         }
2434         $out .= esc_html(substr($str, $pos), %opts)
2435                 if ($pos < length($str));
2436
2437         return $out;
2438 }
2439
2440 # return positions of beginning and end of each match
2441 sub matchpos_list {
2442         my ($str, $regexp) = @_;
2443         return unless (defined $str && defined $regexp);
2444
2445         my @matches;
2446         while ($str =~ /$regexp/g) {
2447                 push @matches, [$-[0], $+[0]];
2448         }
2449         return @matches;
2450 }
2451
2452 # highlight match (if any), and escape HTML
2453 sub esc_html_match_hl {
2454         my ($str, $regexp) = @_;
2455         return esc_html($str) unless defined $regexp;
2456
2457         my @matches = matchpos_list($str, $regexp);
2458         return esc_html($str) unless @matches;
2459
2460         return esc_html_hl_regions($str, 'match', @matches);
2461 }
2462
2463
2464 # highlight match (if any) of shortened string, and escape HTML
2465 sub esc_html_match_hl_chopped {
2466         my ($str, $chopped, $regexp) = @_;
2467         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2468
2469         my @matches = matchpos_list($str, $regexp);
2470         return esc_html($chopped) unless @matches;
2471
2472         # filter matches so that we mark chopped string
2473         my $tail = "... "; # see chop_str
2474         unless ($chopped =~ s/\Q$tail\E$//) {
2475                 $tail = '';
2476         }
2477         my $chop_len = length($chopped);
2478         my $tail_len = length($tail);
2479         my @filtered;
2480
2481         for my $m (@matches) {
2482                 if ($m->[0] > $chop_len) {
2483                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2484                         last;
2485                 } elsif ($m->[1] > $chop_len) {
2486                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2487                         last;
2488                 }
2489                 push @filtered, $m;
2490         }
2491
2492         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2493 }
2494
2495 ## ----------------------------------------------------------------------
2496 ## functions returning short strings
2497
2498 # CSS class for given age epoch value (in seconds)
2499 # and reference time (optional, defaults to now) as second value
2500 sub age_class {
2501         my ($age_epoch, $time_now) = @_;
2502         return "noage" unless defined $age_epoch;
2503         defined $time_now or $time_now = time;
2504         my $age = $time_now - $age_epoch;
2505
2506         if ($age < 60*60*2) {
2507                 return "age0";
2508         } elsif ($age < 60*60*24*2) {
2509                 return "age1";
2510         } else {
2511                 return "age2";
2512         }
2513 }
2514
2515 # convert age epoch in seconds to "nn units ago" string
2516 # reference time used is now unless second argument passed in
2517 # to get the old behavior, pass 0 as the first argument and
2518 # the time in seconds as the second
2519 sub age_string {
2520         my ($age_epoch, $time_now) = @_;
2521         return "unknown" unless defined $age_epoch;
2522         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2523         defined $time_now or $time_now = time;
2524         my $age = $time_now - $age_epoch;
2525         my $age_str;
2526
2527         if ($age > 60*60*24*365*2) {
2528                 $age_str = (int $age/60/60/24/365);
2529                 $age_str .= " years ago";
2530         } elsif ($age > 60*60*24*(365/12)*2) {
2531                 $age_str = int $age/60/60/24/(365/12);
2532                 $age_str .= " months ago";
2533         } elsif ($age > 60*60*24*7*2) {
2534                 $age_str = int $age/60/60/24/7;
2535                 $age_str .= " weeks ago";
2536         } elsif ($age > 60*60*24*2) {
2537                 $age_str = int $age/60/60/24;
2538                 $age_str .= " days ago";
2539         } elsif ($age > 60*60*2) {
2540                 $age_str = int $age/60/60;
2541                 $age_str .= " hours ago";
2542         } elsif ($age > 60*2) {
2543                 $age_str = int $age/60;
2544                 $age_str .= " min ago";
2545         } elsif ($age > 2) {
2546                 $age_str = int $age;
2547                 $age_str .= " sec ago";
2548         } else {
2549                 $age_str .= " right now";
2550         }
2551         return $age_str;
2552 }
2553
2554 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2555 # this is typically shown to the user directly with the age_string_age as a title
2556 sub age_string_date {
2557         my ($age_epoch, $time_now) = @_;
2558         return "unknown" unless defined $age_epoch;
2559         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2560         defined $time_now or $time_now = time;
2561         my $age = $time_now - $age_epoch;
2562
2563         if ($age > 60*60*24*7*2) {
2564                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2565                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2566         } else {
2567                 return age_string($age_epoch, $time_now);
2568         }
2569 }
2570
2571 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2572 # this is typically used for the 'title' attribute so it will show as a tooltip
2573 sub age_string_age {
2574         my ($age_epoch, $time_now) = @_;
2575         return "unknown" unless defined $age_epoch;
2576         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2577         defined $time_now or $time_now = time;
2578         my $age = $time_now - $age_epoch;
2579
2580         if ($age > 60*60*24*7*2) {
2581                 return age_string($age_epoch, $time_now);
2582         } else {
2583                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2584                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2585         }
2586 }
2587
2588 use constant {
2589         S_IFINVALID => 0030000,
2590         S_IFGITLINK => 0160000,
2591 };
2592
2593 # submodule/subproject, a commit object reference
2594 sub S_ISGITLINK {
2595         my $mode = shift;
2596
2597         return (($mode & S_IFMT) == S_IFGITLINK)
2598 }
2599
2600 # convert file mode in octal to symbolic file mode string
2601 sub mode_str {
2602         my $mode = oct shift;
2603
2604         if (S_ISGITLINK($mode)) {
2605                 return 'm---------';
2606         } elsif (S_ISDIR($mode & S_IFMT)) {
2607                 return 'drwxr-xr-x';
2608         } elsif (S_ISLNK($mode)) {
2609                 return 'lrwxrwxrwx';
2610         } elsif (S_ISREG($mode)) {
2611                 # git cares only about the executable bit
2612                 if ($mode & S_IXUSR) {
2613                         return '-rwxr-xr-x';
2614                 } else {
2615                         return '-rw-r--r--';
2616                 };
2617         } else {
2618                 return '----------';
2619         }
2620 }
2621
2622 # convert file mode in octal to file type string
2623 sub file_type {
2624         my $mode = shift;
2625
2626         if ($mode !~ m/^[0-7]+$/) {
2627                 return $mode;
2628         } else {
2629                 $mode = oct $mode;
2630         }
2631
2632         if (S_ISGITLINK($mode)) {
2633                 return "submodule";
2634         } elsif (S_ISDIR($mode & S_IFMT)) {
2635                 return "directory";
2636         } elsif (S_ISLNK($mode)) {
2637                 return "symlink";
2638         } elsif (S_ISREG($mode)) {
2639                 return "file";
2640         } else {
2641                 return "unknown";
2642         }
2643 }
2644
2645 # convert file mode in octal to file type description string
2646 sub file_type_long {
2647         my $mode = shift;
2648
2649         if ($mode !~ m/^[0-7]+$/) {
2650                 return $mode;
2651         } else {
2652                 $mode = oct $mode;
2653         }
2654
2655         if (S_ISGITLINK($mode)) {
2656                 return "submodule";
2657         } elsif (S_ISDIR($mode & S_IFMT)) {
2658                 return "directory";
2659         } elsif (S_ISLNK($mode)) {
2660                 return "symlink";
2661         } elsif (S_ISREG($mode)) {
2662                 if ($mode & S_IXUSR) {
2663                         return "executable";
2664                 } else {
2665                         return "file";
2666                 };
2667         } else {
2668                 return "unknown";
2669         }
2670 }
2671
2672
2673 ## ----------------------------------------------------------------------
2674 ## functions returning short HTML fragments, or transforming HTML fragments
2675 ## which don't belong to other sections
2676
2677 # format line of commit message.
2678 sub format_log_line_html {
2679         my $line = shift;
2680
2681         $line = esc_html($line, -nbsp=>1);
2682         $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
2683                 $cgi->a({-href => href(action=>"object", hash=>$1),
2684                                         -class => "text"}, $1);
2685         }eg unless $line =~ /^\s*git-svn-id:/;
2686
2687         return $line;
2688 }
2689
2690 # format marker of refs pointing to given object
2691
2692 # the destination action is chosen based on object type and current context:
2693 # - for annotated tags, we choose the tag view unless it's the current view
2694 #   already, in which case we go to shortlog view
2695 # - for other refs, we keep the current view if we're in history, shortlog or
2696 #   log view, and select shortlog otherwise
2697 sub format_ref_marker {
2698         my ($refs, $id) = @_;
2699         my $markers = '';
2700
2701         if (defined $refs->{$id}) {
2702                 foreach my $ref (@{$refs->{$id}}) {
2703                         # this code exploits the fact that non-lightweight tags are the
2704                         # only indirect objects, and that they are the only objects for which
2705                         # we want to use tag instead of shortlog as action
2706                         my ($type, $name) = qw();
2707                         my $indirect = ($ref =~ s/\^\{\}$//);
2708                         # e.g. tags/v2.6.11 or heads/next
2709                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2710                                 $type = $1;
2711                                 $name = $2;
2712                         } else {
2713                                 $type = "ref";
2714                                 $name = $ref;
2715                         }
2716
2717                         my $class = $type;
2718                         $class .= " indirect" if $indirect;
2719
2720                         my $dest_action = "shortlog";
2721
2722                         if ($indirect) {
2723                                 $dest_action = "tag" unless $action eq "tag";
2724                         } elsif ($action =~ /^(history|(short)?log)$/) {
2725                                 $dest_action = $action;
2726                         }
2727
2728                         my $dest = "";
2729                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2730                         $dest .= $ref;
2731
2732                         my $link = $cgi->a({
2733                                 -href => href(
2734                                         action=>$dest_action,
2735                                         hash=>$dest
2736                                 )}, $name);
2737
2738                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2739                                 $link . "</span>";
2740                 }
2741         }
2742
2743         if ($markers) {
2744                 return '<span class="refs">'. $markers . '</span>';
2745         } else {
2746                 return "";
2747         }
2748 }
2749
2750 # format, perhaps shortened and with markers, title line
2751 sub format_subject_html {
2752         my ($long, $short, $href, $extra) = @_;
2753         $extra = '' unless defined($extra);
2754
2755         if (length($short) < length($long)) {
2756                 use bytes;
2757                 $long =~ s/[[:cntrl:]]/?/g;
2758                 return $cgi->a({-href => $href, -class => "list subject",
2759                                 -title => to_utf8($long)},
2760                        esc_html($short)) . $extra;
2761         } else {
2762                 return $cgi->a({-href => $href, -class => "list subject"},
2763                        esc_html($long)) . $extra;
2764         }
2765 }
2766
2767 # Rather than recomputing the url for an email multiple times, we cache it
2768 # after the first hit. This gives a visible benefit in views where the avatar
2769 # for the same email is used repeatedly (e.g. shortlog).
2770 # The cache is shared by all avatar engines (currently gravatar only), which
2771 # are free to use it as preferred. Since only one avatar engine is used for any
2772 # given page, there's no risk for cache conflicts.
2773 our %avatar_cache = ();
2774
2775 # Compute the picon url for a given email, by using the picon search service over at
2776 # http://www.cs.indiana.edu/picons/search.html
2777 sub picon_url {
2778         my $email = lc shift;
2779         if (!$avatar_cache{$email}) {
2780                 my ($user, $domain) = split('@', $email);
2781                 $avatar_cache{$email} =
2782                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2783                         "$domain/$user/" .
2784                         "users+domains+unknown/up/single";
2785         }
2786         return $avatar_cache{$email};
2787 }
2788
2789 # Compute the gravatar url for a given email, if it's not in the cache already.
2790 # Gravatar stores only the part of the URL before the size, since that's the
2791 # one computationally more expensive. This also allows reuse of the cache for
2792 # different sizes (for this particular engine).
2793 sub gravatar_url {
2794         my $email = lc shift;
2795         my $size = shift;
2796         $avatar_cache{$email} ||=
2797                 "//www.gravatar.com/avatar/" .
2798                         Digest::MD5::md5_hex($email) . "?s=";
2799         return $avatar_cache{$email} . $size;
2800 }
2801
2802 # Insert an avatar for the given $email at the given $size if the feature
2803 # is enabled.
2804 sub git_get_avatar {
2805         my ($email, %opts) = @_;
2806         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2807         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2808         $opts{-size} ||= 'default';
2809         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2810         my $url = "";
2811         if ($git_avatar eq 'gravatar') {
2812                 $url = gravatar_url($email, $size);
2813         } elsif ($git_avatar eq 'picon') {
2814                 $url = picon_url($email);
2815         }
2816         # Other providers can be added by extending the if chain, defining $url
2817         # as needed. If no variant puts something in $url, we assume avatars
2818         # are completely disabled/unavailable.
2819         if ($url) {
2820                 return $pre_white .
2821                        "<img width=\"$size\" " .
2822                             "class=\"avatar\" " .
2823                             "src=\"".esc_url($url)."\" " .
2824                             "alt=\"\" " .
2825                        "/>" . $post_white;
2826         } else {
2827                 return "";
2828         }
2829 }
2830
2831 sub format_search_author {
2832         my ($author, $searchtype, $displaytext) = @_;
2833         my $have_search = gitweb_check_feature('search');
2834
2835         if ($have_search) {
2836                 my $performed = "";
2837                 if ($searchtype eq 'author') {
2838                         $performed = "authored";
2839                 } elsif ($searchtype eq 'committer') {
2840                         $performed = "committed";
2841                 }
2842
2843                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2844                                 searchtext=>$author,
2845                                 searchtype=>$searchtype), class=>"list",
2846                                 title=>"Search for commits $performed by $author"},
2847                                 $displaytext);
2848
2849         } else {
2850                 return $displaytext;
2851         }
2852 }
2853
2854 # format the author name of the given commit with the given tag
2855 # the author name is chopped and escaped according to the other
2856 # optional parameters (see chop_str).
2857 sub format_author_html {
2858         my $tag = shift;
2859         my $co = shift;
2860         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2861         return "<$tag class=\"author\">" .
2862                format_search_author($co->{'author_name'}, "author",
2863                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2864                        $author) .
2865                "</$tag>";
2866 }
2867
2868 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2869 sub format_git_diff_header_line {
2870         my $line = shift;
2871         my $diffinfo = shift;
2872         my ($from, $to) = @_;
2873
2874         if ($diffinfo->{'nparents'}) {
2875                 # combined diff
2876                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2877                 if ($to->{'href'}) {
2878                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2879                                          esc_path($to->{'file'}));
2880                 } else { # file was deleted (no href)
2881                         $line .= esc_path($to->{'file'});
2882                 }
2883         } else {
2884                 # "ordinary" diff
2885                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2886                 if ($from->{'href'}) {
2887                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2888                                          'a/' . esc_path($from->{'file'}));
2889                 } else { # file was added (no href)
2890                         $line .= 'a/' . esc_path($from->{'file'});
2891                 }
2892                 $line .= ' ';
2893                 if ($to->{'href'}) {
2894                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2895                                          'b/' . esc_path($to->{'file'}));
2896                 } else { # file was deleted
2897                         $line .= 'b/' . esc_path($to->{'file'});
2898                 }
2899         }
2900
2901         return "<div class=\"diff header\">$line</div>\n";
2902 }
2903
2904 # format extended diff header line, before patch itself
2905 sub format_extended_diff_header_line {
2906         my $line = shift;
2907         my $diffinfo = shift;
2908         my ($from, $to) = @_;
2909
2910         # match <path>
2911         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2912                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2913                                        esc_path($from->{'file'}));
2914         }
2915         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2916                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2917                                  esc_path($to->{'file'}));
2918         }
2919         # match single <mode>
2920         if ($line =~ m/\s(\d{6})$/) {
2921                 $line .= '<span class="info"> (' .
2922                          file_type_long($1) .
2923                          ')</span>';
2924         }
2925         # match <hash>
2926         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2927                 # can match only for combined diff
2928                 $line = 'index ';
2929                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2930                         if ($from->{'href'}[$i]) {
2931                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
2932                                                   -class=>"hash"},
2933                                                  substr($diffinfo->{'from_id'}[$i],0,7));
2934                         } else {
2935                                 $line .= '0' x 7;
2936                         }
2937                         # separator
2938                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
2939                 }
2940                 $line .= '..';
2941                 if ($to->{'href'}) {
2942                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2943                                          substr($diffinfo->{'to_id'},0,7));
2944                 } else {
2945                         $line .= '0' x 7;
2946                 }
2947
2948         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
2949                 # can match only for ordinary diff
2950                 my ($from_link, $to_link);
2951                 if ($from->{'href'}) {
2952                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
2953                                              substr($diffinfo->{'from_id'},0,7));
2954                 } else {
2955                         $from_link = '0' x 7;
2956                 }
2957                 if ($to->{'href'}) {
2958                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2959                                            substr($diffinfo->{'to_id'},0,7));
2960                 } else {
2961                         $to_link = '0' x 7;
2962                 }
2963                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
2964                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
2965         }
2966
2967         return $line . "<br/>\n";
2968 }
2969
2970 # format from-file/to-file diff header
2971 sub format_diff_from_to_header {
2972         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
2973         my $line;
2974         my $result = '';
2975
2976         $line = $from_line;
2977         #assert($line =~ m/^---/) if DEBUG;
2978         # no extra formatting for "^--- /dev/null"
2979         if (! $diffinfo->{'nparents'}) {
2980                 # ordinary (single parent) diff
2981                 if ($line =~ m!^--- "?a/!) {
2982                         if ($from->{'href'}) {
2983                                 $line = '--- a/' .
2984                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2985                                                 esc_path($from->{'file'}));
2986                         } else {
2987                                 $line = '--- a/' .
2988                                         esc_path($from->{'file'});
2989                         }
2990                 }
2991                 $result .= qq!<div class="diff from_file">$line</div>\n!;
2992
2993         } else {
2994                 # combined diff (merge commit)
2995                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2996                         if ($from->{'href'}[$i]) {
2997                                 $line = '--- ' .
2998                                         $cgi->a({-href=>href(action=>"blobdiff",
2999                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3000                                                              hash_parent_base=>$parents[$i],
3001                                                              file_parent=>$from->{'file'}[$i],
3002                                                              hash=>$diffinfo->{'to_id'},
3003                                                              hash_base=>$hash,
3004                                                              file_name=>$to->{'file'}),
3005                                                  -class=>"path",
3006                                                  -title=>"diff" . ($i+1)},
3007                                                 $i+1) .
3008                                         '/' .
3009                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3010                                                 esc_path($from->{'file'}[$i]));
3011                         } else {
3012                                 $line = '--- /dev/null';
3013                         }
3014                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3015                 }
3016         }
3017
3018         $line = $to_line;
3019         #assert($line =~ m/^\+\+\+/) if DEBUG;
3020         # no extra formatting for "^+++ /dev/null"
3021         if ($line =~ m!^\+\+\+ "?b/!) {
3022                 if ($to->{'href'}) {
3023                         $line = '+++ b/' .
3024                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3025                                         esc_path($to->{'file'}));
3026                 } else {
3027                         $line = '+++ b/' .
3028                                 esc_path($to->{'file'});
3029                 }
3030         }
3031         $result .= qq!<div class="diff to_file">$line</div>\n!;
3032
3033         return $result;
3034 }
3035
3036 # create note for patch simplified by combined diff
3037 sub format_diff_cc_simplified {
3038         my ($diffinfo, @parents) = @_;
3039         my $result = '';
3040
3041         $result .= "<div class=\"diff header\">" .
3042                    "diff --cc ";
3043         if (!is_deleted($diffinfo)) {
3044                 $result .= $cgi->a({-href => href(action=>"blob",
3045                                                   hash_base=>$hash,
3046                                                   hash=>$diffinfo->{'to_id'},
3047                                                   file_name=>$diffinfo->{'to_file'}),
3048                                     -class => "path"},
3049                                    esc_path($diffinfo->{'to_file'}));
3050         } else {
3051                 $result .= esc_path($diffinfo->{'to_file'});
3052         }
3053         $result .= "</div>\n" . # class="diff header"
3054                    "<div class=\"diff nodifferences\">" .
3055                    "Simple merge" .
3056                    "</div>\n"; # class="diff nodifferences"
3057
3058         return $result;
3059 }
3060
3061 sub diff_line_class {
3062         my ($line, $from, $to) = @_;
3063
3064         # ordinary diff
3065         my $num_sign = 1;
3066         # combined diff
3067         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3068                 $num_sign = scalar @{$from->{'href'}};
3069         }
3070
3071         my @diff_line_classifier = (
3072                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3073                 { regexp => qr/^\\/,               class => "incomplete"  },
3074                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3075                 # classifier for context must come before classifier add/rem,
3076                 # or we would have to use more complicated regexp, for example
3077                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3078                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3079                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3080         );
3081         for my $clsfy (@diff_line_classifier) {
3082                 return $clsfy->{'class'}
3083                         if ($line =~ $clsfy->{'regexp'});
3084         }
3085
3086         # fallback
3087         return "";
3088 }
3089
3090 # assumes that $from and $to are defined and correctly filled,
3091 # and that $line holds a line of chunk header for unified diff
3092 sub format_unidiff_chunk_header {
3093         my ($line, $from, $to) = @_;
3094
3095         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3096                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3097
3098         $from_lines = 0 unless defined $from_lines;
3099         $to_lines   = 0 unless defined $to_lines;
3100
3101         if ($from->{'href'}) {
3102                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3103                                      -class=>"list"}, $from_text);
3104         }
3105         if ($to->{'href'}) {
3106                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3107                                      -class=>"list"}, $to_text);
3108         }
3109         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3110                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3111         return $line;
3112 }
3113
3114 # assumes that $from and $to are defined and correctly filled,
3115 # and that $line holds a line of chunk header for combined diff
3116 sub format_cc_diff_chunk_header {
3117         my ($line, $from, $to) = @_;
3118
3119         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3120         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3121
3122         @from_text = split(' ', $ranges);
3123         for (my $i = 0; $i < @from_text; ++$i) {
3124                 ($from_start[$i], $from_nlines[$i]) =
3125                         (split(',', substr($from_text[$i], 1)), 0);
3126         }
3127
3128         $to_text   = pop @from_text;
3129         $to_start  = pop @from_start;
3130         $to_nlines = pop @from_nlines;
3131
3132         $line = "<span class=\"chunk_info\">$prefix ";
3133         for (my $i = 0; $i < @from_text; ++$i) {
3134                 if ($from->{'href'}[$i]) {
3135                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3136                                           -class=>"list"}, $from_text[$i]);
3137                 } else {
3138                         $line .= $from_text[$i];
3139                 }
3140                 $line .= " ";
3141         }
3142         if ($to->{'href'}) {
3143                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3144                                   -class=>"list"}, $to_text);
3145         } else {
3146                 $line .= $to_text;
3147         }
3148         $line .= " $prefix</span>" .
3149                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3150         return $line;
3151 }
3152
3153 # process patch (diff) line (not to be used for diff headers),
3154 # returning HTML-formatted (but not wrapped) line.
3155 # If the line is passed as a reference, it is treated as HTML and not
3156 # esc_html()'ed.
3157 sub format_diff_line {
3158         my ($line, $diff_class, $from, $to) = @_;
3159
3160         if (ref($line)) {
3161                 $line = $$line;
3162         } else {
3163                 chomp $line;
3164                 $line = untabify($line);
3165
3166                 if ($from && $to && $line =~ m/^\@{2} /) {
3167                         $line = format_unidiff_chunk_header($line, $from, $to);
3168                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3169                         $line = format_cc_diff_chunk_header($line, $from, $to);
3170                 } else {
3171                         $line = esc_html($line, -nbsp=>1);
3172                 }
3173         }
3174
3175         my $diff_classes = "diff diff_body";
3176         $diff_classes .= " $diff_class" if ($diff_class);
3177         $line = "<div class=\"$diff_classes\">$line</div>\n";
3178
3179         return $line;
3180 }
3181
3182 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3183 # linked.  Pass the hash of the tree/commit to snapshot.
3184 sub format_snapshot_links {
3185         my ($hash) = @_;
3186         my $num_fmts = @snapshot_fmts;
3187         if ($num_fmts > 1) {
3188                 # A parenthesized list of links bearing format names.
3189                 # e.g. "snapshot (_tar.gz_ _zip_)"
3190                 return "snapshot (" . join(' ', map
3191                         $cgi->a({
3192                                 -href => href(
3193                                         action=>"snapshot",
3194                                         hash=>$hash,
3195                                         snapshot_format=>$_
3196                                 )
3197                         }, $known_snapshot_formats{$_}{'display'})
3198                 , @snapshot_fmts) . ")";
3199         } elsif ($num_fmts == 1) {
3200                 # A single "snapshot" link whose tooltip bears the format name.
3201                 # i.e. "_snapshot_"
3202                 my ($fmt) = @snapshot_fmts;
3203                 return
3204                         $cgi->a({
3205                                 -href => href(
3206                                         action=>"snapshot",
3207                                         hash=>$hash,
3208                                         snapshot_format=>$fmt
3209                                 ),
3210                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3211                         }, "snapshot");
3212         } else { # $num_fmts == 0
3213                 return undef;
3214         }
3215 }
3216
3217 ## ......................................................................
3218 ## functions returning values to be passed, perhaps after some
3219 ## transformation, to other functions; e.g. returning arguments to href()
3220
3221 # returns hash to be passed to href to generate gitweb URL
3222 # in -title key it returns description of link
3223 sub get_feed_info {
3224         my $format = shift || 'Atom';
3225         my %res = (action => lc($format));
3226         my $matched_ref = 0;
3227
3228         # feed links are possible only for project views
3229         return unless (defined $project);
3230         # some views should link to OPML, or to generic project feed,
3231         # or don't have specific feed yet (so they should use generic)
3232         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3233
3234         my $branch = undef;
3235         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3236         # (fullname) to differentiate from tag links; this also makes
3237         # possible to detect branch links
3238         for my $ref (get_branch_refs()) {
3239                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3240                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3241                         $branch = $1;
3242                         $matched_ref = $ref;
3243                         last;
3244                 }
3245         }
3246         # find log type for feed description (title)
3247         my $type = 'log';
3248         if (defined $file_name) {
3249                 $type  = "history of $file_name";
3250                 $type .= "/" if ($action eq 'tree');
3251                 $type .= " on '$branch'" if (defined $branch);
3252         } else {
3253                 $type = "log of $branch" if (defined $branch);
3254         }
3255
3256         $res{-title} = $type;
3257         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3258         $res{'file_name'} = $file_name;
3259
3260         return %res;
3261 }
3262
3263 ## ----------------------------------------------------------------------
3264 ## git utility subroutines, invoking git commands
3265
3266 # returns path to the core git executable and the --git-dir parameter as list
3267 sub git_cmd {
3268         $number_of_git_cmds++;
3269         return $GIT, '--git-dir='.$git_dir;
3270 }
3271
3272 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3273 sub cmd_pipe {
3274
3275         # In order to be compatible with FCGI mode we must use POSIX
3276         # and access the STDERR_FILENO file descriptor directly
3277
3278         use POSIX qw(STDERR_FILENO dup dup2);
3279
3280         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3281         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3282         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3283         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3284         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3285         my $result = open(my $fd, "-|", @_);
3286         $dup2ok = dup2($saveerr, STDERR_FILENO);
3287         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3288         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3289
3290         return $result ? $fd : undef;
3291 }
3292
3293 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3294 sub git_cmd_pipe {
3295         return cmd_pipe git_cmd(), @_;
3296 }
3297
3298 # quote the given arguments for passing them to the shell
3299 # quote_command("command", "arg 1", "arg with ' and ! characters")
3300 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3301 # Try to avoid using this function wherever possible.
3302 sub quote_command {
3303         return join(' ',
3304                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3305 }
3306
3307 # get HEAD ref of given project as hash
3308 sub git_get_head_hash {
3309         return git_get_full_hash(shift, 'HEAD');
3310 }
3311
3312 sub git_get_full_hash {
3313         return git_get_hash(@_);
3314 }
3315
3316 sub git_get_short_hash {
3317         return git_get_hash(@_, '--short=7');
3318 }
3319
3320 sub git_get_hash {
3321         my ($project, $hash, @options) = @_;
3322         my $o_git_dir = $git_dir;
3323         my $retval = undef;
3324         $git_dir = "$projectroot/$project";
3325         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3326             '--verify', '-q', @options, $hash)) {
3327                 $retval = <$fd>;
3328                 chomp $retval if defined $retval;
3329                 close $fd;
3330         }
3331         if (defined $o_git_dir) {
3332                 $git_dir = $o_git_dir;
3333         }
3334         return $retval;
3335 }
3336
3337 # get type of given object
3338 sub git_get_type {
3339         my $hash = shift;
3340
3341         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3342         my $type = <$fd>;
3343         close $fd or return;
3344         chomp $type;
3345         return $type;
3346 }
3347
3348 # repository configuration
3349 our $config_file = '';
3350 our %config;
3351
3352 # store multiple values for single key as anonymous array reference
3353 # single values stored directly in the hash, not as [ <value> ]
3354 sub hash_set_multi {
3355         my ($hash, $key, $value) = @_;
3356
3357         if (!exists $hash->{$key}) {
3358                 $hash->{$key} = $value;
3359         } elsif (!ref $hash->{$key}) {
3360                 $hash->{$key} = [ $hash->{$key}, $value ];
3361         } else {
3362                 push @{$hash->{$key}}, $value;
3363         }
3364 }
3365
3366 # return hash of git project configuration
3367 # optionally limited to some section, e.g. 'gitweb'
3368 sub git_parse_project_config {
3369         my $section_regexp = shift;
3370         my %config;
3371
3372         local $/ = "\0";
3373
3374         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3375                 or return;
3376
3377         while (my $keyval = to_utf8(scalar <$fh>)) {
3378                 chomp $keyval;
3379                 my ($key, $value) = split(/\n/, $keyval, 2);
3380
3381                 hash_set_multi(\%config, $key, $value)
3382                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3383         }
3384         close $fh;
3385
3386         return %config;
3387 }
3388
3389 # convert config value to boolean: 'true' or 'false'
3390 # no value, number > 0, 'true' and 'yes' values are true
3391 # rest of values are treated as false (never as error)
3392 sub config_to_bool {
3393         my $val = shift;
3394
3395         return 1 if !defined $val;             # section.key
3396
3397         # strip leading and trailing whitespace
3398         $val =~ s/^\s+//;
3399         $val =~ s/\s+$//;
3400
3401         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3402                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3403 }
3404
3405 # convert config value to simple decimal number
3406 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3407 # to be multiplied by 1024, 1048576, or 1073741824
3408 sub config_to_int {
3409         my $val = shift;
3410
3411         # strip leading and trailing whitespace
3412         $val =~ s/^\s+//;
3413         $val =~ s/\s+$//;
3414
3415         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3416                 $unit = lc($unit);
3417                 # unknown unit is treated as 1
3418                 return $num * ($unit eq 'g' ? 1073741824 :
3419                                $unit eq 'm' ?    1048576 :
3420                                $unit eq 'k' ?       1024 : 1);
3421         }
3422         return $val;
3423 }
3424
3425 # convert config value to array reference, if needed
3426 sub config_to_multi {
3427         my $val = shift;
3428
3429         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3430 }
3431
3432 sub git_get_project_config {
3433         my ($key, $type) = @_;
3434
3435         return unless defined $git_dir;
3436
3437         # key sanity check
3438         return unless ($key);
3439         # only subsection, if exists, is case sensitive,
3440         # and not lowercased by 'git config -z -l'
3441         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3442                 $lo =~ s/_//g;
3443                 $key = join(".", lc($hi), $mi, lc($lo));
3444                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3445         } else {
3446                 $key = lc($key);
3447                 $key =~ s/_//g;
3448                 return if ($key =~ /\W/);
3449         }
3450         $key =~ s/^gitweb\.//;
3451
3452         # type sanity check
3453         if (defined $type) {
3454                 $type =~ s/^--//;
3455                 $type = undef
3456                         unless ($type eq 'bool' || $type eq 'int');
3457         }
3458
3459         # get config
3460         if (!defined $config_file ||
3461             $config_file ne "$git_dir/config") {
3462                 %config = git_parse_project_config('gitweb');
3463                 $config_file = "$git_dir/config";
3464         }
3465
3466         # check if config variable (key) exists
3467         return unless exists $config{"gitweb.$key"};
3468
3469         # ensure given type
3470         if (!defined $type) {
3471                 return $config{"gitweb.$key"};
3472         } elsif ($type eq 'bool') {
3473                 # backward compatibility: 'git config --bool' returns true/false
3474                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3475         } elsif ($type eq 'int') {
3476                 return config_to_int($config{"gitweb.$key"});
3477         }
3478         return $config{"gitweb.$key"};
3479 }
3480
3481 # get hash of given path at given ref
3482 sub git_get_hash_by_path {
3483         my $base = shift;
3484         my $path = shift || return undef;
3485         my $type = shift;
3486
3487         $path =~ s,/+$,,;
3488
3489         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3490                 or die_error(500, "Open git-ls-tree failed");
3491         my $line = to_utf8(scalar <$fd>);
3492         close $fd or return undef;
3493
3494         if (!defined $line) {
3495                 # there is no tree or hash given by $path at $base
3496                 return undef;
3497         }
3498
3499         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3500         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3501         if (defined $type && $type ne $2) {
3502                 # type doesn't match
3503                 return undef;
3504         }
3505         return $3;
3506 }
3507
3508 # get path of entry with given hash at given tree-ish (ref)
3509 # used to get 'from' filename for combined diff (merge commit) for renames
3510 sub git_get_path_by_hash {
3511         my $base = shift || return;
3512         my $hash = shift || return;
3513
3514         local $/ = "\0";
3515
3516         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3517                 or return undef;
3518         while (my $line = to_utf8(scalar <$fd>)) {
3519                 chomp $line;
3520
3521                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3522                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3523                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3524                         close $fd;
3525                         return $1;
3526                 }
3527         }
3528         close $fd;
3529         return undef;
3530 }
3531
3532 ## ......................................................................
3533 ## git utility functions, directly accessing git repository
3534
3535 # get the value of config variable either from file named as the variable
3536 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3537 # configuration variable in the repository config file.
3538 sub git_get_file_or_project_config {
3539         my ($path, $name) = @_;
3540
3541         $git_dir = "$projectroot/$path";
3542         open my $fd, '<', "$git_dir/$name"
3543                 or return git_get_project_config($name);
3544         my $conf = to_utf8(scalar <$fd>);
3545         close $fd;
3546         if (defined $conf) {
3547                 chomp $conf;
3548         }
3549         return $conf;
3550 }
3551
3552 sub git_get_project_description {
3553         my $path = shift;
3554         return git_get_file_or_project_config($path, 'description');
3555 }
3556
3557 sub git_get_project_category {
3558         my $path = shift;
3559         return git_get_file_or_project_config($path, 'category');
3560 }
3561
3562
3563 # supported formats:
3564 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3565 #   - if its contents is a number, use it as tag weight,
3566 #   - otherwise add a tag with weight 1
3567 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3568 #   the same value multiple times increases tag weight
3569 # * `gitweb.ctag' multi-valued repo config variable
3570 sub git_get_project_ctags {
3571         my $project = shift;
3572         my $ctags = {};
3573
3574         $git_dir = "$projectroot/$project";
3575         if (opendir my $dh, "$git_dir/ctags") {
3576                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3577                 foreach my $tagfile (@files) {
3578                         open my $ct, '<', $tagfile
3579                                 or next;
3580                         my $val = <$ct>;
3581                         chomp $val if $val;
3582                         close $ct;
3583
3584                         (my $ctag = $tagfile) =~ s#.*/##;
3585                         $ctag = to_utf8($ctag);
3586                         if ($val =~ /^\d+$/) {
3587                                 $ctags->{$ctag} = $val;
3588                         } else {
3589                                 $ctags->{$ctag} = 1;
3590                         }
3591                 }
3592                 closedir $dh;
3593
3594         } elsif (open my $fh, '<', "$git_dir/ctags") {
3595                 while (my $line = to_utf8(scalar <$fh>)) {
3596                         chomp $line;
3597                         $ctags->{$line}++ if $line;
3598                 }
3599                 close $fh;
3600
3601         } else {
3602                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3603                 foreach my $tag (@$taglist) {
3604                         $ctags->{$tag}++;
3605                 }
3606         }
3607
3608         return $ctags;
3609 }
3610
3611 # return hash, where keys are content tags ('ctags'),
3612 # and values are sum of weights of given tag in every project
3613 sub git_gather_all_ctags {
3614         my $projects = shift;
3615         my $ctags = {};
3616
3617         foreach my $p (@$projects) {
3618                 foreach my $ct (keys %{$p->{'ctags'}}) {
3619                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3620                 }
3621         }
3622
3623         return $ctags;
3624 }
3625
3626 sub git_populate_project_tagcloud {
3627         my ($ctags, $action) = @_;
3628
3629         # First, merge different-cased tags; tags vote on casing
3630         my %ctags_lc;
3631         foreach (keys %$ctags) {
3632                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3633                 if (not $ctags_lc{lc $_}->{topcount}
3634                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3635                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3636                         $ctags_lc{lc $_}->{topname} = $_;
3637                 }
3638         }
3639
3640         my $cloud;
3641         my $matched = $input_params{'ctag_filter'};
3642         if (eval { require HTML::TagCloud; 1; }) {
3643                 $cloud = HTML::TagCloud->new;
3644                 foreach my $ctag (sort keys %ctags_lc) {
3645                         # Pad the title with spaces so that the cloud looks
3646                         # less crammed.
3647                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3648                         $title =~ s/ /&#160;/g;
3649                         $title =~ s/^/&#160;/g;
3650                         $title =~ s/$/&#160;/g;
3651                         if (defined $matched && $matched eq $ctag) {
3652                                 $title = qq(<span class="match">$title</span>);
3653                         }
3654                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3655                                     $ctags_lc{$ctag}->{count});
3656                 }
3657         } else {
3658                 $cloud = {};
3659                 foreach my $ctag (keys %ctags_lc) {
3660                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3661                         if (defined $matched && $matched eq $ctag) {
3662                                 $title = qq(<span class="match">$title</span>);
3663                         }
3664                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3665                         $cloud->{$ctag}{ctag} =
3666                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3667                 }
3668         }
3669         return $cloud;
3670 }
3671
3672 sub git_show_project_tagcloud {
3673         my ($cloud, $count) = @_;
3674         if (ref $cloud eq 'HTML::TagCloud') {
3675                 return $cloud->html_and_css($count);
3676         } else {
3677                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3678                 return
3679                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3680                         join (', ', map {
3681                                 $cloud->{$_}->{'ctag'}
3682                         } splice(@tags, 0, $count)) .
3683                         '</div>';
3684         }
3685 }
3686
3687 sub git_get_project_url_list {
3688         my $path = shift;
3689
3690         $git_dir = "$projectroot/$path";
3691         open my $fd, '<', "$git_dir/cloneurl"
3692                 or return wantarray ?
3693                 @{ config_to_multi(git_get_project_config('url')) } :
3694                    config_to_multi(git_get_project_config('url'));
3695         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3696         close $fd;
3697
3698         return wantarray ? @git_project_url_list : \@git_project_url_list;
3699 }
3700
3701 sub git_get_projects_list {
3702         my $filter = shift || '';
3703         my $paranoid = shift;
3704         my @list;
3705
3706         if (-d $projects_list) {
3707                 # search in directory
3708                 my $dir = $projects_list;
3709                 # remove the trailing "/"
3710                 $dir =~ s!/+$!!;
3711                 my $pfxlen = length("$dir");
3712                 my $pfxdepth = ($dir =~ tr!/!!);
3713                 # when filtering, search only given subdirectory
3714                 if ($filter && !$paranoid) {
3715                         $dir .= "/$filter";
3716                         $dir =~ s!/+$!!;
3717                 }
3718
3719                 File::Find::find({
3720                         follow_fast => 1, # follow symbolic links
3721                         follow_skip => 2, # ignore duplicates
3722                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3723                         wanted => sub {
3724                                 # global variables
3725                                 our $project_maxdepth;
3726                                 our $projectroot;
3727                                 # skip project-list toplevel, if we get it.
3728                                 return if (m!^[/.]$!);
3729                                 # only directories can be git repositories
3730                                 return unless (-d $_);
3731                                 # don't traverse too deep (Find is super slow on os x)
3732                                 # $project_maxdepth excludes depth of $projectroot
3733                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3734                                         $File::Find::prune = 1;
3735                                         return;
3736                                 }
3737
3738                                 my $path = substr($File::Find::name, $pfxlen + 1);
3739                                 # paranoidly only filter here
3740                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3741                                         next;
3742                                 }
3743                                 # we check related file in $projectroot
3744                                 if (check_export_ok("$projectroot/$path")) {
3745                                         push @list, { path => $path };
3746                                         $File::Find::prune = 1;
3747                                 }
3748                         },
3749                 }, "$dir");
3750
3751         } elsif (-f $projects_list) {
3752                 # read from file(url-encoded):
3753                 # 'git%2Fgit.git Linus+Torvalds'
3754                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3755                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3756                 open my $fd, '<', $projects_list or return;
3757         PROJECT:
3758                 while (my $line = <$fd>) {
3759                         chomp $line;
3760                         my ($path, $owner) = split ' ', $line;
3761                         $path = unescape($path);
3762                         $owner = unescape($owner);
3763                         if (!defined $path) {
3764                                 next;
3765                         }
3766                         # if $filter is rpovided, check if $path begins with $filter
3767                         if ($filter && $path !~ m!^\Q$filter\E/!) {
3768                                 next;
3769                         }
3770                         if (check_export_ok("$projectroot/$path")) {
3771                                 my $pr = {
3772                                         path => $path
3773                                 };
3774                                 if ($owner) {
3775                                         $pr->{'owner'} = to_utf8($owner);
3776                                 }
3777                                 push @list, $pr;
3778                         }
3779                 }
3780                 close $fd;
3781         }
3782         return @list;
3783 }
3784
3785 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3786 # as side effects it sets 'forks' field to list of forks for forked projects
3787 sub filter_forks_from_projects_list {
3788         my $projects = shift;
3789
3790         my %trie; # prefix tree of directories (path components)
3791         # generate trie out of those directories that might contain forks
3792         foreach my $pr (@$projects) {
3793                 my $path = $pr->{'path'};
3794                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3795                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3796                 next unless ($path);      # skip '.git' repository: tests, git-instaweb
3797                 next unless (-d "$projectroot/$path"); # containing directory exists
3798                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3799
3800                 # add to trie
3801                 my @dirs = split('/', $path);
3802                 # walk the trie, until either runs out of components or out of trie
3803                 my $ref = \%trie;
3804                 while (scalar @dirs &&
3805                        exists($ref->{$dirs[0]})) {
3806                         $ref = $ref->{shift @dirs};
3807                 }
3808                 # create rest of trie structure from rest of components
3809                 foreach my $dir (@dirs) {
3810                         $ref = $ref->{$dir} = {};
3811                 }
3812                 # create end marker, store $pr as a data
3813                 $ref->{''} = $pr if (!exists $ref->{''});
3814         }
3815
3816         # filter out forks, by finding shortest prefix match for paths
3817         my @filtered;
3818  PROJECT:
3819         foreach my $pr (@$projects) {
3820                 # trie lookup
3821                 my $ref = \%trie;
3822         DIR:
3823                 foreach my $dir (split('/', $pr->{'path'})) {
3824                         if (exists $ref->{''}) {
3825                                 # found [shortest] prefix, is a fork - skip it
3826                                 push @{$ref->{''}{'forks'}}, $pr;
3827                                 next PROJECT;
3828                         }
3829                         if (!exists $ref->{$dir}) {
3830                                 # not in trie, cannot have prefix, not a fork
3831                                 push @filtered, $pr;
3832                                 next PROJECT;
3833                         }
3834                         # If the dir is there, we just walk one step down the trie.
3835                         $ref = $ref->{$dir};
3836                 }
3837                 # we ran out of trie
3838                 # (shouldn't happen: it's either no match, or end marker)
3839                 push @filtered, $pr;
3840         }
3841
3842         return @filtered;
3843 }
3844
3845 # note: fill_project_list_info must be run first,
3846 # for 'descr_long' and 'ctags' to be filled
3847 sub search_projects_list {
3848         my ($projlist, %opts) = @_;
3849         my $tagfilter  = $opts{'tagfilter'};
3850         my $search_re = $opts{'search_regexp'};
3851
3852         return @$projlist
3853                 unless ($tagfilter || $search_re);
3854
3855         # searching projects require filling to be run before it;
3856         fill_project_list_info($projlist,
3857                                $tagfilter  ? 'ctags' : (),
3858                                $search_re ? ('path', 'descr') : ());
3859         my @projects;
3860  PROJECT:
3861         foreach my $pr (@$projlist) {
3862
3863                 if ($tagfilter) {
3864                         next unless ref($pr->{'ctags'}) eq 'HASH';
3865                         next unless
3866                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3867                 }
3868
3869                 if ($search_re) {
3870                         my $path = $pr->{'path'};
3871                         $path =~ s/\.git$//; # should not be included in search
3872                         next unless
3873                                 $path =~ /$search_re/ ||
3874                                 $pr->{'descr_long'} =~ /$search_re/;
3875                 }
3876
3877                 push @projects, $pr;
3878         }
3879
3880         return @projects;
3881 }
3882
3883 our $gitweb_project_owner = undef;
3884 sub git_get_project_list_from_file {
3885
3886         return if (defined $gitweb_project_owner);
3887
3888         $gitweb_project_owner = {};
3889         # read from file (url-encoded):
3890         # 'git%2Fgit.git Linus+Torvalds'
3891         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3892         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3893         if (-f $projects_list) {
3894                 open(my $fd, '<', $projects_list);
3895                 while (my $line = <$fd>) {
3896                         chomp $line;
3897                         my ($pr, $ow) = split ' ', $line;
3898                         $pr = unescape($pr);
3899                         $ow = unescape($ow);
3900                         $gitweb_project_owner->{$pr} = to_utf8($ow);
3901                 }
3902                 close $fd;
3903         }
3904 }
3905
3906 sub git_get_project_owner {
3907         my $proj = shift;
3908         my $owner;
3909
3910         return undef unless $proj;
3911         $git_dir = "$projectroot/$proj";
3912
3913         if (defined $project && $proj eq $project) {
3914                 $owner = git_get_project_config('owner');
3915         }
3916         if (!defined $owner && !defined $gitweb_project_owner) {
3917                 git_get_project_list_from_file();
3918         }
3919         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
3920                 $owner = $gitweb_project_owner->{$proj};
3921         }
3922         if (!defined $owner && (!defined $project || $proj ne $project)) {
3923                 $owner = git_get_project_config('owner');
3924         }
3925         if (!defined $owner) {
3926                 $owner = get_file_owner("$git_dir");
3927         }
3928
3929         return $owner;
3930 }
3931
3932 sub parse_activity_date {
3933         my $dstr = shift;
3934
3935         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
3936                 # Unix timestamp
3937                 return 0 + $1;
3938         }
3939         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
3940                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
3941                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
3942                 defined($z) && $z ne '' or $z = 'Z';
3943                 $z =~ s/://;
3944                 substr($z,1,0) = '0' if length($z) == 4;
3945                 my $off = 0;
3946                 if (uc($z) ne 'Z') {
3947                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
3948                         $off = -$off if substr($z,0,1) eq '-';
3949                 }
3950                 return $seconds - $off;
3951         }
3952         return undef;
3953 }
3954
3955 # If $quick is true only look at $lastactivity_file
3956 sub git_get_last_activity {
3957         my ($path, $quick) = @_;
3958         my $fd;
3959
3960         $git_dir = "$projectroot/$path";
3961         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
3962                 my $activity = <$fd>;
3963                 close $fd;
3964                 return (undef) unless defined $activity;
3965                 chomp $activity;
3966                 return (undef) if $activity eq '';
3967                 if (my $timestamp = parse_activity_date($activity)) {
3968                         return ($timestamp);
3969                 }
3970         }
3971         return (undef) if $quick;
3972         defined($fd = git_cmd_pipe 'for-each-ref',
3973              '--format=%(committer)',
3974              '--sort=-committerdate',
3975              '--count=1',
3976              map { "refs/$_" } get_branch_refs ()) or return;
3977         my $most_recent = <$fd>;
3978         close $fd or return (undef);
3979         if (defined $most_recent &&
3980             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
3981                 my $timestamp = $1;
3982                 return ($timestamp);
3983         }
3984         return (undef);
3985 }
3986
3987 # Implementation note: when a single remote is wanted, we cannot use 'git
3988 # remote show -n' because that command always work (assuming it's a remote URL
3989 # if it's not defined), and we cannot use 'git remote show' because that would
3990 # try to make a network roundtrip. So the only way to find if that particular
3991 # remote is defined is to walk the list provided by 'git remote -v' and stop if
3992 # and when we find what we want.
3993 sub git_get_remotes_list {
3994         my $wanted = shift;
3995         my %remotes = ();
3996
3997         my $fd = git_cmd_pipe 'remote', '-v';
3998         return unless $fd;
3999         while (my $remote = to_utf8(scalar <$fd>)) {
4000                 chomp $remote;
4001                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4002                 next if $wanted and not $remote eq $wanted;
4003                 my ($url, $key) = ($1, $2);
4004
4005                 $remotes{$remote} ||= { 'heads' => [] };
4006                 $remotes{$remote}{$key} = $url;
4007         }
4008         close $fd or return;
4009         return wantarray ? %remotes : \%remotes;
4010 }
4011
4012 # Takes a hash of remotes as first parameter and fills it by adding the
4013 # available remote heads for each of the indicated remotes.
4014 sub fill_remote_heads {
4015         my $remotes = shift;
4016         my @heads = map { "remotes/$_" } keys %$remotes;
4017         my @remoteheads = git_get_heads_list(undef, @heads);
4018         foreach my $remote (keys %$remotes) {
4019                 $remotes->{$remote}{'heads'} = [ grep {
4020                         $_->{'name'} =~ s!^$remote/!!
4021                         } @remoteheads ];
4022         }
4023 }
4024
4025 sub git_get_references {
4026         my $type = shift || "";
4027         my %refs;
4028         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4029         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4030         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4031                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4032                 or return;
4033
4034         while (my $line = to_utf8(scalar <$fd>)) {
4035                 chomp $line;
4036                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4037                         if (defined $refs{$1}) {
4038                                 push @{$refs{$1}}, $2;
4039                         } else {
4040                                 $refs{$1} = [ $2 ];
4041                         }
4042                 }
4043         }
4044         close $fd or return;
4045         return \%refs;
4046 }
4047
4048 sub git_get_rev_name_tags {
4049         my $hash = shift || return undef;
4050
4051         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4052                 or return;
4053         my $name_rev = to_utf8(scalar <$fd>);
4054         close $fd;
4055
4056         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4057                 return $1;
4058         } else {
4059                 # catches also '$hash undefined' output
4060                 return undef;
4061         }
4062 }
4063
4064 ## ----------------------------------------------------------------------
4065 ## parse to hash functions
4066
4067 sub parse_date {
4068         my $epoch = shift;
4069         my $tz = shift || "-0000";
4070
4071         my %date;
4072         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4073         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4074         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4075         $date{'hour'} = $hour;
4076         $date{'minute'} = $min;
4077         $date{'mday'} = $mday;
4078         $date{'day'} = $days[$wday];
4079         $date{'month'} = $months[$mon];
4080         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4081                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4082         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4083                              $mday, $months[$mon], $hour ,$min;
4084         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4085                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4086
4087         my ($tz_sign, $tz_hour, $tz_min) =
4088                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4089         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4090         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4091         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4092         $date{'hour_local'} = $hour;
4093         $date{'minute_local'} = $min;
4094         $date{'mday_local'} = $mday;
4095         $date{'tz_local'} = $tz;
4096         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4097                                   1900+$year, $mon+1, $mday,
4098                                   $hour, $min, $sec, $tz);
4099         return %date;
4100 }
4101
4102 my %parse_date_rfc2822_month_names;
4103 BEGIN {
4104         %parse_date_rfc2822_month_names = (
4105                 jan => 0, feb => 1, mar => 2, apr => 3, may => 4, jun => 5,
4106                 jul => 6, aug => 7, sep => 8, oct => 9, nov => 10, dec => 11
4107         );
4108 }
4109
4110 sub parse_date_rfc2822 {
4111         my $datestr = shift;
4112         return () unless defined $datestr;
4113         $datestr = $1 if $datestr =~/^[^\s]+,\s*(.*)$/;
4114         return () unless $datestr =~
4115                 /^\s*(\d{1,2})\s+([A-Za-z]{3})\s+(\d{4})\s+(\d{1,2}):(\d{2}):(\d{2})\s+([+-]\d{4})\s*$/;
4116         my ($d,$b,$Y,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7);
4117         my $m = $parse_date_rfc2822_month_names{lc($b)};
4118         return () unless defined($m);
4119         my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, 0+$m, $Y-1900);
4120         my $tzoffset = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
4121         $tzoffset = -$tzoffset if substr($z,0,1) eq '-';
4122         my $tzstring;
4123         if ($tzoffset >= 0) {
4124                 $tzstring = sprintf('+%02d%02d', int($tzoffset / 3600), int(($tzoffset % 3600) / 60));
4125         } else {
4126                 $tzstring = sprintf('-%02d%02d', int(-$tzoffset / 3600), int((-$tzoffset % 3600) / 60));
4127         }
4128         return parse_date($seconds - $tzoffset, $tzstring);
4129 }
4130
4131 sub parse_tag {
4132         my $tag_id = shift;
4133         my %tag;
4134         my @comment;
4135
4136         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4137         $tag{'id'} = $tag_id;
4138         while (my $line = to_utf8(scalar <$fd>)) {
4139                 chomp $line;
4140                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4141                         $tag{'object'} = $1;
4142                 } elsif ($line =~ m/^type (.+)$/) {
4143                         $tag{'type'} = $1;
4144                 } elsif ($line =~ m/^tag (.+)$/) {
4145                         $tag{'name'} = $1;
4146                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4147                         $tag{'author'} = $1;
4148                         $tag{'author_epoch'} = $2;
4149                         $tag{'author_tz'} = $3;
4150                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4151                                 $tag{'author_name'}  = $1;
4152                                 $tag{'author_email'} = $2;
4153                         } else {
4154                                 $tag{'author_name'} = $tag{'author'};
4155                         }
4156                 } elsif ($line =~ m/--BEGIN/) {
4157                         push @comment, $line;
4158                         last;
4159                 } elsif ($line eq "") {
4160                         last;
4161                 }
4162         }
4163         push @comment, map(to_utf8($_), <$fd>);
4164         $tag{'comment'} = \@comment;
4165         close $fd or return;
4166         if (!defined $tag{'name'}) {
4167                 return
4168         };
4169         return %tag
4170 }
4171
4172 sub parse_commit_text {
4173         my ($commit_text, $withparents) = @_;
4174         my @commit_lines = split '\n', $commit_text;
4175         my %co;
4176
4177         pop @commit_lines; # Remove '\0'
4178
4179         if (! @commit_lines) {
4180                 return;
4181         }
4182
4183         my $header = shift @commit_lines;
4184         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4185                 return;
4186         }
4187         ($co{'id'}, my @parents) = split ' ', $header;
4188         while (my $line = shift @commit_lines) {
4189                 last if $line eq "\n";
4190                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4191                         $co{'tree'} = $1;
4192                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4193                         push @parents, $1;
4194                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4195                         $co{'author'} = to_utf8($1);
4196                         $co{'author_epoch'} = $2;
4197                         $co{'author_tz'} = $3;
4198                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4199                                 $co{'author_name'}  = $1;
4200                                 $co{'author_email'} = $2;
4201                         } else {
4202                                 $co{'author_name'} = $co{'author'};
4203                         }
4204                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4205                         $co{'committer'} = to_utf8($1);
4206                         $co{'committer_epoch'} = $2;
4207                         $co{'committer_tz'} = $3;
4208                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4209                                 $co{'committer_name'}  = $1;
4210                                 $co{'committer_email'} = $2;
4211                         } else {
4212                                 $co{'committer_name'} = $co{'committer'};
4213                         }
4214                 }
4215         }
4216         if (!defined $co{'tree'}) {
4217                 return;
4218         };
4219         $co{'parents'} = \@parents;
4220         $co{'parent'} = $parents[0];
4221
4222         @commit_lines = map to_utf8($_), @commit_lines;
4223         foreach my $title (@commit_lines) {
4224                 $title =~ s/^    //;
4225                 if ($title ne "") {
4226                         $co{'title'} = chop_str($title, 80, 5);
4227                         # remove leading stuff of merges to make the interesting part visible
4228                         if (length($title) > 50) {
4229                                 $title =~ s/^Automatic //;
4230                                 $title =~ s/^merge (of|with) /Merge ... /i;
4231                                 if (length($title) > 50) {
4232                                         $title =~ s/(http|rsync):\/\///;
4233                                 }
4234                                 if (length($title) > 50) {
4235                                         $title =~ s/(master|www|rsync)\.//;
4236                                 }
4237                                 if (length($title) > 50) {
4238                                         $title =~ s/kernel.org:?//;
4239                                 }
4240                                 if (length($title) > 50) {
4241                                         $title =~ s/\/pub\/scm//;
4242                                 }
4243                         }
4244                         $co{'title_short'} = chop_str($title, 50, 5);
4245                         last;
4246                 }
4247         }
4248         if (! defined $co{'title'} || $co{'title'} eq "") {
4249                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4250         }
4251         # remove added spaces
4252         foreach my $line (@commit_lines) {
4253                 $line =~ s/^    //;
4254         }
4255         $co{'comment'} = \@commit_lines;
4256
4257         my $age_epoch = $co{'committer_epoch'};
4258         $co{'age_epoch'} = $age_epoch;
4259         my $time_now = time;
4260         $co{'age_string'} = age_string($age_epoch, $time_now);
4261         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4262         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4263         return %co;
4264 }
4265
4266 sub parse_commit {
4267         my ($commit_id) = @_;
4268         my %co;
4269
4270         local $/ = "\0";
4271
4272         defined(my $fd = git_cmd_pipe "rev-list",
4273                 "--parents",
4274                 "--header",
4275                 "--max-count=1",
4276                 $commit_id,
4277                 "--")
4278                 or die_error(500, "Open git-rev-list failed");
4279         %co = parse_commit_text(<$fd>, 1);
4280         close $fd;
4281
4282         return %co;
4283 }
4284
4285 sub parse_commits {
4286         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4287         my @cos;
4288
4289         $maxcount ||= 1;
4290         $skip ||= 0;
4291
4292         local $/ = "\0";
4293
4294         defined(my $fd = git_cmd_pipe "rev-list",
4295                 "--header",
4296                 @args,
4297                 ("--max-count=" . $maxcount),
4298                 ("--skip=" . $skip),
4299                 @extra_options,
4300                 $commit_id,
4301                 "--",
4302                 ($filename ? ($filename) : ()))
4303                 or die_error(500, "Open git-rev-list failed");
4304         while (my $line = <$fd>) {
4305                 my %co = parse_commit_text($line);
4306                 push @cos, \%co;
4307         }
4308         close $fd;
4309
4310         return wantarray ? @cos : \@cos;
4311 }
4312
4313 # parse line of git-diff-tree "raw" output
4314 sub parse_difftree_raw_line {
4315         my $line = shift;
4316         my %res;
4317
4318         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4319         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4320         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4321                 $res{'from_mode'} = $1;
4322                 $res{'to_mode'} = $2;
4323                 $res{'from_id'} = $3;
4324                 $res{'to_id'} = $4;
4325                 $res{'status'} = $5;
4326                 $res{'similarity'} = $6;
4327                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4328                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4329                 } else {
4330                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4331                 }
4332         }
4333         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4334         # combined diff (for merge commit)
4335         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4336                 $res{'nparents'}  = length($1);
4337                 $res{'from_mode'} = [ split(' ', $2) ];
4338                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4339                 $res{'from_id'} = [ split(' ', $3) ];
4340                 $res{'to_id'} = pop @{$res{'from_id'}};
4341                 $res{'status'} = [ split('', $4) ];
4342                 $res{'to_file'} = unquote($5);
4343         }
4344         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4345         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4346                 $res{'commit'} = $1;
4347         }
4348
4349         return wantarray ? %res : \%res;
4350 }
4351
4352 # wrapper: return parsed line of git-diff-tree "raw" output
4353 # (the argument might be raw line, or parsed info)
4354 sub parsed_difftree_line {
4355         my $line_or_ref = shift;
4356
4357         if (ref($line_or_ref) eq "HASH") {
4358                 # pre-parsed (or generated by hand)
4359                 return $line_or_ref;
4360         } else {
4361                 return parse_difftree_raw_line($line_or_ref);
4362         }
4363 }
4364
4365 # parse line of git-ls-tree output
4366 sub parse_ls_tree_line {
4367         my $line = shift;
4368         my %opts = @_;
4369         my %res;
4370
4371         if ($opts{'-l'}) {
4372                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4373                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4374
4375                 $res{'mode'} = $1;
4376                 $res{'type'} = $2;
4377                 $res{'hash'} = $3;
4378                 $res{'size'} = $4;
4379                 if ($opts{'-z'}) {
4380                         $res{'name'} = $5;
4381                 } else {
4382                         $res{'name'} = unquote($5);
4383                 }
4384         } else {
4385                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4386                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4387
4388                 $res{'mode'} = $1;
4389                 $res{'type'} = $2;
4390                 $res{'hash'} = $3;
4391                 if ($opts{'-z'}) {
4392                         $res{'name'} = $4;
4393                 } else {
4394                         $res{'name'} = unquote($4);
4395                 }
4396         }
4397
4398         return wantarray ? %res : \%res;
4399 }
4400
4401 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4402 sub parse_from_to_diffinfo {
4403         my ($diffinfo, $from, $to, @parents) = @_;
4404
4405         if ($diffinfo->{'nparents'}) {
4406                 # combined diff
4407                 $from->{'file'} = [];
4408                 $from->{'href'} = [];
4409                 fill_from_file_info($diffinfo, @parents)
4410                         unless exists $diffinfo->{'from_file'};
4411                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4412                         $from->{'file'}[$i] =
4413                                 defined $diffinfo->{'from_file'}[$i] ?
4414                                         $diffinfo->{'from_file'}[$i] :
4415                                         $diffinfo->{'to_file'};
4416                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4417                                 $from->{'href'}[$i] = href(action=>"blob",
4418                                                            hash_base=>$parents[$i],
4419                                                            hash=>$diffinfo->{'from_id'}[$i],
4420                                                            file_name=>$from->{'file'}[$i]);
4421                         } else {
4422                                 $from->{'href'}[$i] = undef;
4423                         }
4424                 }
4425         } else {
4426                 # ordinary (not combined) diff
4427                 $from->{'file'} = $diffinfo->{'from_file'};
4428                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4429                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4430                                                hash=>$diffinfo->{'from_id'},
4431                                                file_name=>$from->{'file'});
4432                 } else {
4433                         delete $from->{'href'};
4434                 }
4435         }
4436
4437         $to->{'file'} = $diffinfo->{'to_file'};
4438         if (!is_deleted($diffinfo)) { # file exists in result
4439                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4440                                      hash=>$diffinfo->{'to_id'},
4441                                      file_name=>$to->{'file'});
4442         } else {
4443                 delete $to->{'href'};
4444         }
4445 }
4446
4447 ## ......................................................................
4448 ## parse to array of hashes functions
4449
4450 sub git_get_heads_list {
4451         my ($limit, @classes) = @_;
4452         @classes = get_branch_refs() unless @classes;
4453         my @patterns = map { "refs/$_" } @classes;
4454         my @headslist;
4455
4456         defined(my $fd = git_cmd_pipe 'for-each-ref',
4457                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4458                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4459                 @patterns)
4460                 or return;
4461         while (my $line = to_utf8(scalar <$fd>)) {
4462                 my %ref_item;
4463
4464                 chomp $line;
4465                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4466                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4467                 my ($committer, $epoch, $tz) =
4468                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4469                 $ref_item{'fullname'}  = $name;
4470                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4471                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4472                 $ref_item{'name'} = $name;
4473                 # for refs neither in 'heads' nor 'remotes' we want to
4474                 # show their ref dir
4475                 my $ref_dir = (defined $1) ? $1 : '';
4476                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4477                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4478                 }
4479
4480                 $ref_item{'id'}    = $hash;
4481                 $ref_item{'title'} = $title || '(no commit message)';
4482                 $ref_item{'epoch'} = $epoch;
4483                 if ($epoch) {
4484                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4485                 } else {
4486                         $ref_item{'age'} = "unknown";
4487                 }
4488
4489                 push @headslist, \%ref_item;
4490         }
4491         close $fd;
4492
4493         return wantarray ? @headslist : \@headslist;
4494 }
4495
4496 sub git_get_tags_list {
4497         my $limit = shift;
4498         my @tagslist;
4499         my $all = shift || 0;
4500         my $order = shift || $default_refs_order;
4501         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4502
4503         defined(my $fd = git_cmd_pipe 'for-each-ref',
4504                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4505                 '--format=%(objectname) %(objecttype) %(refname) '.
4506                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4507                 ($all ? 'refs' : 'refs/tags'))
4508                 or return;
4509         while (my $line = to_utf8(scalar <$fd>)) {
4510                 my %ref_item;
4511
4512                 chomp $line;
4513                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4514                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4515                 my ($creator, $epoch, $tz) =
4516                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4517                 $ref_item{'fullname'} = $name;
4518                 $name =~ s!^refs/!! if $all;
4519                 $name =~ s!^refs/tags/!! unless $all;
4520
4521                 $ref_item{'type'} = $type;
4522                 $ref_item{'id'} = $id;
4523                 $ref_item{'name'} = $name;
4524                 if ($type eq "tag") {
4525                         $ref_item{'subject'} = $title;
4526                         $ref_item{'reftype'} = $reftype;
4527                         $ref_item{'refid'}   = $refid;
4528                 } else {
4529                         $ref_item{'reftype'} = $type;
4530                         $ref_item{'refid'}   = $id;
4531                 }
4532
4533                 if ($type eq "tag" || $type eq "commit") {
4534                         $ref_item{'epoch'} = $epoch;
4535                         if ($epoch) {
4536                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4537                         } else {
4538                                 $ref_item{'age'} = "unknown";
4539                         }
4540                 }
4541
4542                 push @tagslist, \%ref_item;
4543         }
4544         close $fd;
4545
4546         return wantarray ? @tagslist : \@tagslist;
4547 }
4548
4549 ## ----------------------------------------------------------------------
4550 ## filesystem-related functions
4551
4552 sub get_file_owner {
4553         my $path = shift;
4554
4555         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4556         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4557         if (!defined $gcos) {
4558                 return undef;
4559         }
4560         my $owner = $gcos;
4561         $owner =~ s/[,;].*$//;
4562         return to_utf8($owner);
4563 }
4564
4565 # assume that file exists
4566 sub insert_file {
4567         my $filename = shift;
4568
4569         open my $fd, '<', $filename;
4570         while (<$fd>) {
4571                 print to_utf8($_);
4572         }
4573         close $fd;
4574 }
4575
4576 ## ......................................................................
4577 ## mimetype related functions
4578
4579 sub mimetype_guess_file {
4580         my $filename = shift;
4581         my $mimemap = shift;
4582         my $rawmode = shift;
4583         -r $mimemap or return undef;
4584
4585         my %mimemap;
4586         open(my $mh, '<', $mimemap) or return undef;
4587         while (<$mh>) {
4588                 next if m/^#/; # skip comments
4589                 my ($mimetype, @exts) = split(/\s+/);
4590                 foreach my $ext (@exts) {
4591                         $mimemap{$ext} = $mimetype;
4592                 }
4593         }
4594         close($mh);
4595
4596         my ($ext, $ans);
4597         $ext = $1 if $filename =~ /\.([^.]*)$/;
4598         $ans = $mimemap{$ext} if $ext;
4599         if (defined $ans) {
4600                 my $l = lc($ans);
4601                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4602                 if (!$rawmode) {
4603                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4604                                              $l eq 'image/svg+xml' ||
4605                                              $l eq 'application/xml-dtd' ||
4606                                              $l eq 'application/xml-external-parsed-entity';
4607                 }
4608         }
4609         return $ans;
4610 }
4611
4612 sub mimetype_guess {
4613         my $filename = shift;
4614         my $rawmode = shift;
4615         my $mime;
4616         $filename =~ /\./ or return undef;
4617
4618         if ($mimetypes_file) {
4619                 my $file = $mimetypes_file;
4620                 if ($file !~ m!^/!) { # if it is relative path
4621                         # it is relative to project
4622                         $file = "$projectroot/$project/$file";
4623                 }
4624                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4625         }
4626         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4627         return $mime;
4628 }
4629
4630 sub blob_mimetype {
4631         my $fd = shift;
4632         my $filename = shift;
4633         my $rawmode = shift;
4634         my $mime;
4635
4636         # The -T/-B file operators produce the wrong result unless a perlio
4637         # layer is present when the file handle is a pipe that delivers less
4638         # than 512 bytes of data before reaching EOF.
4639         #
4640         # If we are running in a Perl that uses the stdio layer rather than the
4641         # unix+perlio layers we will end up adding a perlio layer on top of the
4642         # stdio layer and get a second level of buffering.  This is harmless
4643         # and it makes the -T/-B file operators work properly in all cases.
4644
4645         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4646                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4647
4648         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4649
4650         if (!$mime && $filename) {
4651                 if ($filename =~ m/\.html?$/i) {
4652                         $mime = 'text/html';
4653                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4654                         $mime = 'text/html';
4655                 } elsif ($filename =~ m/\.te?xt?$/i) {
4656                         $mime = 'text/plain';
4657                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4658                         $mime = 'text/plain';
4659                 } elsif ($filename =~ m/\.png$/i) {
4660                         $mime = 'image/png';
4661                 } elsif ($filename =~ m/\.gif$/i) {
4662                         $mime = 'image/gif';
4663                 } elsif ($filename =~ m/\.jpe?g$/i) {
4664                         $mime = 'image/jpeg';
4665                 } elsif ($filename =~ m/\.svgz?$/i) {
4666                         $mime = 'image/svg+xml';
4667                 }
4668         }
4669
4670         # just in case
4671         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4672
4673         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4674
4675         return $mime;
4676 }
4677
4678 sub is_ascii {
4679         use bytes;
4680         my $data = shift;
4681         return scalar($data =~ /^[\x00-\x7f]*$/);
4682 }
4683
4684 sub is_valid_utf8 {
4685         my $data = shift;
4686         return utf8::decode($data);
4687 }
4688
4689 sub extract_html_charset {
4690         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4691         my $head = $1;
4692         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4693         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) {
4694                 my %kv = (lc($1) => $3, lc($4) => $6);
4695                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4696                 return $1 if $he && $c && $he eq 'content-type' &&
4697                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4698         }
4699         return undef;
4700 }
4701
4702 sub blob_contenttype {
4703         my ($fd, $file_name, $type) = @_;
4704
4705         $type ||= blob_mimetype($fd, $file_name, 1);
4706         return $type unless $type =~ m!^text/.+!i;
4707         my ($leader, $charset, $htmlcharset);
4708         if ($fd && read($fd, $leader, 32768)) {{
4709                 $charset='US-ASCII' if is_ascii($leader);
4710                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4711                 $charset='ISO-8859-1' unless $charset;
4712                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4713                 if ($htmlcharset && $charset ne 'US-ASCII') {
4714                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4715                 }
4716         }}
4717         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4718         my $defcharset = $default_text_plain_charset || '';
4719         $defcharset =~ s/^\s+//;
4720         $defcharset =~ s/\s+$//;
4721         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4722         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4723 }
4724
4725 # peek the first upto 128 bytes off a file handle
4726 sub peek128bytes {
4727         my $fd = shift;
4728
4729         use IO::Handle;
4730         use bytes;
4731
4732         my $prefix128;
4733         return '' unless $fd && read($fd, $prefix128, 128);
4734
4735         # In the general case, we're guaranteed only to be able to ungetc one
4736         # character (provided, of course, we actually got a character first).
4737         #
4738         # However, we know:
4739         #
4740         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4741         #    already been called at least once on the file handle before us
4742         #
4743         # 2) we have an $fd positioned at the start of the input stream and
4744         #    therefore know we were positioned at a buffer boundary before
4745         #    reading the initial upto 128 bytes
4746         #
4747         # 3) the buffer size is at least 512 bytes
4748         #
4749         # 4) we are careful to only unget raw bytes
4750         #
4751         # 5) we are attempting to unget exactly the same number of bytes we got
4752         #
4753         # Given the above conditions we will ALWAYS be able to safely unget
4754         # the $prefix128 value we just got.
4755         #
4756         # In fact, we could read up to 511 bytes and still be sure.
4757         # (Reading 512 might pop us into the next internal buffer, but probably
4758         # not since that could break the always able to unget at least the one
4759         # you just got guarantee.)
4760
4761         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4762
4763         return $prefix128;
4764 }
4765
4766 # guess file syntax for syntax highlighting; return undef if no highlighting
4767 # the name of syntax can (in the future) depend on syntax highlighter used
4768 sub guess_file_syntax {
4769         my ($fd, $mimetype, $file_name) = @_;
4770         return undef unless $fd && defined $file_name &&
4771                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4772         my $basename = basename($file_name, '.in');
4773         return $highlight_basename{$basename}
4774                 if exists $highlight_basename{$basename};
4775
4776         # Peek to see if there's a shebang or xml line.
4777         # We always operate on bytes when testing this.
4778         {
4779                 use bytes;
4780                 my $shebang = peek128bytes($fd);
4781                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4782                         foreach my $key (keys %highlight_shebang) {
4783                                 my $ar = ref($highlight_shebang{$key}) ?
4784                                         $highlight_shebang{$key} :
4785                                         [$highlight_shebang{key}];
4786                                 map {return $key if $shebang =~ /$_/} @$ar;
4787                         }
4788                 }
4789                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4790         }
4791
4792         $basename =~ /\.([^.]*)$/;
4793         my $ext = $1 or return undef;
4794         return $highlight_ext{$ext}
4795                 if exists $highlight_ext{$ext};
4796
4797         return undef;
4798 }
4799
4800 # run highlighter and return FD of its output,
4801 # or return original FD if no highlighting
4802 sub run_highlighter {
4803         my ($fd, $syntax) = @_;
4804         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4805
4806         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4807                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4808                 quote_command($highlight_bin).
4809                 " --replace-tabs=8 --fragment --syntax $syntax")
4810                 or die_error(500, "Couldn't open file or run syntax highlighter");
4811         if (eof $hifd) {
4812                 # just in case, should not happen as we tested !eof($fd) above
4813                 return $fd if close($hifd);
4814
4815                 # should not happen
4816                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4817
4818                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4819                 # instead of dying horribly on this, just skip the highlighting
4820                 # but do output a message about it to STDERR that will end up in the log
4821                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4822                         sprintf("child exit status 0x%x\n", $?);
4823                 return $fd
4824         }
4825         close $fd;
4826         return ($hifd, 1);
4827 }
4828
4829 ## ======================================================================
4830 ## functions printing HTML: header, footer, error page
4831
4832 sub get_page_title {
4833         my $title = to_utf8($site_name);
4834
4835         unless (defined $project) {
4836                 if (defined $project_filter) {
4837                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4838                 }
4839                 return $title;
4840         }
4841         $title .= " - " . to_utf8($project);
4842
4843         return $title unless (defined $action);
4844         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4845         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4846
4847         return $title unless (defined $file_name);
4848         $title .= " - " . esc_path($file_name);
4849         if ($action eq "tree" && $file_name !~ m|/$|) {
4850                 $title .= "/";
4851         }
4852
4853         return $title;
4854 }
4855
4856 sub get_content_type_html {
4857         # We do not ever emit application/xhtml+xml since that gives us
4858         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4859         # strict, which is troublesome for example when showing user-supplied
4860         # README.html files.
4861         return 'text/html';
4862 }
4863
4864 sub print_feed_meta {
4865         if (defined $project) {
4866                 my %href_params = get_feed_info();
4867                 if (!exists $href_params{'-title'}) {
4868                         $href_params{'-title'} = 'log';
4869                 }
4870
4871                 foreach my $format (qw(RSS Atom)) {
4872                         my $type = lc($format);
4873                         my %link_attr = (
4874                                 '-rel' => 'alternate',
4875                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4876                                 '-type' => "application/$type+xml"
4877                         );
4878
4879                         $href_params{'extra_options'} = undef;
4880                         $href_params{'action'} = $type;
4881                         $link_attr{'-href'} = href(%href_params);
4882                         print "<link ".
4883                               "rel=\"$link_attr{'-rel'}\" ".
4884                               "title=\"$link_attr{'-title'}\" ".
4885                               "href=\"$link_attr{'-href'}\" ".
4886                               "type=\"$link_attr{'-type'}\" ".
4887                               "/>\n";
4888
4889                         $href_params{'extra_options'} = '--no-merges';
4890                         $link_attr{'-href'} = href(%href_params);
4891                         $link_attr{'-title'} .= ' (no merges)';
4892                         print "<link ".
4893                               "rel=\"$link_attr{'-rel'}\" ".
4894                               "title=\"$link_attr{'-title'}\" ".
4895                               "href=\"$link_attr{'-href'}\" ".
4896                               "type=\"$link_attr{'-type'}\" ".
4897                               "/>\n";
4898                 }
4899
4900         } else {
4901                 printf('<link rel="alternate" title="%s projects list" '.
4902                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4903                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4904                 printf('<link rel="alternate" title="%s projects feeds" '.
4905                        'href="%s" type="text/x-opml" />'."\n",
4906                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4907         }
4908 }
4909
4910 sub print_header_links {
4911         my $status = shift;
4912
4913         # print out each stylesheet that exist, providing backwards capability
4914         # for those people who defined $stylesheet in a config file
4915         if (defined $stylesheet) {
4916                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4917         } else {
4918                 foreach my $stylesheet (@stylesheets) {
4919                         next unless $stylesheet;
4920                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4921                 }
4922         }
4923         print_feed_meta()
4924                 if ($status eq '200 OK');
4925         if (defined $favicon) {
4926                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4927         }
4928 }
4929
4930 sub print_nav_breadcrumbs_path {
4931         my $dirprefix = undef;
4932         while (my $part = shift) {
4933                 $dirprefix .= "/" if defined $dirprefix;
4934                 $dirprefix .= $part;
4935                 print $cgi->a({-href => href(project => undef,
4936                                              project_filter => $dirprefix,
4937                                              action => "project_list")},
4938                               esc_html($part)) . " / ";
4939         }
4940 }
4941
4942 sub print_nav_breadcrumbs {
4943         my %opts = @_;
4944
4945         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4946                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4947         }
4948         if (defined $project) {
4949                 my @dirname = split '/', $project;
4950                 my $projectbasename = pop @dirname;
4951                 print_nav_breadcrumbs_path(@dirname);
4952                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4953                 if (defined $action) {
4954                         my $action_print = $action ;
4955                         $action_print = 'blame' if $action_print eq 'blame_incremental';
4956                         if (defined $opts{-action_extra}) {
4957                                 $action_print = $cgi->a({-href => href(action=>$action)},
4958                                         $action);
4959                         }
4960                         print " / $action_print";
4961                 }
4962                 if (defined $opts{-action_extra}) {
4963                         print " / $opts{-action_extra}";
4964                 }
4965                 print "\n";
4966         } elsif (defined $project_filter) {
4967                 print_nav_breadcrumbs_path(split '/', $project_filter);
4968         }
4969 }
4970
4971 sub print_search_form {
4972         if (!defined $searchtext) {
4973                 $searchtext = "";
4974         }
4975         my $search_hash;
4976         if (defined $hash_base) {
4977                 $search_hash = $hash_base;
4978         } elsif (defined $hash) {
4979                 $search_hash = $hash;
4980         } else {
4981                 $search_hash = "HEAD";
4982         }
4983         # We can't use href() here because we need to encode the
4984         # URL parameters into the form, not into the action link.
4985         my $action = $my_uri;
4986         my $use_pathinfo = gitweb_check_feature('pathinfo');
4987         if ($use_pathinfo) {
4988                 # See notes about doubled / in href()
4989                 $action =~ s,/$,,;
4990                 $action .= "/".esc_path_info($project);
4991         }
4992         print $cgi->start_form(-method => "get", -action => $action) .
4993               "<div class=\"search\">\n" .
4994               (!$use_pathinfo &&
4995               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
4996               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
4997               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
4998               $cgi->popup_menu(-name => 'st', -default => 'commit',
4999                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
5000               " " . $cgi->a({-href => href(action=>"search_help"),
5001                              -title => "search help" }, "?") . " search:\n",
5002               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
5003               "<span title=\"Extended regular expression\">" .
5004               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5005                              -checked => $search_use_regexp) .
5006               "</span>" .
5007               "</div>" .
5008               $cgi->end_form() . "\n";
5009 }
5010
5011 sub git_header_html {
5012         my $status = shift || "200 OK";
5013         my $expires = shift;
5014         my %opts = @_;
5015
5016         my $title = get_page_title();
5017         my $content_type = get_content_type_html();
5018         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5019                            -status=> $status, -expires => $expires)
5020                 unless ($opts{'-no_http_header'});
5021         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5022         print <<EOF;
5023 <?xml version="1.0" encoding="utf-8"?>
5024 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5025 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5026 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5027 <!-- git core binaries version $git_version -->
5028 <head>
5029 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5030 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5031 <meta name="robots" content="index, nofollow"/>
5032 <title>$title</title>
5033 <script type="text/javascript">/* <![CDATA[ */
5034 function fixBlameLinks() {
5035         var allLinks = document.getElementsByTagName("a");
5036         for (var i = 0; i < allLinks.length; i++) {
5037                 var link = allLinks.item(i);
5038                 if (link.className == 'blamelink')
5039                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5040         }
5041 }
5042 /* ]]> */</script>
5043 EOF
5044         # the stylesheet, favicon etc urls won't work correctly with path_info
5045         # unless we set the appropriate base URL
5046         if ($ENV{'PATH_INFO'}) {
5047                 print "<base href=\"".esc_url($base_url)."\" />\n";
5048         }
5049         print_header_links($status);
5050
5051         if (defined $site_html_head_string) {
5052                 print to_utf8($site_html_head_string);
5053         }
5054
5055         print "</head>\n" .
5056               "<body>\n";
5057
5058         if (defined $site_header && -f $site_header) {
5059                 insert_file($site_header);
5060         }
5061
5062         print "<div class=\"page_header\">\n";
5063         if (defined $logo) {
5064                 print $cgi->a({-href => esc_url($logo_url),
5065                                -title => $logo_label},
5066                               $cgi->img({-src => esc_url($logo),
5067                                          -width => 72, -height => 27,
5068                                          -alt => "git",
5069                                          -class => "logo"}));
5070         }
5071         print_nav_breadcrumbs(%opts);
5072         print "</div>\n";
5073
5074         my $have_search = gitweb_check_feature('search');
5075         if (defined $project && $have_search) {
5076                 print_search_form();
5077         }
5078 }
5079
5080 sub compute_timed_interval {
5081         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5082         return tv_interval($t0, [ gettimeofday() ]);
5083 }
5084
5085 sub compute_commands_count {
5086         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5087         my $s = $number_of_git_cmds == 1 ? '' : 's';
5088         return '<span id="generating_cmd">'.
5089                 $number_of_git_cmds.
5090                 "</span> git command$s";
5091 }
5092
5093 sub git_footer_html {
5094         my $feed_class = 'rss_logo';
5095
5096         print "<div class=\"page_footer\">\n";
5097         if (defined $project) {
5098                 my $descr = git_get_project_description($project);
5099                 if (defined $descr) {
5100                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5101                 }
5102
5103                 my %href_params = get_feed_info();
5104                 if (!%href_params) {
5105                         $feed_class .= ' generic';
5106                 }
5107                 $href_params{'-title'} ||= 'log';
5108
5109                 foreach my $format (qw(RSS Atom)) {
5110                         $href_params{'action'} = lc($format);
5111                         print $cgi->a({-href => href(%href_params),
5112                                       -title => "$href_params{'-title'} $format feed",
5113                                       -class => $feed_class}, $format)."\n";
5114                 }
5115
5116         } else {
5117                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5118                                              project_filter => $project_filter),
5119                               -class => $feed_class}, "OPML") . " ";
5120                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5121                                              project_filter => $project_filter),
5122                               -class => $feed_class}, "TXT") . "\n";
5123         }
5124         print "</div>\n"; # class="page_footer"
5125
5126         if (defined $t0 && gitweb_check_feature('timed')) {
5127                 print "<div id=\"generating_info\">\n";
5128                 print 'This page took '.
5129                       '<span id="generating_time" class="time_span">'.
5130                       compute_timed_interval().
5131                       ' seconds </span>'.
5132                       ' and '.
5133                       compute_commands_count().
5134                       " to generate.\n";
5135                 print "</div>\n"; # class="page_footer"
5136         }
5137
5138         if (defined $site_footer && -f $site_footer) {
5139                 insert_file($site_footer);
5140         }
5141
5142         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5143         if (defined $action &&
5144             $action eq 'blame_incremental') {
5145                 print qq!<script type="text/javascript">\n!.
5146                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5147                       qq!           "!. href() .qq!");\n!.
5148                       qq!</script>\n!;
5149         } else {
5150                 my ($jstimezone, $tz_cookie, $datetime_class) =
5151                         gitweb_get_feature('javascript-timezone');
5152
5153                 print qq!<script type="text/javascript">\n!.
5154                       qq!window.onload = function () {\n!;
5155                 if (gitweb_check_feature('blame_incremental')) {
5156                         print qq!       fixBlameLinks();\n!;
5157                 }
5158                 if (gitweb_check_feature('javascript-actions')) {
5159                         print qq!       fixLinks();\n!;
5160                 }
5161                 if ($jstimezone && $tz_cookie && $datetime_class) {
5162                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5163                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5164                 }
5165                 print qq!};\n!.
5166                       qq!</script>\n!;
5167         }
5168
5169         print "</body>\n" .
5170               "</html>";
5171 }
5172
5173 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5174 # Example: die_error(404, 'Hash not found')
5175 # By convention, use the following status codes (as defined in RFC 2616):
5176 # 400: Invalid or missing CGI parameters, or
5177 #      requested object exists but has wrong type.
5178 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5179 #      this server or project.
5180 # 404: Requested object/revision/project doesn't exist.
5181 # 500: The server isn't configured properly, or
5182 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5183 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5184 # 503: The server is currently unavailable (because it is overloaded,
5185 #      or down for maintenance).  Generally, this is a temporary state.
5186 sub die_error {
5187         my $status = shift || 500;
5188         my $error = esc_html(shift) || "Internal Server Error";
5189         my $extra = shift;
5190         my %opts = @_;
5191
5192         my %http_responses = (
5193                 400 => '400 Bad Request',
5194                 403 => '403 Forbidden',
5195                 404 => '404 Not Found',
5196                 500 => '500 Internal Server Error',
5197                 503 => '503 Service Unavailable',
5198         );
5199         git_header_html($http_responses{$status}, undef, %opts);
5200         print <<EOF;
5201 <div class="page_body">
5202 <br /><br />
5203 $status - $error
5204 <br />
5205 EOF
5206         if (defined $extra) {
5207                 print "<hr />\n" .
5208                       "$extra\n";
5209         }
5210         print "</div>\n";
5211
5212         git_footer_html();
5213         goto DONE_GITWEB
5214                 unless ($opts{'-error_handler'});
5215 }
5216
5217 ## ----------------------------------------------------------------------
5218 ## functions printing or outputting HTML: navigation
5219
5220 sub git_print_page_nav {
5221         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5222         $extra = '' if !defined $extra; # pager or formats
5223
5224         my @navs = qw(summary log commit commitdiff tree refs);
5225         if ($suppress) {
5226                 @navs = grep { $_ ne $suppress } @navs;
5227         }
5228
5229         my %arg = map { $_ => {action=>$_} } @navs;
5230         if (defined $head) {
5231                 for (qw(commit commitdiff)) {
5232                         $arg{$_}{'hash'} = $head;
5233                 }
5234                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5235                         $arg{'log'}{'hash'} = $head;
5236                 }
5237         }
5238
5239         $arg{'log'}{'action'} = 'shortlog';
5240         if ($current eq 'log') {
5241                 $current = 'shortlog';
5242         } elsif ($current eq 'shortlog') {
5243                 $current = 'log';
5244         }
5245         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5246         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5247
5248         my @actions = gitweb_get_feature('actions');
5249         my $escname = $project;
5250         $escname =~ s/[+]/%2B/g;
5251         my %repl = (
5252                 '%' => '%',
5253                 'n' => $project,         # project name
5254                 'f' => $git_dir,         # project path within filesystem
5255                 'h' => $treehead || '',  # current hash ('h' parameter)
5256                 'b' => $treebase || '',  # hash base ('hb' parameter)
5257                 'e' => $escname,         # project name with '+' escaped
5258         );
5259         while (@actions) {
5260                 my ($label, $link, $pos) = splice(@actions,0,3);
5261                 # insert
5262                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5263                 # munch munch
5264                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5265                 $arg{$label}{'_href'} = $link;
5266         }
5267
5268         print "<div class=\"page_nav\">\n" .
5269                 (join " | ",
5270                  map { $_ eq $current ?
5271                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
5272                  } @navs);
5273         print "<br/>\n$extra<br/>\n" .
5274               "</div>\n";
5275 }
5276
5277 # returns a submenu for the nagivation of the refs views (tags, heads,
5278 # remotes) with the current view disabled and the remotes view only
5279 # available if the feature is enabled
5280 sub format_ref_views {
5281         my ($current) = @_;
5282         my @ref_views = qw{tags heads};
5283         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5284         return join " | ", map {
5285                 $_ eq $current ? $_ :
5286                 $cgi->a({-href => href(action=>$_)}, $_)
5287         } @ref_views
5288 }
5289
5290 sub format_paging_nav {
5291         my ($action, $page, $has_next_link) = @_;
5292         my $paging_nav;
5293
5294
5295         if ($page > 0) {
5296                 $paging_nav .=
5297                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
5298                         " &#183; " .
5299                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5300                                  -accesskey => "p", -title => "Alt-p"}, "prev");
5301         } else {
5302                 $paging_nav .= "first &#183; prev";
5303         }
5304
5305         if ($has_next_link) {
5306                 $paging_nav .= " &#183; " .
5307                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5308                                  -accesskey => "n", -title => "Alt-n"}, "next");
5309         } else {
5310                 $paging_nav .= " &#183; next";
5311         }
5312
5313         return $paging_nav;
5314 }
5315
5316 sub format_log_nav {
5317         my ($action, $page, $has_next_link) = @_;
5318         my $paging_nav;
5319
5320         if ($action eq 'shortlog') {
5321                 $paging_nav .= 'shortlog';
5322         } else {
5323                 $paging_nav .= $cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog');
5324         }
5325         $paging_nav .= ' | ';
5326         if ($action eq 'log') {
5327                 $paging_nav .= 'fulllog';
5328         } else {
5329                 $paging_nav .= $cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog');
5330         }
5331
5332         $paging_nav .= " | " . format_paging_nav($action, $page, $has_next_link);
5333         return $paging_nav;
5334 }
5335
5336 ## ......................................................................
5337 ## functions printing or outputting HTML: div
5338
5339 sub git_print_header_div {
5340         my ($action, $title, $hash, $hash_base, $extra) = @_;
5341         my %args = ();
5342         defined $extra or $extra = '';
5343
5344         $args{'action'} = $action;
5345         $args{'hash'} = $hash if $hash;
5346         $args{'hash_base'} = $hash_base if $hash_base;
5347
5348         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5349                             $title ? $title : $action);
5350         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5351         print "<div class=\"header\">\n" . '<span class="title">' .
5352               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5353 }
5354
5355 sub format_repo_url {
5356         my ($name, $url) = @_;
5357         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5358 }
5359
5360 # Group output by placing it in a DIV element and adding a header.
5361 # Options for start_div() can be provided by passing a hash reference as the
5362 # first parameter to the function.
5363 # Options to git_print_header_div() can be provided by passing an array
5364 # reference. This must follow the options to start_div if they are present.
5365 # The content can be a scalar, which is output as-is, a scalar reference, which
5366 # is output after html escaping, an IO handle passed either as *handle or
5367 # *handle{IO}, or a function reference. In the latter case all following
5368 # parameters will be taken as argument to the content function call.
5369 sub git_print_section {
5370         my ($div_args, $header_args, $content);
5371         my $arg = shift;
5372         if (ref($arg) eq 'HASH') {
5373                 $div_args = $arg;
5374                 $arg = shift;
5375         }
5376         if (ref($arg) eq 'ARRAY') {
5377                 $header_args = $arg;
5378                 $arg = shift;
5379         }
5380         $content = $arg;
5381
5382         print $cgi->start_div($div_args);
5383         git_print_header_div(@$header_args);
5384
5385         if (ref($content) eq 'CODE') {
5386                 $content->(@_);
5387         } elsif (ref($content) eq 'SCALAR') {
5388                 print esc_html($$content);
5389         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5390                 while (<$content>) {
5391                         print to_utf8($_);
5392                 }
5393         } elsif (!ref($content) && defined($content)) {
5394                 print $content;
5395         }
5396
5397         print $cgi->end_div;
5398 }
5399
5400 sub format_timestamp_html {
5401         my $date = shift;
5402         my $strtime = $date->{'rfc2822'};
5403
5404         my (undef, undef, $datetime_class) =
5405                 gitweb_get_feature('javascript-timezone');
5406         if ($datetime_class) {
5407                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5408         }
5409
5410         my $localtime_format = '(%d %02d:%02d %s)';
5411         if ($date->{'hour_local'} < 6) {
5412                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5413         }
5414         $strtime .= ' ' .
5415                     sprintf($localtime_format, $date->{'mday_local'},
5416                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5417
5418         return $strtime;
5419 }
5420
5421 # Outputs the author name and date in long form
5422 sub git_print_authorship {
5423         my $co = shift;
5424         my %opts = @_;
5425         my $tag = $opts{-tag} || 'div';
5426         my $author = $co->{'author_name'};
5427
5428         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5429         print "<$tag class=\"author_date\">" .
5430               format_search_author($author, "author", esc_html($author)) .
5431               " [".format_timestamp_html(\%ad)."]".
5432               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5433               "</$tag>\n";
5434 }
5435
5436 # Outputs table rows containing the full author or committer information,
5437 # in the format expected for 'commit' view (& similar).
5438 # Parameters are a commit hash reference, followed by the list of people
5439 # to output information for. If the list is empty it defaults to both
5440 # author and committer.
5441 sub git_print_authorship_rows {
5442         my $co = shift;
5443         # too bad we can't use @people = @_ || ('author', 'committer')
5444         my @people = @_;
5445         @people = ('author', 'committer') unless @people;
5446         foreach my $who (@people) {
5447                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5448                 print "<tr><td>$who</td><td>" .
5449                       format_search_author($co->{"${who}_name"}, $who,
5450                                            esc_html($co->{"${who}_name"})) . " " .
5451                       format_search_author($co->{"${who}_email"}, $who,
5452                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5453                       "</td><td rowspan=\"2\">" .
5454                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5455                       "</td></tr>\n" .
5456                       "<tr>" .
5457                       "<td></td><td>" .
5458                       format_timestamp_html(\%wd) .
5459                       "</td>" .
5460                       "</tr>\n";
5461         }
5462 }
5463
5464 sub git_print_page_path {
5465         my $name = shift;
5466         my $type = shift;
5467         my $hb = shift;
5468
5469
5470         print "<div class=\"page_path\">";
5471         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5472                       -title => 'tree root'}, to_utf8("[$project]"));
5473         print " / ";
5474         if (defined $name) {
5475                 my @dirname = split '/', $name;
5476                 my $basename = pop @dirname;
5477                 my $fullname = '';
5478
5479                 foreach my $dir (@dirname) {
5480                         $fullname .= ($fullname ? '/' : '') . $dir;
5481                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5482                                                      hash_base=>$hb),
5483                                       -title => $fullname}, esc_path($dir));
5484                         print " / ";
5485                 }
5486                 if (defined $type && $type eq 'blob') {
5487                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5488                                                      hash_base=>$hb),
5489                                       -title => $name}, esc_path($basename));
5490                 } elsif (defined $type && $type eq 'tree') {
5491                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5492                                                      hash_base=>$hb),
5493                                       -title => $name}, esc_path($basename));
5494                         print " / ";
5495                 } else {
5496                         print esc_path($basename);
5497                 }
5498         }
5499         print "<br/></div>\n";
5500 }
5501
5502 sub git_print_log {
5503         my $log = shift;
5504         my %opts = @_;
5505
5506         if ($opts{'-remove_title'}) {
5507                 # remove title, i.e. first line of log
5508                 shift @$log;
5509         }
5510         # remove leading empty lines
5511         while (defined $log->[0] && $log->[0] eq "") {
5512                 shift @$log;
5513         }
5514
5515         # print log
5516         my $skip_blank_line = 0;
5517         foreach my $line (@$log) {
5518                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5519                         if (! $opts{'-remove_signoff'}) {
5520                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5521                                 $skip_blank_line = 1;
5522                         }
5523                         next;
5524                 }
5525
5526                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5527                         if (! $opts{'-remove_signoff'}) {
5528                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5529                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5530                                         "</span><br/>\n";
5531                                 $skip_blank_line = 1;
5532                         }
5533                         next;
5534                 }
5535
5536                 # print only one empty line
5537                 # do not print empty line after signoff
5538                 if ($line eq "") {
5539                         next if ($skip_blank_line);
5540                         $skip_blank_line = 1;
5541                 } else {
5542                         $skip_blank_line = 0;
5543                 }
5544
5545                 print format_log_line_html($line) . "<br/>\n";
5546         }
5547
5548         if ($opts{'-final_empty_line'}) {
5549                 # end with single empty line
5550                 print "<br/>\n" unless $skip_blank_line;
5551         }
5552 }
5553
5554 # return link target (what link points to)
5555 sub git_get_link_target {
5556         my $hash = shift;
5557         my $link_target;
5558
5559         # read link
5560         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5561                 or return;
5562         {
5563                 local $/ = undef;
5564                 $link_target = to_utf8(scalar <$fd>);
5565         }
5566         close $fd
5567                 or return;
5568
5569         return $link_target;
5570 }
5571
5572 # given link target, and the directory (basedir) the link is in,
5573 # return target of link relative to top directory (top tree);
5574 # return undef if it is not possible (including absolute links).
5575 sub normalize_link_target {
5576         my ($link_target, $basedir) = @_;
5577
5578         # absolute symlinks (beginning with '/') cannot be normalized
5579         return if (substr($link_target, 0, 1) eq '/');
5580
5581         # normalize link target to path from top (root) tree (dir)
5582         my $path;
5583         if ($basedir) {
5584                 $path = $basedir . '/' . $link_target;
5585         } else {
5586                 # we are in top (root) tree (dir)
5587                 $path = $link_target;
5588         }
5589
5590         # remove //, /./, and /../
5591         my @path_parts;
5592         foreach my $part (split('/', $path)) {
5593                 # discard '.' and ''
5594                 next if (!$part || $part eq '.');
5595                 # handle '..'
5596                 if ($part eq '..') {
5597                         if (@path_parts) {
5598                                 pop @path_parts;
5599                         } else {
5600                                 # link leads outside repository (outside top dir)
5601                                 return;
5602                         }
5603                 } else {
5604                         push @path_parts, $part;
5605                 }
5606         }
5607         $path = join('/', @path_parts);
5608
5609         return $path;
5610 }
5611
5612 # print tree entry (row of git_tree), but without encompassing <tr> element
5613 sub git_print_tree_entry {
5614         my ($t, $basedir, $hash_base, $have_blame) = @_;
5615
5616         my %base_key = ();
5617         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5618
5619         # The format of a table row is: mode list link.  Where mode is
5620         # the mode of the entry, list is the name of the entry, an href,
5621         # and link is the action links of the entry.
5622
5623         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5624         if (exists $t->{'size'}) {
5625                 print "<td class=\"size\">$t->{'size'}</td>\n";
5626         }
5627         if ($t->{'type'} eq "blob") {
5628                 print "<td class=\"list\">" .
5629                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5630                                                file_name=>"$basedir$t->{'name'}", %base_key),
5631                                 -class => "list"}, esc_path($t->{'name'}));
5632                 if (S_ISLNK(oct $t->{'mode'})) {
5633                         my $link_target = git_get_link_target($t->{'hash'});
5634                         if ($link_target) {
5635                                 my $norm_target = normalize_link_target($link_target, $basedir);
5636                                 if (defined $norm_target) {
5637                                         print " -> " .
5638                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5639                                                                      file_name=>$norm_target),
5640                                                        -title => $norm_target}, esc_path($link_target));
5641                                 } else {
5642                                         print " -> " . esc_path($link_target);
5643                                 }
5644                         }
5645                 }
5646                 print "</td>\n";
5647                 print "<td class=\"link\">";
5648                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5649                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5650                               "blob");
5651                 if ($have_blame) {
5652                         print " | " .
5653                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5654                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5655                                       -class => "blamelink"},
5656                                       "blame");
5657                 }
5658                 if (defined $hash_base) {
5659                         print " | " .
5660                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5661                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5662                                       "history");
5663                 }
5664                 print " | " .
5665                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5666                                                file_name=>"$basedir$t->{'name'}")},
5667                                 "raw");
5668                 print "</td>\n";
5669
5670         } elsif ($t->{'type'} eq "tree") {
5671                 print "<td class=\"list\">";
5672                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5673                                              file_name=>"$basedir$t->{'name'}",
5674                                              %base_key)},
5675                               esc_path($t->{'name'}));
5676                 print "</td>\n";
5677                 print "<td class=\"link\">";
5678                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5679                                              file_name=>"$basedir$t->{'name'}",
5680                                              %base_key)},
5681                               "tree");
5682                 if (defined $hash_base) {
5683                         print " | " .
5684                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5685                                                      file_name=>"$basedir$t->{'name'}")},
5686                                       "history");
5687                 }
5688                 print "</td>\n";
5689         } else {
5690                 # unknown object: we can only present history for it
5691                 # (this includes 'commit' object, i.e. submodule support)
5692                 print "<td class=\"list\">" .
5693                       esc_path($t->{'name'}) .
5694                       "</td>\n";
5695                 print "<td class=\"link\">";
5696                 if (defined $hash_base) {
5697                         print $cgi->a({-href => href(action=>"history",
5698                                                      hash_base=>$hash_base,
5699                                                      file_name=>"$basedir$t->{'name'}")},
5700                                       "history");
5701                 }
5702                 print "</td>\n";
5703         }
5704 }
5705
5706 ## ......................................................................
5707 ## functions printing large fragments of HTML
5708
5709 # get pre-image filenames for merge (combined) diff
5710 sub fill_from_file_info {
5711         my ($diff, @parents) = @_;
5712
5713         $diff->{'from_file'} = [ ];
5714         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5715         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5716                 if ($diff->{'status'}[$i] eq 'R' ||
5717                     $diff->{'status'}[$i] eq 'C') {
5718                         $diff->{'from_file'}[$i] =
5719                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5720                 }
5721         }
5722
5723         return $diff;
5724 }
5725
5726 # is current raw difftree line of file deletion
5727 sub is_deleted {
5728         my $diffinfo = shift;
5729
5730         return $diffinfo->{'to_id'} eq ('0' x 40);
5731 }
5732
5733 # does patch correspond to [previous] difftree raw line
5734 # $diffinfo  - hashref of parsed raw diff format
5735 # $patchinfo - hashref of parsed patch diff format
5736 #              (the same keys as in $diffinfo)
5737 sub is_patch_split {
5738         my ($diffinfo, $patchinfo) = @_;
5739
5740         return defined $diffinfo && defined $patchinfo
5741                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5742 }
5743
5744
5745 sub git_difftree_body {
5746         my ($difftree, $hash, @parents) = @_;
5747         my ($parent) = $parents[0];
5748         my $have_blame = gitweb_check_feature('blame');
5749         print "<div class=\"list_head\">\n";
5750         if ($#{$difftree} > 10) {
5751                 print(($#{$difftree} + 1) . " files changed:\n");
5752         }
5753         print "</div>\n";
5754
5755         print "<table class=\"" .
5756               (@parents > 1 ? "combined " : "") .
5757               "diff_tree\">\n";
5758
5759         # header only for combined diff in 'commitdiff' view
5760         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5761         if ($has_header) {
5762                 # table header
5763                 print "<thead><tr>\n" .
5764                        "<th></th><th></th>\n"; # filename, patchN link
5765                 for (my $i = 0; $i < @parents; $i++) {
5766                         my $par = $parents[$i];
5767                         print "<th>" .
5768                               $cgi->a({-href => href(action=>"commitdiff",
5769                                                      hash=>$hash, hash_parent=>$par),
5770                                        -title => 'commitdiff to parent number ' .
5771                                                   ($i+1) . ': ' . substr($par,0,7)},
5772                                       $i+1) .
5773                               "&#160;</th>\n";
5774                 }
5775                 print "</tr></thead>\n<tbody>\n";
5776         }
5777
5778         my $alternate = 1;
5779         my $patchno = 0;
5780         foreach my $line (@{$difftree}) {
5781                 my $diff = parsed_difftree_line($line);
5782
5783                 if ($alternate) {
5784                         print "<tr class=\"dark\">\n";
5785                 } else {
5786                         print "<tr class=\"light\">\n";
5787                 }
5788                 $alternate ^= 1;
5789
5790                 if (exists $diff->{'nparents'}) { # combined diff
5791
5792                         fill_from_file_info($diff, @parents)
5793                                 unless exists $diff->{'from_file'};
5794
5795                         if (!is_deleted($diff)) {
5796                                 # file exists in the result (child) commit
5797                                 print "<td>" .
5798                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5799                                                              file_name=>$diff->{'to_file'},
5800                                                              hash_base=>$hash),
5801                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5802                                       "</td>\n";
5803                         } else {
5804                                 print "<td>" .
5805                                       esc_path($diff->{'to_file'}) .
5806                                       "</td>\n";
5807                         }
5808
5809                         if ($action eq 'commitdiff') {
5810                                 # link to patch
5811                                 $patchno++;
5812                                 print "<td class=\"link\">" .
5813                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5814                                               "patch") .
5815                                       " | " .
5816                                       "</td>\n";
5817                         }
5818
5819                         my $has_history = 0;
5820                         my $not_deleted = 0;
5821                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5822                                 my $hash_parent = $parents[$i];
5823                                 my $from_hash = $diff->{'from_id'}[$i];
5824                                 my $from_path = $diff->{'from_file'}[$i];
5825                                 my $status = $diff->{'status'}[$i];
5826
5827                                 $has_history ||= ($status ne 'A');
5828                                 $not_deleted ||= ($status ne 'D');
5829
5830                                 if ($status eq 'A') {
5831                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
5832                                 } elsif ($status eq 'D') {
5833                                         print "<td class=\"link\">" .
5834                                               $cgi->a({-href => href(action=>"blob",
5835                                                                      hash_base=>$hash,
5836                                                                      hash=>$from_hash,
5837                                                                      file_name=>$from_path)},
5838                                                       "blob" . ($i+1)) .
5839                                               " | </td>\n";
5840                                 } else {
5841                                         if ($diff->{'to_id'} eq $from_hash) {
5842                                                 print "<td class=\"link nochange\">";
5843                                         } else {
5844                                                 print "<td class=\"link\">";
5845                                         }
5846                                         print $cgi->a({-href => href(action=>"blobdiff",
5847                                                                      hash=>$diff->{'to_id'},
5848                                                                      hash_parent=>$from_hash,
5849                                                                      hash_base=>$hash,
5850                                                                      hash_parent_base=>$hash_parent,
5851                                                                      file_name=>$diff->{'to_file'},
5852                                                                      file_parent=>$from_path)},
5853                                                       "diff" . ($i+1)) .
5854                                               " | </td>\n";
5855                                 }
5856                         }
5857
5858                         print "<td class=\"link\">";
5859                         if ($not_deleted) {
5860                                 print $cgi->a({-href => href(action=>"blob",
5861                                                              hash=>$diff->{'to_id'},
5862                                                              file_name=>$diff->{'to_file'},
5863                                                              hash_base=>$hash)},
5864                                               "blob");
5865                                 print " | " if ($has_history);
5866                         }
5867                         if ($has_history) {
5868                                 print $cgi->a({-href => href(action=>"history",
5869                                                              file_name=>$diff->{'to_file'},
5870                                                              hash_base=>$hash)},
5871                                               "history");
5872                         }
5873                         print "</td>\n";
5874
5875                         print "</tr>\n";
5876                         next; # instead of 'else' clause, to avoid extra indent
5877                 }
5878                 # else ordinary diff
5879
5880                 my ($to_mode_oct, $to_mode_str, $to_file_type);
5881                 my ($from_mode_oct, $from_mode_str, $from_file_type);
5882                 if ($diff->{'to_mode'} ne ('0' x 6)) {
5883                         $to_mode_oct = oct $diff->{'to_mode'};
5884                         if (S_ISREG($to_mode_oct)) { # only for regular file
5885                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
5886                         }
5887                         $to_file_type = file_type($diff->{'to_mode'});
5888                 }
5889                 if ($diff->{'from_mode'} ne ('0' x 6)) {
5890                         $from_mode_oct = oct $diff->{'from_mode'};
5891                         if (S_ISREG($from_mode_oct)) { # only for regular file
5892                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
5893                         }
5894                         $from_file_type = file_type($diff->{'from_mode'});
5895                 }
5896
5897                 if ($diff->{'status'} eq "A") { # created
5898                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
5899                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
5900                         $mode_chng   .= "]</span>";
5901                         print "<td>";
5902                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5903                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5904                                       -class => "list"}, esc_path($diff->{'file'}));
5905                         print "</td>\n";
5906                         print "<td>$mode_chng</td>\n";
5907                         print "<td class=\"link\">";
5908                         if ($action eq 'commitdiff') {
5909                                 # link to patch
5910                                 $patchno++;
5911                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5912                                               "patch") .
5913                                       " | ";
5914                         }
5915                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5916                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5917                                       "blob");
5918                         print "</td>\n";
5919
5920                 } elsif ($diff->{'status'} eq "D") { # deleted
5921                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5922                         print "<td>";
5923                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5924                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
5925                                        -class => "list"}, esc_path($diff->{'file'}));
5926                         print "</td>\n";
5927                         print "<td>$mode_chng</td>\n";
5928                         print "<td class=\"link\">";
5929                         if ($action eq 'commitdiff') {
5930                                 # link to patch
5931                                 $patchno++;
5932                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5933                                               "patch") .
5934                                       " | ";
5935                         }
5936                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5937                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
5938                                       "blob") . " | ";
5939                         if ($have_blame) {
5940                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5941                                                              file_name=>$diff->{'file'}),
5942                                               -class => "blamelink"},
5943                                               "blame") . " | ";
5944                         }
5945                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5946                                                      file_name=>$diff->{'file'})},
5947                                       "history");
5948                         print "</td>\n";
5949
5950                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5951                         my $mode_chnge = "";
5952                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5953                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5954                                 if ($from_file_type ne $to_file_type) {
5955                                         $mode_chnge .= " from $from_file_type to $to_file_type";
5956                                 }
5957                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
5958                                         if ($from_mode_str && $to_mode_str) {
5959                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
5960                                         } elsif ($to_mode_str) {
5961                                                 $mode_chnge .= " mode: $to_mode_str";
5962                                         }
5963                                 }
5964                                 $mode_chnge .= "]</span>\n";
5965                         }
5966                         print "<td>";
5967                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5968                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5969                                       -class => "list"}, esc_path($diff->{'file'}));
5970                         print "</td>\n";
5971                         print "<td>$mode_chnge</td>\n";
5972                         print "<td class=\"link\">";
5973                         if ($action eq 'commitdiff') {
5974                                 # link to patch
5975                                 $patchno++;
5976                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5977                                               "patch") .
5978                                       " | ";
5979                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5980                                 # "commit" view and modified file (not onlu mode changed)
5981                                 print $cgi->a({-href => href(action=>"blobdiff",
5982                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5983                                                              hash_base=>$hash, hash_parent_base=>$parent,
5984                                                              file_name=>$diff->{'file'})},
5985                                               "diff") .
5986                                       " | ";
5987                         }
5988                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5989                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5990                                        "blob") . " | ";
5991                         if ($have_blame) {
5992                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5993                                                              file_name=>$diff->{'file'}),
5994                                               -class => "blamelink"},
5995                                               "blame") . " | ";
5996                         }
5997                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5998                                                      file_name=>$diff->{'file'})},
5999                                       "history");
6000                         print "</td>\n";
6001
6002                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6003                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6004                         my $nstatus = $status_name{$diff->{'status'}};
6005                         my $mode_chng = "";
6006                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6007                                 # mode also for directories, so we cannot use $to_mode_str
6008                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6009                         }
6010                         print "<td>" .
6011                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6012                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6013                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6014                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6015                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6016                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6017                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6018                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6019                               "<td class=\"link\">";
6020                         if ($action eq 'commitdiff') {
6021                                 # link to patch
6022                                 $patchno++;
6023                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6024                                               "patch") .
6025                                       " | ";
6026                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6027                                 # "commit" view and modified file (not only pure rename or copy)
6028                                 print $cgi->a({-href => href(action=>"blobdiff",
6029                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6030                                                              hash_base=>$hash, hash_parent_base=>$parent,
6031                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6032                                               "diff") .
6033                                       " | ";
6034                         }
6035                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6036                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6037                                       "blob") . " | ";
6038                         if ($have_blame) {
6039                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6040                                                              file_name=>$diff->{'to_file'}),
6041                                               -class => "blamelink"},
6042                                               "blame") . " | ";
6043                         }
6044                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6045                                                     file_name=>$diff->{'to_file'})},
6046                                       "history");
6047                         print "</td>\n";
6048
6049                 } # we should not encounter Unmerged (U) or Unknown (X) status
6050                 print "</tr>\n";
6051         }
6052         print "</tbody>" if $has_header;
6053         print "</table>\n";
6054 }
6055
6056 # Print context lines and then rem/add lines in a side-by-side manner.
6057 sub print_sidebyside_diff_lines {
6058         my ($ctx, $rem, $add) = @_;
6059
6060         # print context block before add/rem block
6061         if (@$ctx) {
6062                 print join '',
6063                         '<div class="chunk_block ctx">',
6064                                 '<div class="old">',
6065                                 @$ctx,
6066                                 '</div>',
6067                                 '<div class="new">',
6068                                 @$ctx,
6069                                 '</div>',
6070                         '</div>';
6071         }
6072
6073         if (!@$add) {
6074                 # pure removal
6075                 print join '',
6076                         '<div class="chunk_block rem">',
6077                                 '<div class="old">',
6078                                 @$rem,
6079                                 '</div>',
6080                         '</div>';
6081         } elsif (!@$rem) {
6082                 # pure addition
6083                 print join '',
6084                         '<div class="chunk_block add">',
6085                                 '<div class="new">',
6086                                 @$add,
6087                                 '</div>',
6088                         '</div>';
6089         } else {
6090                 print join '',
6091                         '<div class="chunk_block chg">',
6092                                 '<div class="old">',
6093                                 @$rem,
6094                                 '</div>',
6095                                 '<div class="new">',
6096                                 @$add,
6097                                 '</div>',
6098                         '</div>';
6099         }
6100 }
6101
6102 # Print context lines and then rem/add lines in inline manner.
6103 sub print_inline_diff_lines {
6104         my ($ctx, $rem, $add) = @_;
6105
6106         print @$ctx, @$rem, @$add;
6107 }
6108
6109 # Format removed and added line, mark changed part and HTML-format them.
6110 # Implementation is based on contrib/diff-highlight
6111 sub format_rem_add_lines_pair {
6112         my ($rem, $add, $num_parents) = @_;
6113
6114         # We need to untabify lines before split()'ing them;
6115         # otherwise offsets would be invalid.
6116         chomp $rem;
6117         chomp $add;
6118         $rem = untabify($rem);
6119         $add = untabify($add);
6120
6121         my @rem = split(//, $rem);
6122         my @add = split(//, $add);
6123         my ($esc_rem, $esc_add);
6124         # Ignore leading +/- characters for each parent.
6125         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6126         my ($prefix_has_nonspace, $suffix_has_nonspace);
6127
6128         my $shorter = (@rem < @add) ? @rem : @add;
6129         while ($prefix_len < $shorter) {
6130                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6131
6132                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6133                 $prefix_len++;
6134         }
6135
6136         while ($prefix_len + $suffix_len < $shorter) {
6137                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6138
6139                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6140                 $suffix_len++;
6141         }
6142
6143         # Mark lines that are different from each other, but have some common
6144         # part that isn't whitespace.  If lines are completely different, don't
6145         # mark them because that would make output unreadable, especially if
6146         # diff consists of multiple lines.
6147         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6148                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6149                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6150                 $esc_add = esc_html_hl_regions($add, 'marked',
6151                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6152         } else {
6153                 $esc_rem = esc_html($rem, -nbsp=>1);
6154                 $esc_add = esc_html($add, -nbsp=>1);
6155         }
6156
6157         return format_diff_line(\$esc_rem, 'rem'),
6158                format_diff_line(\$esc_add, 'add');
6159 }
6160
6161 # HTML-format diff context, removed and added lines.
6162 sub format_ctx_rem_add_lines {
6163         my ($ctx, $rem, $add, $num_parents) = @_;
6164         my (@new_ctx, @new_rem, @new_add);
6165         my $can_highlight = 0;
6166         my $is_combined = ($num_parents > 1);
6167
6168         # Highlight if every removed line has a corresponding added line.
6169         if (@$add > 0 && @$add == @$rem) {
6170                 $can_highlight = 1;
6171
6172                 # Highlight lines in combined diff only if the chunk contains
6173                 # diff between the same version, e.g.
6174                 #
6175                 #    - a
6176                 #   -  b
6177                 #    + c
6178                 #   +  d
6179                 #
6180                 # Otherwise the highlightling would be confusing.
6181                 if ($is_combined) {
6182                         for (my $i = 0; $i < @$add; $i++) {
6183                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6184                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6185
6186                                 $prefix_rem =~ s/-/+/g;
6187
6188                                 if ($prefix_rem ne $prefix_add) {
6189                                         $can_highlight = 0;
6190                                         last;
6191                                 }
6192                         }
6193                 }
6194         }
6195
6196         if ($can_highlight) {
6197                 for (my $i = 0; $i < @$add; $i++) {
6198                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6199                                 $rem->[$i], $add->[$i], $num_parents);
6200                         push @new_rem, $line_rem;
6201                         push @new_add, $line_add;
6202                 }
6203         } else {
6204                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6205                 @new_add = map { format_diff_line($_, 'add') } @$add;
6206         }
6207
6208         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6209
6210         return (\@new_ctx, \@new_rem, \@new_add);
6211 }
6212
6213 # Print context lines and then rem/add lines.
6214 sub print_diff_lines {
6215         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6216         my $is_combined = $num_parents > 1;
6217
6218         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6219                 $num_parents);
6220
6221         if ($diff_style eq 'sidebyside' && !$is_combined) {
6222                 print_sidebyside_diff_lines($ctx, $rem, $add);
6223         } else {
6224                 # default 'inline' style and unknown styles
6225                 print_inline_diff_lines($ctx, $rem, $add);
6226         }
6227 }
6228
6229 sub print_diff_chunk {
6230         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6231         my (@ctx, @rem, @add);
6232
6233         # The class of the previous line.
6234         my $prev_class = '';
6235
6236         return unless @chunk;
6237
6238         # incomplete last line might be among removed or added lines,
6239         # or both, or among context lines: find which
6240         for (my $i = 1; $i < @chunk; $i++) {
6241                 if ($chunk[$i][0] eq 'incomplete') {
6242                         $chunk[$i][0] = $chunk[$i-1][0];
6243                 }
6244         }
6245
6246         # guardian
6247         push @chunk, ["", ""];
6248
6249         foreach my $line_info (@chunk) {
6250                 my ($class, $line) = @$line_info;
6251
6252                 # print chunk headers
6253                 if ($class && $class eq 'chunk_header') {
6254                         print format_diff_line($line, $class, $from, $to);
6255                         next;
6256                 }
6257
6258                 ## print from accumulator when have some add/rem lines or end
6259                 # of chunk (flush context lines), or when have add and rem
6260                 # lines and new block is reached (otherwise add/rem lines could
6261                 # be reordered)
6262                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6263                     (@rem && @add && $class ne $prev_class)) {
6264                         print_diff_lines(\@ctx, \@rem, \@add,
6265                                          $diff_style, $num_parents);
6266                         @ctx = @rem = @add = ();
6267                 }
6268
6269                 ## adding lines to accumulator
6270                 # guardian value
6271                 last unless $line;
6272                 # rem, add or change
6273                 if ($class eq 'rem') {
6274                         push @rem, $line;
6275                 } elsif ($class eq 'add') {
6276                         push @add, $line;
6277                 }
6278                 # context line
6279                 if ($class eq 'ctx') {
6280                         push @ctx, $line;
6281                 }
6282
6283                 $prev_class = $class;
6284         }
6285 }
6286
6287 sub git_patchset_body {
6288         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6289         my ($hash_parent) = $hash_parents[0];
6290
6291         my $is_combined = (@hash_parents > 1);
6292         my $patch_idx = 0;
6293         my $patch_number = 0;
6294         my $patch_line;
6295         my $diffinfo;
6296         my $to_name;
6297         my (%from, %to);
6298         my @chunk; # for side-by-side diff
6299
6300         print "<div class=\"patchset\">\n";
6301
6302         # skip to first patch
6303         while ($patch_line = to_utf8(scalar <$fd>)) {
6304                 chomp $patch_line;
6305
6306                 last if ($patch_line =~ m/^diff /);
6307         }
6308
6309  PATCH:
6310         while ($patch_line) {
6311
6312                 # parse "git diff" header line
6313                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6314                         # $1 is from_name, which we do not use
6315                         $to_name = unquote($2);
6316                         $to_name =~ s!^b/!!;
6317                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6318                         # $1 is 'cc' or 'combined', which we do not use
6319                         $to_name = unquote($2);
6320                 } else {
6321                         $to_name = undef;
6322                 }
6323
6324                 # check if current patch belong to current raw line
6325                 # and parse raw git-diff line if needed
6326                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6327                         # this is continuation of a split patch
6328                         print "<div class=\"patch cont\">\n";
6329                 } else {
6330                         # advance raw git-diff output if needed
6331                         $patch_idx++ if defined $diffinfo;
6332
6333                         # read and prepare patch information
6334                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6335
6336                         # compact combined diff output can have some patches skipped
6337                         # find which patch (using pathname of result) we are at now;
6338                         if ($is_combined) {
6339                                 while ($to_name ne $diffinfo->{'to_file'}) {
6340                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6341                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6342                                               "</div>\n";  # class="patch"
6343
6344                                         $patch_idx++;
6345                                         $patch_number++;
6346
6347                                         last if $patch_idx > $#$difftree;
6348                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6349                                 }
6350                         }
6351
6352                         # modifies %from, %to hashes
6353                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6354
6355                         # this is first patch for raw difftree line with $patch_idx index
6356                         # we index @$difftree array from 0, but number patches from 1
6357                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6358                 }
6359
6360                 # git diff header
6361                 #assert($patch_line =~ m/^diff /) if DEBUG;
6362                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6363                 $patch_number++;
6364                 # print "git diff" header
6365                 print format_git_diff_header_line($patch_line, $diffinfo,
6366                                                   \%from, \%to);
6367
6368                 # print extended diff header
6369                 print "<div class=\"diff extended_header\">\n";
6370         EXTENDED_HEADER:
6371                 while ($patch_line = to_utf8(scalar<$fd>)) {
6372                         chomp $patch_line;
6373
6374                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6375
6376                         print format_extended_diff_header_line($patch_line, $diffinfo,
6377                                                                \%from, \%to);
6378                 }
6379                 print "</div>\n"; # class="diff extended_header"
6380
6381                 # from-file/to-file diff header
6382                 if (! $patch_line) {
6383                         print "</div>\n"; # class="patch"
6384                         last PATCH;
6385                 }
6386                 next PATCH if ($patch_line =~ m/^diff /);
6387                 #assert($patch_line =~ m/^---/) if DEBUG;
6388
6389                 my $last_patch_line = $patch_line;
6390                 $patch_line = to_utf8(scalar <$fd>);
6391                 chomp $patch_line;
6392                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6393
6394                 print format_diff_from_to_header($last_patch_line, $patch_line,
6395                                                  $diffinfo, \%from, \%to,
6396                                                  @hash_parents);
6397
6398                 # the patch itself
6399         LINE:
6400                 while ($patch_line = to_utf8(scalar <$fd>)) {
6401                         chomp $patch_line;
6402
6403                         next PATCH if ($patch_line =~ m/^diff /);
6404
6405                         my $class = diff_line_class($patch_line, \%from, \%to);
6406
6407                         if ($class eq 'chunk_header') {
6408                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6409                                 @chunk = ();
6410                         }
6411
6412                         push @chunk, [ $class, $patch_line ];
6413                 }
6414
6415         } continue {
6416                 if (@chunk) {
6417                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6418                         @chunk = ();
6419                 }
6420                 print "</div>\n"; # class="patch"
6421         }
6422
6423         # for compact combined (--cc) format, with chunk and patch simplification
6424         # the patchset might be empty, but there might be unprocessed raw lines
6425         for (++$patch_idx if $patch_number > 0;
6426              $patch_idx < @$difftree;
6427              ++$patch_idx) {
6428                 # read and prepare patch information
6429                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6430
6431                 # generate anchor for "patch" links in difftree / whatchanged part
6432                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6433                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6434                       "</div>\n";  # class="patch"
6435
6436                 $patch_number++;
6437         }
6438
6439         if ($patch_number == 0) {
6440                 if (@hash_parents > 1) {
6441                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6442                 } else {
6443                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6444                 }
6445         }
6446
6447         print "</div>\n"; # class="patchset"
6448 }
6449
6450 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6451
6452 sub git_project_search_form {
6453         my ($searchtext, $search_use_regexp) = @_;
6454
6455         my $limit = '';
6456         if ($project_filter) {
6457                 $limit = " in '$project_filter'";
6458         }
6459
6460         print "<div class=\"projsearch\">\n";
6461         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6462               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6463         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6464                 if (defined $project_filter);
6465         print $cgi->textfield(-name => 's', -value => $searchtext,
6466                               -title => "Search project by name and description$limit",
6467                               -size => 60) . "\n" .
6468               "<span title=\"Extended regular expression\">" .
6469               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6470                              -checked => $search_use_regexp) .
6471               "</span>\n" .
6472               $cgi->submit(-name => 'btnS', -value => 'Search') .
6473               $cgi->end_form() . "\n" .
6474               "<span class=\"projectlist_link\">" .
6475               $cgi->a({-href => href(project => undef, searchtext => undef,
6476                                      action => 'project_list',
6477                                      project_filter => $project_filter)},
6478                       esc_html("List all projects$limit")) . "</span><br />\n";
6479         print "<span class=\"projectlist_link\">" .
6480               $cgi->a({-href => href(project => undef, searchtext => undef,
6481                                      action => 'project_list',
6482                                      project_filter => undef)},
6483                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6484         print "</div>\n";
6485 }
6486
6487 # entry for given @keys needs filling if at least one of keys in list
6488 # is not present in %$project_info
6489 sub project_info_needs_filling {
6490         my ($project_info, @keys) = @_;
6491
6492         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6493         foreach my $key (@keys) {
6494                 if (!exists $project_info->{$key}) {
6495                         return 1;
6496                 }
6497         }
6498         return;
6499 }
6500
6501 sub git_cache_file_format {
6502         return GITWEB_CACHE_FORMAT .
6503                 (gitweb_check_feature('forks') ? " (forks)" : "");
6504 }
6505
6506 sub git_retrieve_cache_file {
6507         my $cache_file = shift;
6508
6509         use Storable qw(retrieve);
6510
6511         if ((my $dump = eval { retrieve($cache_file) })) {
6512                 return $$dump[1] if
6513                         ref($dump) eq 'ARRAY' &&
6514                         @$dump == 2 &&
6515                         ref($$dump[1]) eq 'ARRAY' &&
6516                         @{$$dump[1]} == 2 &&
6517                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6518                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6519                         $$dump[0] eq git_cache_file_format();
6520         }
6521
6522         return undef;
6523 }
6524
6525 sub git_store_cache_file {
6526         my ($cache_file, $cachedata) = @_;
6527
6528         use File::Basename qw(dirname);
6529         use File::stat;
6530         use POSIX qw(:fcntl_h);
6531         use Storable qw(store_fd);
6532
6533         my $result = undef;
6534         my $cache_d = dirname($cache_file);
6535         my $mask = umask();
6536         umask($mask & ~0070) if $cache_grpshared;
6537         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6538             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6539                 store_fd([git_cache_file_format(), $cachedata], $fd);
6540                 close $fd;
6541                 rename "$cache_file.lock", $cache_file;
6542                 $result = stat($cache_file)->mtime;
6543         }
6544         umask($mask) if $cache_grpshared;
6545         return $result;
6546 }
6547
6548 sub verify_cached_project {
6549         my ($hashref, $path) = @_;
6550         return undef unless $path;
6551         delete $$hashref{$path}, return undef unless is_valid_project($path);
6552         return $$hashref{$path} if exists $$hashref{$path};
6553
6554         # A valid project was requested but it's not yet in the cache
6555         # Manufacture a minimal project entry (path, name, description)
6556         # Also provide age, but only if it's available via $lastactivity_file
6557
6558         my %proj = ('path' => $path);
6559         my $val = git_get_project_description($path);
6560         defined $val or $val = '';
6561         $proj{'descr_long'} = $val;
6562         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6563         unless ($omit_owner) {
6564                 $val = git_get_project_owner($path);
6565                 defined $val or $val = '';
6566                 $proj{'owner'} = $val;
6567         }
6568         unless ($omit_age_column) {
6569                 ($val) = git_get_last_activity($path, 1);
6570                 $proj{'age_epoch'} = $val if defined $val;
6571         }
6572         $$hashref{$path} = \%proj;
6573         return \%proj;
6574 }
6575
6576 sub git_filter_cached_projects {
6577         my ($cache, $projlist, $verify) = @_;
6578         my $hashref = $$cache[1];
6579         my $sub = $verify ?
6580                 sub {verify_cached_project($hashref, $_[0])} :
6581                 sub {$$hashref{$_[0]}};
6582         return map {
6583                 my $c = &$sub($_->{'path'});
6584                 defined $c ? ($_ = $c) : ()
6585         } @$projlist;
6586 }
6587
6588 # fills project list info (age, description, owner, category, forks, etc.)
6589 # for each project in the list, removing invalid projects from
6590 # returned list, or fill only specified info.
6591 #
6592 # Invalid projects are removed from the returned list if and only if you
6593 # ask 'age_epoch' to be filled, because they are the only fields
6594 # that run unconditionally git command that requires repository, and
6595 # therefore do always check if project repository is invalid.
6596 #
6597 # USAGE:
6598 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6599 #   ensures that 'descr_long' and 'ctags' fields are filled
6600 # * @project_list = fill_project_list_info(\@project_list)
6601 #   ensures that all fields are filled (and invalid projects removed)
6602 #
6603 # NOTE: modifies $projlist, but does not remove entries from it
6604 sub fill_project_list_info {
6605         my ($projlist, @wanted_keys) = @_;
6606
6607         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6608         return fill_project_list_info_uncached($projlist, @wanted_keys)
6609                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6610
6611         use File::stat;
6612
6613         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6614         my $cache_file = "$cache_dir/$projlist_cache_name";
6615
6616         my @projects;
6617         my $stale = 0;
6618         my $now = time();
6619         my $cache_mtime;
6620         if ($cache_lifetime && -f $cache_file) {
6621                 $cache_mtime = stat($cache_file)->mtime;
6622                 $cache_dump = undef if $cache_mtime &&
6623                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6624         }
6625         if (defined $cache_mtime && # caching is on and $cache_file exists
6626             $cache_mtime + $cache_lifetime*60 > $now &&
6627             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6628                 # Cache hit.
6629                 $cache_dump_mtime = $cache_mtime;
6630                 $stale = $now - $cache_mtime;
6631                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6632                         gitweb_check_feature('forks');
6633                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6634
6635         } else { # Cache miss.
6636                 if (defined $cache_mtime) {
6637                         # Postpone timeout by two minutes so that we get
6638                         # enough time to do our job, or to be more exact
6639                         # make cache expire after two minutes from now.
6640                         my $time = $now - $cache_lifetime*60 + 120;
6641                         utime $time, $time, $cache_file;
6642                 }
6643                 my @all_projects = git_get_projects_list();
6644                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6645                         fill_project_list_info_uncached(\@all_projects);
6646                 map { $all_projects_filled{$_->{'path'}} = $_ }
6647                         filter_forks_from_projects_list([values(%all_projects_filled)])
6648                         if gitweb_check_feature('forks');
6649                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6650                                \%all_projects_filled];
6651                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6652                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6653         }
6654
6655         if ($cache_lifetime && $stale > 0) {
6656                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6657                         unless $shown_stale_message;
6658                 $shown_stale_message = 1;
6659         }
6660
6661         return @projects;
6662 }
6663
6664 sub fill_project_list_info_uncached {
6665         my ($projlist, @wanted_keys) = @_;
6666         my @projects;
6667         my $filter_set = sub { return @_; };
6668         if (@wanted_keys) {
6669                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6670                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6671         }
6672
6673         my $show_ctags = gitweb_check_feature('ctags');
6674  PROJECT:
6675         foreach my $pr (@$projlist) {
6676                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6677                         my (@activity) = git_get_last_activity($pr->{'path'});
6678                         unless (@activity) {
6679                                 next PROJECT;
6680                         }
6681                         ($pr->{'age_epoch'}) = @activity;
6682                 }
6683                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6684                         my $descr = git_get_project_description($pr->{'path'}) || "";
6685                         $descr = to_utf8($descr);
6686                         $pr->{'descr_long'} = $descr;
6687                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6688                 }
6689                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6690                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6691                 }
6692                 if ($show_ctags &&
6693                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6694                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6695                 }
6696                 if ($projects_list_group_categories &&
6697                     project_info_needs_filling($pr, $filter_set->('category'))) {
6698                         my $cat = git_get_project_category($pr->{'path'}) ||
6699                                                            $project_list_default_category;
6700                         $pr->{'category'} = to_utf8($cat);
6701                 }
6702
6703                 push @projects, $pr;
6704         }
6705
6706         return @projects;
6707 }
6708
6709 sub sort_projects_list {
6710         my ($projlist, $order) = @_;
6711
6712         sub order_str {
6713                 my $key = shift;
6714                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6715         }
6716
6717         sub order_reverse_num_then_undef {
6718                 my $key = shift;
6719                 return sub {
6720                         defined $a->{$key} ?
6721                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6722                                 (defined $b->{$key} ? 1 : 0)
6723                 };
6724         }
6725
6726         my %orderings = (
6727                 project => order_str('path'),
6728                 descr => order_str('descr_long'),
6729                 owner => order_str('owner'),
6730                 age => order_reverse_num_then_undef('age_epoch'),
6731         );
6732
6733         my $ordering = $orderings{$order};
6734         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6735 }
6736
6737 # returns a hash of categories, containing the list of project
6738 # belonging to each category
6739 sub build_projlist_by_category {
6740         my ($projlist, $from, $to) = @_;
6741         my %categories;
6742
6743         $from = 0 unless defined $from;
6744         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6745
6746         for (my $i = $from; $i <= $to; $i++) {
6747                 my $pr = $projlist->[$i];
6748                 push @{$categories{ $pr->{'category'} }}, $pr;
6749         }
6750
6751         return wantarray ? %categories : \%categories;
6752 }
6753
6754 # print 'sort by' <th> element, generating 'sort by $name' replay link
6755 # if that order is not selected
6756 sub print_sort_th {
6757         print format_sort_th(@_);
6758 }
6759
6760 sub format_sort_th {
6761         my ($name, $order, $header) = @_;
6762         my $sort_th = "";
6763         $header ||= ucfirst($name);
6764
6765         if ($order eq $name) {
6766                 $sort_th .= "<th>$header</th>\n";
6767         } else {
6768                 $sort_th .= "<th>" .
6769                             $cgi->a({-href => href(-replay=>1, order=>$name),
6770                                      -class => "header"}, $header) .
6771                             "</th>\n";
6772         }
6773
6774         return $sort_th;
6775 }
6776
6777 sub git_project_list_rows {
6778         my ($projlist, $from, $to, $check_forks) = @_;
6779
6780         $from = 0 unless defined $from;
6781         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6782
6783         my $now = time;
6784         my $alternate = 1;
6785         for (my $i = $from; $i <= $to; $i++) {
6786                 my $pr = $projlist->[$i];
6787
6788                 if ($alternate) {
6789                         print "<tr class=\"dark\">\n";
6790                 } else {
6791                         print "<tr class=\"light\">\n";
6792                 }
6793                 $alternate ^= 1;
6794
6795                 if ($check_forks) {
6796                         print "<td>";
6797                         if ($pr->{'forks'}) {
6798                                 my $nforks = scalar @{$pr->{'forks'}};
6799                                 my $s = $nforks == 1 ? '' : 's';
6800                                 if ($nforks > 0) {
6801                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6802                                                        -title => "$nforks fork$s"}, "+");
6803                                 } else {
6804                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6805                                 }
6806                         }
6807                         print "</td>\n";
6808                 }
6809                 my $path = $pr->{'path'};
6810                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6811                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6812                                         -class => "list"},
6813                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6814                       "</td>\n" .
6815                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6816                                         -class => "list",
6817                                         -title => $pr->{'descr_long'}},
6818                                         $search_regexp
6819                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6820                                                                     $pr->{'descr'}, $search_regexp)
6821                                         : esc_html($pr->{'descr'})) .
6822                       "</td>\n";
6823                 unless ($omit_owner) {
6824                         print "<td><i>" . ($owner_link_hook
6825                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6826                                                     chop_and_escape_str($pr->{'owner'}, 15))
6827                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6828                 }
6829                 unless ($omit_age_column) {
6830                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6831                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6832                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6833                 }
6834                 print"<td class=\"link\">" .
6835                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
6836                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . " | " .
6837                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6838                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6839                       "</td>\n" .
6840                       "</tr>\n";
6841         }
6842 }
6843
6844 sub git_project_list_body {
6845         # actually uses global variable $project
6846         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
6847         my @projects = @$projlist;
6848
6849         my $check_forks = gitweb_check_feature('forks');
6850         my $show_ctags  = gitweb_check_feature('ctags');
6851         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6852         $check_forks = undef
6853                 if ($tagfilter || $search_regexp);
6854
6855         # filtering out forks before filling info allows us to do less work
6856         if ($check_forks) {
6857                 @projects = filter_forks_from_projects_list(\@projects);
6858                 push @projects, { 'path' => "$project_filter.git" }
6859                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
6860         }
6861         # search_projects_list pre-fills required info
6862         @projects = search_projects_list(\@projects,
6863                                          'search_regexp' => $search_regexp,
6864                                          'tagfilter'  => $tagfilter)
6865                 if ($tagfilter || $search_regexp);
6866         # fill the rest
6867         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6868         push @all_fields, 'age_epoch' unless($omit_age_column);
6869         push @all_fields, 'owner' unless($omit_owner);
6870         @projects = fill_project_list_info(\@projects, @all_fields);
6871
6872         $order ||= $default_projects_order;
6873         $from = 0 unless defined $from;
6874         $to = $#projects if (!defined $to || $#projects < $to);
6875
6876         # short circuit
6877         if ($from > $to) {
6878                 print "<center>\n".
6879                       "<b>No such projects found</b><br />\n".
6880                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
6881                       "</center>\n<br />\n";
6882                 return;
6883         }
6884
6885         @projects = sort_projects_list(\@projects, $order);
6886
6887         if ($show_ctags) {
6888                 my $ctags = git_gather_all_ctags(\@projects);
6889                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
6890                 print git_show_project_tagcloud($cloud, 64);
6891         }
6892
6893         print "<table class=\"project_list\">\n";
6894         unless ($no_header) {
6895                 print "<tr>\n";
6896                 if ($check_forks) {
6897                         print "<th></th>\n";
6898                 }
6899                 print_sort_th('project', $order, 'Project');
6900                 print_sort_th('descr', $order, 'Description');
6901                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
6902                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
6903                 print "<th></th>\n" . # for links
6904                       "</tr>\n";
6905         }
6906
6907         if ($projects_list_group_categories) {
6908                 # only display categories with projects in the $from-$to window
6909                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
6910                 my %categories = build_projlist_by_category(\@projects, $from, $to);
6911                 foreach my $cat (sort keys %categories) {
6912                         unless ($cat eq "") {
6913                                 print "<tr>\n";
6914                                 if ($check_forks) {
6915                                         print "<td></td>\n";
6916                                 }
6917                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
6918                                 print "</tr>\n";
6919                         }
6920
6921                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
6922                 }
6923         } else {
6924                 git_project_list_rows(\@projects, $from, $to, $check_forks);
6925         }
6926
6927         if (defined $extra) {
6928                 print "<tr>\n";
6929                 if ($check_forks) {
6930                         print "<td></td>\n";
6931                 }
6932                 print "<td colspan=\"5\">$extra</td>\n" .
6933                       "</tr>\n";
6934         }
6935         print "</table>\n";
6936 }
6937
6938 sub git_log_body {
6939         # uses global variable $project
6940         my ($commitlist, $from, $to, $refs, $extra) = @_;
6941
6942         $from = 0 unless defined $from;
6943         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6944
6945         for (my $i = 0; $i <= $to; $i++) {
6946                 my %co = %{$commitlist->[$i]};
6947                 next if !%co;
6948                 my $commit = $co{'id'};
6949                 my $ref = format_ref_marker($refs, $commit);
6950                 git_print_header_div('commit',
6951                                "<span class=\"age\">$co{'age_string'}</span>" .
6952                                esc_html($co{'title'}),
6953                                $commit, undef, $ref);
6954                 print "<div class=\"title_text\">\n" .
6955                       "<div class=\"log_link\">\n" .
6956                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
6957                       " | " .
6958                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
6959                       " | " .
6960                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
6961                       "<br/>\n" .
6962                       "</div>\n";
6963                       git_print_authorship(\%co, -tag => 'span');
6964                       print "<br/>\n</div>\n";
6965
6966                 print "<div class=\"log_body\">\n";
6967                 git_print_log($co{'comment'}, -final_empty_line=> 1);
6968                 print "</div>\n";
6969         }
6970         if ($extra) {
6971                 print "<div class=\"page_nav\">\n";
6972                 print "$extra\n";
6973                 print "</div>\n";
6974         }
6975 }
6976
6977 sub git_shortlog_body {
6978         # uses global variable $project
6979         my ($commitlist, $from, $to, $refs, $extra) = @_;
6980
6981         $from = 0 unless defined $from;
6982         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6983
6984         print "<table class=\"shortlog\">\n";
6985         my $alternate = 1;
6986         for (my $i = $from; $i <= $to; $i++) {
6987                 my %co = %{$commitlist->[$i]};
6988                 my $commit = $co{'id'};
6989                 my $ref = format_ref_marker($refs, $commit);
6990                 if ($alternate) {
6991                         print "<tr class=\"dark\">\n";
6992                 } else {
6993                         print "<tr class=\"light\">\n";
6994                 }
6995                 $alternate ^= 1;
6996                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
6997                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6998                       format_author_html('td', \%co, 10) . "<td>";
6999                 print format_subject_html($co{'title'}, $co{'title_short'},
7000                                           href(action=>"commit", hash=>$commit), $ref);
7001                 print "</td>\n" .
7002                       "<td class=\"link\">" .
7003                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
7004                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
7005                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7006                 my $snapshot_links = format_snapshot_links($commit);
7007                 if (defined $snapshot_links) {
7008                         print " | " . $snapshot_links;
7009                 }
7010                 print "</td>\n" .
7011                       "</tr>\n";
7012         }
7013         if (defined $extra) {
7014                 print "<tr>\n" .
7015                       "<td colspan=\"4\">$extra</td>\n" .
7016                       "</tr>\n";
7017         }
7018         print "</table>\n";
7019 }
7020
7021 sub git_history_body {
7022         # Warning: assumes constant type (blob or tree) during history
7023         my ($commitlist, $from, $to, $refs, $extra,
7024             $file_name, $file_hash, $ftype) = @_;
7025
7026         $from = 0 unless defined $from;
7027         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7028
7029         print "<table class=\"history\">\n";
7030         my $alternate = 1;
7031         for (my $i = $from; $i <= $to; $i++) {
7032                 my %co = %{$commitlist->[$i]};
7033                 if (!%co) {
7034                         next;
7035                 }
7036                 my $commit = $co{'id'};
7037
7038                 my $ref = format_ref_marker($refs, $commit);
7039
7040                 if ($alternate) {
7041                         print "<tr class=\"dark\">\n";
7042                 } else {
7043                         print "<tr class=\"light\">\n";
7044                 }
7045                 $alternate ^= 1;
7046                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7047         # shortlog:   format_author_html('td', \%co, 10)
7048                       format_author_html('td', \%co, 15, 3) . "<td>";
7049                 # originally git_history used chop_str($co{'title'}, 50)
7050                 print format_subject_html($co{'title'}, $co{'title_short'},
7051                                           href(action=>"commit", hash=>$commit), $ref);
7052                 print "</td>\n" .
7053                       "<td class=\"link\">" .
7054                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
7055                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7056
7057                 if ($ftype eq 'blob') {
7058                         my $blob_current = $file_hash;
7059                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7060                         if (defined $blob_current && defined $blob_parent &&
7061                                         $blob_current ne $blob_parent) {
7062                                 print " | " .
7063                                         $cgi->a({-href => href(action=>"blobdiff",
7064                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7065                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7066                                                                file_name=>$file_name)},
7067                                                 "diff to current");
7068                         }
7069                 }
7070                 print "</td>\n" .
7071                       "</tr>\n";
7072         }
7073         if (defined $extra) {
7074                 print "<tr>\n" .
7075                       "<td colspan=\"4\">$extra</td>\n" .
7076                       "</tr>\n";
7077         }
7078         print "</table>\n";
7079 }
7080
7081 sub git_tags_body {
7082         # uses global variable $project
7083         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7084         $from = 0 unless defined $from;
7085         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7086         $order ||= $default_refs_order;
7087
7088         print "<table class=\"tags\">\n";
7089         if ($full) {
7090                 print "<tr class=\"tags_header\">\n";
7091                 print_sort_th('age', $order, 'Last Change');
7092                 print_sort_th('name', $order, 'Name');
7093                 print "<th></th>\n" . # for comment
7094                       "<th></th>\n" . # for tag
7095                       "<th></th>\n" . # for links
7096                       "</tr>\n";
7097         }
7098         my $alternate = 1;
7099         for (my $i = $from; $i <= $to; $i++) {
7100                 my $entry = $taglist->[$i];
7101                 my %tag = %$entry;
7102                 my $comment = $tag{'subject'};
7103                 my $comment_short;
7104                 if (defined $comment) {
7105                         $comment_short = chop_str($comment, 30, 5);
7106                 }
7107                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7108                 if ($alternate) {
7109                         print "<tr class=\"dark\">\n";
7110                 } else {
7111                         print "<tr class=\"light\">\n";
7112                 }
7113                 $alternate ^= 1;
7114                 if (defined $tag{'age'}) {
7115                         print "<td><i>$tag{'age'}</i></td>\n";
7116                 } else {
7117                         print "<td></td>\n";
7118                 }
7119                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7120                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7121                                -class => "list name"}, esc_html($tag{'name'})) .
7122                       "</td>\n" .
7123                       "<td>");
7124                 if (defined $comment) {
7125                         print format_subject_html($comment, $comment_short,
7126                                                   href(action=>"tag", hash=>$tag{'id'}));
7127                 }
7128                 print "</td>\n" .
7129                       "<td class=\"selflink\">";
7130                 if ($tag{'type'} eq "tag") {
7131                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7132                 } else {
7133                         print "&#160;";
7134                 }
7135                 print "</td>\n" .
7136                       "<td class=\"link\">" . " | " .
7137                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7138                 if ($tag{'reftype'} eq "commit") {
7139                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7140                         print " | " . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7141                 } elsif ($tag{'reftype'} eq "blob") {
7142                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7143                 }
7144                 print "</td>\n" .
7145                       "</tr>";
7146         }
7147         if (defined $extra) {
7148                 print "<tr>\n" .
7149                       "<td colspan=\"5\">$extra</td>\n" .
7150                       "</tr>\n";
7151         }
7152         print "</table>\n";
7153 }
7154
7155 sub git_heads_body {
7156         # uses global variable $project
7157         my ($headlist, $head_at, $from, $to, $extra) = @_;
7158         $from = 0 unless defined $from;
7159         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7160
7161         print "<table class=\"heads\">\n";
7162         my $alternate = 1;
7163         for (my $i = $from; $i <= $to; $i++) {
7164                 my $entry = $headlist->[$i];
7165                 my %ref = %$entry;
7166                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7167                 if ($alternate) {
7168                         print "<tr class=\"dark\">\n";
7169                 } else {
7170                         print "<tr class=\"light\">\n";
7171                 }
7172                 $alternate ^= 1;
7173                 print "<td><i>$ref{'age'}</i></td>\n" .
7174                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7175                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7176                                -class => "list name"},esc_html($ref{'name'})) .
7177                       "</td>\n" .
7178                       "<td class=\"link\">" .
7179                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . " | " .
7180                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7181                       "</td>\n" .
7182                       "</tr>";
7183         }
7184         if (defined $extra) {
7185                 print "<tr>\n" .
7186                       "<td colspan=\"3\">$extra</td>\n" .
7187                       "</tr>\n";
7188         }
7189         print "</table>\n";
7190 }
7191
7192 # Display a single remote block
7193 sub git_remote_block {
7194         my ($remote, $rdata, $limit, $head) = @_;
7195
7196         my $heads = $rdata->{'heads'};
7197         my $fetch = $rdata->{'fetch'};
7198         my $push = $rdata->{'push'};
7199
7200         my $urls_table = "<table class=\"projects_list\">\n" ;
7201
7202         if (defined $fetch) {
7203                 if ($fetch eq $push) {
7204                         $urls_table .= format_repo_url("URL", $fetch);
7205                 } else {
7206                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7207                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7208                 }
7209         } elsif (defined $push) {
7210                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7211         } else {
7212                 $urls_table .= format_repo_url("", "No remote URL");
7213         }
7214
7215         $urls_table .= "</table>\n";
7216
7217         my $dots;
7218         if (defined $limit && $limit < @$heads) {
7219                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7220         }
7221
7222         print $urls_table;
7223         git_heads_body($heads, $head, 0, $limit, $dots);
7224 }
7225
7226 # Display a list of remote names with the respective fetch and push URLs
7227 sub git_remotes_list {
7228         my ($remotedata, $limit) = @_;
7229         print "<table class=\"heads\">\n";
7230         my $alternate = 1;
7231         my @remotes = sort keys %$remotedata;
7232
7233         my $limited = $limit && $limit < @remotes;
7234
7235         $#remotes = $limit - 1 if $limited;
7236
7237         while (my $remote = shift @remotes) {
7238                 my $rdata = $remotedata->{$remote};
7239                 my $fetch = $rdata->{'fetch'};
7240                 my $push = $rdata->{'push'};
7241                 if ($alternate) {
7242                         print "<tr class=\"dark\">\n";
7243                 } else {
7244                         print "<tr class=\"light\">\n";
7245                 }
7246                 $alternate ^= 1;
7247                 print "<td>" .
7248                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7249                                -class=> "list name"},esc_html($remote)) .
7250                       "</td>";
7251                 print "<td class=\"link\">" .
7252                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7253                       " | " .
7254                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7255                       "</td>";
7256
7257                 print "</tr>\n";
7258         }
7259
7260         if ($limited) {
7261                 print "<tr>\n" .
7262                       "<td colspan=\"3\">" .
7263                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7264                       "</td>\n" . "</tr>\n";
7265         }
7266
7267         print "</table>";
7268 }
7269
7270 # Display remote heads grouped by remote, unless there are too many
7271 # remotes, in which case we only display the remote names
7272 sub git_remotes_body {
7273         my ($remotedata, $limit, $head) = @_;
7274         if ($limit and $limit < keys %$remotedata) {
7275                 git_remotes_list($remotedata, $limit);
7276         } else {
7277                 fill_remote_heads($remotedata);
7278                 while (my ($remote, $rdata) = each %$remotedata) {
7279                         git_print_section({-class=>"remote", -id=>$remote},
7280                                 ["remotes", $remote, $remote], sub {
7281                                         git_remote_block($remote, $rdata, $limit, $head);
7282                                 });
7283                 }
7284         }
7285 }
7286
7287 sub git_search_message {
7288         my %co = @_;
7289
7290         my $greptype;
7291         if ($searchtype eq 'commit') {
7292                 $greptype = "--grep=";
7293         } elsif ($searchtype eq 'author') {
7294                 $greptype = "--author=";
7295         } elsif ($searchtype eq 'committer') {
7296                 $greptype = "--committer=";
7297         }
7298         $greptype .= $searchtext;
7299         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7300                                        $greptype, '--regexp-ignore-case',
7301                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7302
7303         my $paging_nav = '';
7304         if ($page > 0) {
7305                 $paging_nav .=
7306                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7307                                 "first") .
7308                         " &#183; " .
7309                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7310                                  -accesskey => "p", -title => "Alt-p"}, "prev");
7311         } else {
7312                 $paging_nav .= "first &#183; prev";
7313         }
7314         my $next_link = '';
7315         if ($#commitlist >= 100) {
7316                 $next_link =
7317                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7318                                  -accesskey => "n", -title => "Alt-n"}, "next");
7319                 $paging_nav .= " &#183; $next_link";
7320         } else {
7321                 $paging_nav .= " &#183; next";
7322         }
7323
7324         git_header_html();
7325
7326         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
7327         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7328         if ($page == 0 && !@commitlist) {
7329                 print "<p>No match.</p>\n";
7330         } else {
7331                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7332         }
7333
7334         git_footer_html();
7335 }
7336
7337 sub git_search_changes {
7338         my %co = @_;
7339
7340         local $/ = "\n";
7341         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7342                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7343                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7344                         or die_error(500, "Open git-log failed");
7345
7346         git_header_html();
7347
7348         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7349         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7350
7351         print "<table class=\"pickaxe search\">\n";
7352         my $alternate = 1;
7353         undef %co;
7354         my @files;
7355         while (my $line = to_utf8(scalar <$fd>)) {
7356                 chomp $line;
7357                 next unless $line;
7358
7359                 my %set = parse_difftree_raw_line($line);
7360                 if (defined $set{'commit'}) {
7361                         # finish previous commit
7362                         if (%co) {
7363                                 print "</td>\n" .
7364                                       "<td class=\"link\">" .
7365                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7366                                               "commit") .
7367                                       " | " .
7368                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7369                                                              hash_base=>$co{'id'})},
7370                                               "tree") .
7371                                       "</td>\n" .
7372                                       "</tr>\n";
7373                         }
7374
7375                         if ($alternate) {
7376                                 print "<tr class=\"dark\">\n";
7377                         } else {
7378                                 print "<tr class=\"light\">\n";
7379                         }
7380                         $alternate ^= 1;
7381                         %co = parse_commit($set{'commit'});
7382                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7383                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7384                               "<td><i>$author</i></td>\n" .
7385                               "<td>" .
7386                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7387                                       -class => "list subject"},
7388                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7389                 } elsif (defined $set{'to_id'}) {
7390                         next if ($set{'to_id'} =~ m/^0{40}$/);
7391
7392                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7393                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7394                                       -class => "list"},
7395                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7396                               "<br/>\n";
7397                 }
7398         }
7399         close $fd;
7400
7401         # finish last commit (warning: repetition!)
7402         if (%co) {
7403                 print "</td>\n" .
7404                       "<td class=\"link\">" .
7405                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7406                               "commit") .
7407                       " | " .
7408                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7409                                              hash_base=>$co{'id'})},
7410                               "tree") .
7411                       "</td>\n" .
7412                       "</tr>\n";
7413         }
7414
7415         print "</table>\n";
7416
7417         git_footer_html();
7418 }
7419
7420 sub git_search_files {
7421         my %co = @_;
7422
7423         local $/ = "\n";
7424         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7425                 $search_use_regexp ? ('-E', '-i') : '-F',
7426                 $searchtext, $co{'tree'})
7427                         or die_error(500, "Open git-grep failed");
7428
7429         git_header_html();
7430
7431         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7432         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7433
7434         print "<table class=\"grep_search\">\n";
7435         my $alternate = 1;
7436         my $matches = 0;
7437         my $lastfile = '';
7438         my $file_href;
7439         while (my $line = to_utf8(scalar <$fd>)) {
7440                 chomp $line;
7441                 my ($file, $lno, $ltext, $binary);
7442                 last if ($matches++ > 1000);
7443                 if ($line =~ /^Binary file (.+) matches$/) {
7444                         $file = $1;
7445                         $binary = 1;
7446                 } else {
7447                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7448                         $file =~ s/^$co{'tree'}://;
7449                 }
7450                 if ($file ne $lastfile) {
7451                         $lastfile and print "</td></tr>\n";
7452                         if ($alternate++) {
7453                                 print "<tr class=\"dark\">\n";
7454                         } else {
7455                                 print "<tr class=\"light\">\n";
7456                         }
7457                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7458                                           file_name=>$file);
7459                         print "<td class=\"list\">".
7460                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7461                         print "</td><td>\n";
7462                         $lastfile = $file;
7463                 }
7464                 if ($binary) {
7465                         print "<div class=\"binary\">Binary file</div>\n";
7466                 } else {
7467                         $ltext = untabify($ltext);
7468                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7469                                 $ltext = esc_html($1, -nbsp=>1);
7470                                 $ltext .= '<span class="match">';
7471                                 $ltext .= esc_html($2, -nbsp=>1);
7472                                 $ltext .= '</span>';
7473                                 $ltext .= esc_html($3, -nbsp=>1);
7474                         } else {
7475                                 $ltext = esc_html($ltext, -nbsp=>1);
7476                         }
7477                         print "<div class=\"pre\">" .
7478                                 $cgi->a({-href => $file_href.'#l'.$lno,
7479                                         -class => "linenr"}, sprintf('%4i', $lno)) .
7480                                 ' ' .  $ltext . "</div>\n";
7481                 }
7482         }
7483         if ($lastfile) {
7484                 print "</td></tr>\n";
7485                 if ($matches > 1000) {
7486                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7487                 }
7488         } else {
7489                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7490         }
7491         close $fd;
7492
7493         print "</table>\n";
7494
7495         git_footer_html();
7496 }
7497
7498 sub git_search_grep_body {
7499         my ($commitlist, $from, $to, $extra) = @_;
7500         $from = 0 unless defined $from;
7501         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7502
7503         print "<table class=\"commit_search\">\n";
7504         my $alternate = 1;
7505         for (my $i = $from; $i <= $to; $i++) {
7506                 my %co = %{$commitlist->[$i]};
7507                 if (!%co) {
7508                         next;
7509                 }
7510                 my $commit = $co{'id'};
7511                 if ($alternate) {
7512                         print "<tr class=\"dark\">\n";
7513                 } else {
7514                         print "<tr class=\"light\">\n";
7515                 }
7516                 $alternate ^= 1;
7517                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7518                       format_author_html('td', \%co, 15, 5) .
7519                       "<td>" .
7520                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7521                                -class => "list subject"},
7522                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7523                 my $comment = $co{'comment'};
7524                 foreach my $line (@$comment) {
7525                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7526                                 my ($lead, $match, $trail) = ($1, $2, $3);
7527                                 $match = chop_str($match, 70, 5, 'center');
7528                                 my $contextlen = int((80 - length($match))/2);
7529                                 $contextlen = 30 if ($contextlen > 30);
7530                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7531                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7532
7533                                 $lead  = esc_html($lead);
7534                                 $match = esc_html($match);
7535                                 $trail = esc_html($trail);
7536
7537                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7538                         }
7539                 }
7540                 print "</td>\n" .
7541                       "<td class=\"link\">" .
7542                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7543                       " | " .
7544                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7545                       " | " .
7546                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7547                 print "</td>\n" .
7548                       "</tr>\n";
7549         }
7550         if (defined $extra) {
7551                 print "<tr>\n" .
7552                       "<td colspan=\"3\">$extra</td>\n" .
7553                       "</tr>\n";
7554         }
7555         print "</table>\n";
7556 }
7557
7558 ## ======================================================================
7559 ## ======================================================================
7560 ## actions
7561
7562 sub git_project_list_load {
7563         my $empty_list_ok = shift;
7564         my $order = $input_params{'order'};
7565         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7566                 die_error(400, "Unknown order parameter");
7567         }
7568
7569         my @list = git_get_projects_list($project_filter, $strict_export);
7570         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7571                 push @list, { 'path' => "$project_filter.git" }
7572                         if is_valid_project("$project_filter.git");
7573         }
7574         if (!@list) {
7575                 die_error(404, "No projects found") unless $empty_list_ok;
7576         }
7577
7578         return (\@list, $order);
7579 }
7580
7581 sub git_frontpage {
7582         my ($projlist, $order);
7583
7584         if ($frontpage_no_project_list) {
7585                 $project = undef;
7586                 $project_filter = undef;
7587         } else {
7588                 ($projlist, $order) = git_project_list_load(1);
7589         }
7590         git_header_html();
7591         if (defined $home_text && -f $home_text) {
7592                 print "<div class=\"index_include\">\n";
7593                 insert_file($home_text);
7594                 print "</div>\n";
7595         }
7596         git_project_search_form($searchtext, $search_use_regexp);
7597         if ($frontpage_no_project_list) {
7598                 my $show_ctags = gitweb_check_feature('ctags');
7599                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7600                         my @projects = git_get_projects_list($project_filter, $strict_export);
7601                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7602                         @projects = fill_project_list_info(\@projects, 'ctags');
7603                         my $ctags = git_gather_all_ctags(\@projects);
7604                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7605                         print git_show_project_tagcloud($cloud, 64);
7606                 }
7607         } else {
7608                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7609         }
7610         git_footer_html();
7611 }
7612
7613 sub git_project_list {
7614         my ($projlist, $order) = git_project_list_load();
7615         git_header_html();
7616         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7617                 print "<div class=\"index_include\">\n";
7618                 insert_file($home_text);
7619                 print "</div>\n";
7620         }
7621         git_project_search_form();
7622         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7623         git_footer_html();
7624 }
7625
7626 sub git_forks {
7627         my $order = $input_params{'order'};
7628         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7629                 die_error(400, "Unknown order parameter");
7630         }
7631
7632         my $filter = $project;
7633         $filter =~ s/\.git$//;
7634         my @list = git_get_projects_list($filter);
7635         if (!@list) {
7636                 die_error(404, "No forks found");
7637         }
7638
7639         git_header_html();
7640         git_print_page_nav('','');
7641         git_print_header_div('summary', "$project forks");
7642         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7643         git_footer_html();
7644 }
7645
7646 sub git_project_index {
7647         my @projects = git_get_projects_list($project_filter, $strict_export);
7648         if (!@projects) {
7649                 die_error(404, "No projects found");
7650         }
7651
7652         print $cgi->header(
7653                 -type => 'text/plain',
7654                 -charset => 'utf-8',
7655                 -content_disposition => 'inline; filename="index.aux"');
7656
7657         foreach my $pr (@projects) {
7658                 if (!exists $pr->{'owner'}) {
7659                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7660                 }
7661
7662                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7663                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7664                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7665                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7666                 $path  =~ s/ /\+/g;
7667                 $owner =~ s/ /\+/g;
7668
7669                 print "$path $owner\n";
7670         }
7671 }
7672
7673 sub git_summary {
7674         my $descr = git_get_project_description($project) || "none";
7675         my %co = parse_commit("HEAD");
7676         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7677         my $head = $co{'id'};
7678         my $remote_heads = gitweb_check_feature('remote_heads');
7679
7680         my $owner = git_get_project_owner($project);
7681         my $homepage = git_get_project_config('homepage');
7682         my $base_url = git_get_project_config('baseurl');
7683         my $last_refresh = git_get_project_config('lastrefresh');
7684
7685         my $refs = git_get_references();
7686         # These get_*_list functions return one more to allow us to see if
7687         # there are more ...
7688         my @taglist  = git_get_tags_list(16);
7689         my @headlist = git_get_heads_list(16);
7690         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7691         my @forklist;
7692         my $check_forks = gitweb_check_feature('forks');
7693
7694         if ($check_forks) {
7695                 # find forks of a project
7696                 my $filter = $project;
7697                 $filter =~ s/\.git$//;
7698                 @forklist = git_get_projects_list($filter);
7699                 # filter out forks of forks
7700                 @forklist = filter_forks_from_projects_list(\@forklist)
7701                         if (@forklist);
7702         }
7703
7704         git_header_html();
7705         git_print_page_nav('summary','', $head);
7706
7707         if ($check_forks and $project =~ m#/#) {
7708                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7709                 my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7710                 print <<EOT;
7711 <div class="forkinfo">
7712 This project is a fork of the $r project. If you have that one
7713 already cloned locally, you can use
7714 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7715 to save bandwidth during cloning.
7716 </div>
7717 EOT
7718         }
7719
7720         print "<div class=\"title\">&#160;</div>\n";
7721         print "<table class=\"projects_list\">\n" .
7722               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7723         if ($homepage) {
7724                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7725         }
7726         if ($base_url) {
7727                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7728         }
7729         if ($owner and not $omit_owner) {
7730                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7731                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7732                         : email_obfuscate($owner)) . "</td></tr>\n";
7733         }
7734         if (defined $cd{'rfc2822'}) {
7735                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7736                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7737         }
7738         if (defined $last_refresh) {
7739                 my %rd = parse_date_rfc2822($last_refresh);
7740                 print "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
7741                       "<td>".format_timestamp_html(\%rd)."</td></tr>\n"
7742                 if defined $rd{'rfc2822'};
7743         }
7744
7745         # use per project git URL list in $projectroot/$project/cloneurl
7746         # or make project git URL from git base URL and project name
7747         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7748         my @url_list = git_get_project_url_list($project);
7749         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7750         foreach my $git_url (@url_list) {
7751                 next unless $git_url;
7752                 print format_repo_url($url_tag, $git_url);
7753                 $url_tag = "";
7754         }
7755         @url_list = map { "$_/$project" } @git_base_push_urls;
7756         if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7757             -f "$projectroot/$project/.nofetch") {
7758                 $url_tag = "Push&#160;URL";
7759                 foreach my $git_push_url (@url_list) {
7760                         next unless $git_push_url;
7761                         my $hint = $https_hint_html && $git_push_url =~ /^https:/i ?
7762                                 "&#160;$https_hint_html" : '';
7763                         print "<tr class=\"metadata_pushurl\"><td>$url_tag</td><td>$git_push_url$hint</td></tr>\n";
7764                         $url_tag = "";
7765                 }
7766         }
7767
7768         # Tag cloud
7769         my $show_ctags = gitweb_check_feature('ctags');
7770         if ($show_ctags) {
7771                 my $ctags = git_get_project_ctags($project);
7772                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7773                         # without ability to add tags, don't show if there are none
7774                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7775                         print "<tr id=\"metadata_ctags\">" .
7776                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7777                         print "</td>\n<td>" unless %$ctags;
7778                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7779                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7780                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7781                               unless $show_ctags =~ /^\d+$/;
7782                         print "</td>\n<td>" if %$ctags;
7783                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7784                               "</tr>\n";
7785                 }
7786         }
7787
7788         print "</table>\n";
7789
7790         # If XSS prevention is on, we don't include README.html.
7791         # TODO: Allow a readme in some safe format.
7792         if (!$prevent_xss && -s "$projectroot/$project/README.html") {
7793                 print "<div class=\"title\">readme</div>\n" .
7794                       "<div class=\"readme\">\n";
7795                 insert_file("$projectroot/$project/README.html");
7796                 print "\n</div>\n"; # class="readme"
7797         }
7798
7799         # we need to request one more than 16 (0..15) to check if
7800         # those 16 are all
7801         my @commitlist = $head ? parse_commits($head, 17) : ();
7802         if (@commitlist) {
7803                 git_print_header_div('shortlog');
7804                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7805                                   $#commitlist <=  15 ? undef :
7806                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7807         }
7808
7809         if (@taglist) {
7810                 git_print_header_div('tags');
7811                 git_tags_body(\@taglist, 0, 15,
7812                               $#taglist <=  15 ? undef :
7813                               $cgi->a({-href => href(action=>"tags")}, "..."));
7814         }
7815
7816         if (@headlist) {
7817                 git_print_header_div('heads');
7818                 git_heads_body(\@headlist, $head, 0, 15,
7819                                $#headlist <= 15 ? undef :
7820                                $cgi->a({-href => href(action=>"heads")}, "..."));
7821         }
7822
7823         if (%remotedata) {
7824                 git_print_header_div('remotes');
7825                 git_remotes_body(\%remotedata, 15, $head);
7826         }
7827
7828         if (@forklist) {
7829                 git_print_header_div('forks');
7830                 git_project_list_body(\@forklist, 'age', 0, 15,
7831                                       $#forklist <= 15 ? undef :
7832                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7833                                       'no_header', 'forks');
7834         }
7835
7836         git_footer_html();
7837 }
7838
7839 sub git_tag {
7840         my %tag = parse_tag($hash);
7841
7842         if (! %tag) {
7843                 die_error(404, "Unknown tag object");
7844         }
7845
7846         my $fullhash;
7847         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
7848         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
7849
7850         my $head = git_get_head_hash($project);
7851         git_header_html();
7852         git_print_page_nav('','', $head,undef,$head);
7853         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
7854         print "<div class=\"title_text\">\n" .
7855               "<table class=\"object_header\">\n" .
7856               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
7857               "<tr>\n" .
7858               "<td>object</td>\n" .
7859               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7860                                $tag{'object'}) . "</td>\n" .
7861               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7862                                               $tag{'type'}) . "</td>\n" .
7863               "</tr>\n";
7864         if (defined($tag{'author'})) {
7865                 git_print_authorship_rows(\%tag, 'author');
7866         }
7867         print "</table>\n\n" .
7868               "</div>\n";
7869         print "<div class=\"page_body\">";
7870         my $comment = $tag{'comment'};
7871         foreach my $line (@$comment) {
7872                 chomp $line;
7873                 print esc_html($line, -nbsp=>1) . "<br/>\n";
7874         }
7875         print "</div>\n";
7876         git_footer_html();
7877 }
7878
7879 sub git_blame_common {
7880         my $format = shift || 'porcelain';
7881         if ($format eq 'porcelain' && $input_params{'javascript'}) {
7882                 $format = 'incremental';
7883                 $action = 'blame_incremental'; # for page title etc
7884         }
7885
7886         # permissions
7887         gitweb_check_feature('blame')
7888                 or die_error(403, "Blame view not allowed");
7889
7890         # error checking
7891         die_error(400, "No file name given") unless $file_name;
7892         $hash_base ||= git_get_head_hash($project);
7893         die_error(404, "Couldn't find base commit") unless $hash_base;
7894         my %co = parse_commit($hash_base)
7895                 or die_error(404, "Commit not found");
7896         my $ftype = "blob";
7897         if (!defined $hash) {
7898                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
7899                         or die_error(404, "Error looking up file");
7900         } else {
7901                 $ftype = git_get_type($hash);
7902                 if ($ftype !~ "blob") {
7903                         die_error(400, "Object is not a blob");
7904                 }
7905         }
7906
7907         my $fd;
7908         if ($format eq 'incremental') {
7909                 # get file contents (as base)
7910                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
7911                         or die_error(500, "Open git-cat-file failed");
7912         } elsif ($format eq 'data') {
7913                 # run git-blame --incremental
7914                 defined($fd = git_cmd_pipe "blame", "--incremental",
7915                         $hash_base, "--", $file_name)
7916                         or die_error(500, "Open git-blame --incremental failed");
7917         } else {
7918                 # run git-blame --porcelain
7919                 defined($fd = git_cmd_pipe "blame", '-p',
7920                         $hash_base, '--', $file_name)
7921                         or die_error(500, "Open git-blame --porcelain failed");
7922         }
7923
7924         # incremental blame data returns early
7925         if ($format eq 'data') {
7926                 print $cgi->header(
7927                         -type=>"text/plain", -charset => "utf-8",
7928                         -status=> "200 OK");
7929                 local $| = 1; # output autoflush
7930                 while (<$fd>) {
7931                         print to_utf8($_);
7932                 }
7933                 close $fd
7934                         or print "ERROR $!\n";
7935
7936                 print 'END';
7937                 if (defined $t0 && gitweb_check_feature('timed')) {
7938                         print ' '.
7939                               tv_interval($t0, [ gettimeofday() ]).
7940                               ' '.$number_of_git_cmds;
7941                 }
7942                 print "\n";
7943
7944                 return;
7945         }
7946
7947         # page header
7948         git_header_html();
7949         my $formats_nav =
7950                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
7951                         "blob");
7952         $formats_nav .=
7953                 " | " .
7954                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7955                         "history") .
7956                 " | " .
7957                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
7958                         "HEAD");
7959         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7960         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7961         git_print_page_path($file_name, $ftype, $hash_base);
7962
7963         # page body
7964         if ($format eq 'incremental') {
7965                 print "<noscript>\n<div class=\"error\"><center><b>\n".
7966                       "This page requires JavaScript to run.\n Use ".
7967                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
7968                               'this page').
7969                       " instead.\n".
7970                       "</b></center></div>\n</noscript>\n";
7971
7972                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
7973         }
7974
7975         print qq!<div class="page_body">\n!;
7976         print qq!<div id="progress_info">... / ...</div>\n!
7977                 if ($format eq 'incremental');
7978         print qq!<table id="blame_table" class="blame" width="100%">\n!.
7979               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
7980               qq!<thead>\n!.
7981               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
7982               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
7983               qq!title="toggles blame author information display">[+]</a></th>!.
7984               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
7985               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
7986               qq!</thead>\n!.
7987               qq!<tbody>\n!;
7988
7989         my @rev_color = qw(light dark);
7990         my $num_colors = scalar(@rev_color);
7991         my $current_color = 0;
7992
7993         if ($format eq 'incremental') {
7994                 my $color_class = $rev_color[$current_color];
7995
7996                 #contents of a file
7997                 my $linenr = 0;
7998         LINE:
7999                 while (my $line = to_utf8(scalar <$fd>)) {
8000                         chomp $line;
8001                         $linenr++;
8002
8003                         print qq!<tr id="l$linenr" class="$color_class">!.
8004                               qq!<td class="sha1"><a href=""> </a></td>!.
8005                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8006                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8007                               qq!<td class="linenr">!.
8008                               qq!<a class="linenr" href="">$linenr</a></td>!;
8009                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8010                         print qq!</tr>\n!;
8011                 }
8012
8013         } else { # porcelain, i.e. ordinary blame
8014                 my %metainfo = (); # saves information about commits
8015
8016                 # blame data
8017         LINE:
8018                 while (my $line = to_utf8(scalar <$fd>)) {
8019                         chomp $line;
8020                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8021                         # no <lines in group> for subsequent lines in group of lines
8022                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8023                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8024                         if (!exists $metainfo{$full_rev}) {
8025                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8026                         }
8027                         my $meta = $metainfo{$full_rev};
8028                         my $data;
8029                         while ($data = to_utf8(scalar <$fd>)) {
8030                                 chomp $data;
8031                                 last if ($data =~ s/^\t//); # contents of line
8032                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8033                                         $meta->{$1} = $2 unless exists $meta->{$1};
8034                                 }
8035                                 if ($data =~ /^previous /) {
8036                                         $meta->{'nprevious'}++;
8037                                 }
8038                         }
8039                         my $short_rev = substr($full_rev, 0, 8);
8040                         my $author = $meta->{'author'};
8041                         my %date =
8042                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8043                         my $date = $date{'iso-tz'};
8044                         if ($group_size) {
8045                                 $current_color = ($current_color + 1) % $num_colors;
8046                         }
8047                         my $tr_class = $rev_color[$current_color];
8048                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8049                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8050                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8051                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8052                         if ($group_size) {
8053                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8054                                 print "<td class=\"sha1\"";
8055                                 print " title=\"". esc_html($author) . ", $date\"";
8056                                 print "$rowspan>";
8057                                 print $cgi->a({-href => href(action=>"commit",
8058                                                              hash=>$full_rev,
8059                                                              file_name=>$file_name)},
8060                                               esc_html($short_rev));
8061                                 if ($group_size >= 2) {
8062                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8063                                         if (@author_initials) {
8064                                                 print "<br />" .
8065                                                       esc_html(join('', @author_initials));
8066                                                 #           or join('.', ...)
8067                                         }
8068                                 }
8069                                 print "</td>\n";
8070                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8071                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8072                         }
8073                         # 'previous' <sha1 of parent commit> <filename at commit>
8074                         if (exists $meta->{'previous'} &&
8075                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8076                                 $meta->{'parent'} = $1;
8077                                 $meta->{'file_parent'} = unquote($2);
8078                         }
8079                         my $linenr_commit =
8080                                 exists($meta->{'parent'}) ?
8081                                 $meta->{'parent'} : $full_rev;
8082                         my $linenr_filename =
8083                                 exists($meta->{'file_parent'}) ?
8084                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8085                         my $blamed = href(action => 'blame',
8086                                           file_name => $linenr_filename,
8087                                           hash_base => $linenr_commit);
8088                         print "<td class=\"linenr\">";
8089                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8090                                         -class => "linenr" },
8091                                       esc_html($lineno));
8092                         print "</td>";
8093                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8094                         print "</tr>\n";
8095                 } # end while
8096
8097         }
8098
8099         # footer
8100         print "</tbody>\n".
8101               "</table>\n"; # class="blame"
8102         print "</div>\n";   # class="blame_body"
8103         close $fd
8104                 or print "Reading blob failed\n";
8105
8106         git_footer_html();
8107 }
8108
8109 sub git_blame {
8110         git_blame_common();
8111 }
8112
8113 sub git_blame_incremental {
8114         git_blame_common('incremental');
8115 }
8116
8117 sub git_blame_data {
8118         git_blame_common('data');
8119 }
8120
8121 sub git_tags {
8122         my $head = git_get_head_hash($project);
8123         git_header_html();
8124         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8125         git_print_header_div('summary', $project);
8126
8127         my @tagslist = git_get_tags_list();
8128         if (@tagslist) {
8129                 git_tags_body(\@tagslist);
8130         }
8131         git_footer_html();
8132 }
8133
8134 sub git_refs {
8135         my $order = $input_params{'order'};
8136         if (defined $order && $order !~ m/age|name/) {
8137                 die_error(400, "Unknown order parameter");
8138         }
8139
8140         my $head = git_get_head_hash($project);
8141         git_header_html();
8142         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8143         git_print_header_div('summary', $project);
8144
8145         my @refslist = git_get_tags_list(undef, 1, $order);
8146         if (@refslist) {
8147                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8148         }
8149         git_footer_html();
8150 }
8151
8152 sub git_heads {
8153         my $head = git_get_head_hash($project);
8154         git_header_html();
8155         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8156         git_print_header_div('summary', $project);
8157
8158         my @headslist = git_get_heads_list();
8159         if (@headslist) {
8160                 git_heads_body(\@headslist, $head);
8161         }
8162         git_footer_html();
8163 }
8164
8165 # used both for single remote view and for list of all the remotes
8166 sub git_remotes {
8167         gitweb_check_feature('remote_heads')
8168                 or die_error(403, "Remote heads view is disabled");
8169
8170         my $head = git_get_head_hash($project);
8171         my $remote = $input_params{'hash'};
8172
8173         my $remotedata = git_get_remotes_list($remote);
8174         die_error(500, "Unable to get remote information") unless defined $remotedata;
8175
8176         unless (%$remotedata) {
8177                 die_error(404, defined $remote ?
8178                         "Remote $remote not found" :
8179                         "No remotes found");
8180         }
8181
8182         git_header_html(undef, undef, -action_extra => $remote);
8183         git_print_page_nav('', '',  $head, undef, $head,
8184                 format_ref_views($remote ? '' : 'remotes'));
8185
8186         fill_remote_heads($remotedata);
8187         if (defined $remote) {
8188                 git_print_header_div('remotes', "$remote remote for $project");
8189                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8190         } else {
8191                 git_print_header_div('summary', "$project remotes");
8192                 git_remotes_body($remotedata, undef, $head);
8193         }
8194
8195         git_footer_html();
8196 }
8197
8198 sub git_blob_plain {
8199         my $type = shift;
8200         my $expires;
8201
8202         if (!defined $hash) {
8203                 if (defined $file_name) {
8204                         my $base = $hash_base || git_get_head_hash($project);
8205                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8206                                 or die_error(404, "Cannot find file");
8207                 } else {
8208                         die_error(400, "No file name defined");
8209                 }
8210         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8211                 # blobs defined by non-textual hash id's can be cached
8212                 $expires = "+1d";
8213         }
8214
8215         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8216                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8217         binmode($fd);
8218
8219         # content-type (can include charset)
8220         my $leader;
8221         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8222
8223         # "save as" filename, even when no $file_name is given
8224         my $save_as = "$hash";
8225         if (defined $file_name) {
8226                 $save_as = $file_name;
8227         } elsif ($type =~ m/^text\//) {
8228                 $save_as .= '.txt';
8229         }
8230
8231         # With XSS prevention on, blobs of all types except a few known safe
8232         # ones are served with "Content-Disposition: attachment" to make sure
8233         # they don't run in our security domain.  For certain image types,
8234         # blob view writes an <img> tag referring to blob_plain view, and we
8235         # want to be sure not to break that by serving the image as an
8236         # attachment (though Firefox 3 doesn't seem to care).
8237         my $sandbox = $prevent_xss &&
8238                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8239
8240         # serve text/* as text/plain
8241         if ($prevent_xss &&
8242             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8243              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8244                 my $rest = $1;
8245                 $rest = defined $rest ? $rest : '';
8246                 $type = "text/plain$rest";
8247         }
8248
8249         print $cgi->header(
8250                 -type => $type,
8251                 -expires => $expires,
8252                 -content_disposition =>
8253                         ($sandbox ? 'attachment' : 'inline')
8254                         . '; filename="' . $save_as . '"');
8255         binmode STDOUT, ':raw';
8256         $fcgi_raw_mode = 1;
8257         print $leader if defined $leader;
8258         my $buf;
8259         while (read($fd, $buf, 32768)) {
8260                 print $buf;
8261         }
8262         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8263         $fcgi_raw_mode = 0;
8264         close $fd;
8265 }
8266
8267 sub git_blob {
8268         my $expires;
8269
8270         my $fullhash;
8271         if (!defined $hash) {
8272                 if (defined $file_name) {
8273                         my $base = $hash_base || git_get_head_hash($project);
8274                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8275                                 or die_error(404, "Cannot find file");
8276                         $fullhash = $hash;
8277                 } else {
8278                         die_error(400, "No file name defined");
8279                 }
8280         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8281                 # blobs defined by non-textual hash id's can be cached
8282                 $expires = "+1d";
8283                 $fullhash = $hash;
8284         }
8285         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8286
8287         my $have_blame = gitweb_check_feature('blame');
8288         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8289                 or die_error(500, "Couldn't cat $file_name, $hash");
8290         binmode($fd);
8291         my $mimetype = blob_mimetype($fd, $file_name);
8292         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8293         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8294                 close $fd;
8295                 return git_blob_plain($mimetype);
8296         }
8297         # we can have blame only for text/* mimetype
8298         $have_blame &&= ($mimetype =~ m!^text/!);
8299
8300         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8301         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8302         my $highlight_mode_active;
8303         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8304
8305         git_header_html(undef, $expires);
8306         my $formats_nav = '';
8307         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8308                 if (defined $file_name) {
8309                         if ($have_blame) {
8310                                 $formats_nav .=
8311                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8312                                                 -class => "blamelink"},
8313                                                 "blame") .
8314                                         " | ";
8315                         }
8316                         $formats_nav .=
8317                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8318                                         "history") .
8319                                 " | " .
8320                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8321                                         "raw") .
8322                                 " | " .
8323                                 $cgi->a({-href => href(action=>"blob",
8324                                                        hash_base=>"HEAD", file_name=>$file_name)},
8325                                         "HEAD");
8326                 } else {
8327                         $formats_nav .=
8328                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8329                                         "raw");
8330                 }
8331                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8332                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8333         } else {
8334                 print "<div class=\"page_nav\">\n" .
8335                       "<br/><br/></div>\n" .
8336                       "<div class=\"title\">".esc_html($hash)."</div>\n";
8337         }
8338         git_print_page_path($file_name, "blob", $hash_base);
8339         print "<div class=\"title_text\">\n" .
8340               "<table class=\"object_header\">\n";
8341         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8342         print "</table>".
8343               "</div>\n";
8344         print "<div class=\"page_body\">\n";
8345         if ($mimetype =~ m!^image/!) {
8346                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8347                 if ($file_name) {
8348                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8349                 }
8350                 print qq! src="! .
8351                       href(action=>"blob_plain", hash=>$hash,
8352                            hash_base=>$hash_base, file_name=>$file_name) .
8353                       qq!" />\n!;
8354         } else {
8355                 my $nr;
8356                 while (my $line = to_utf8(scalar <$fd>)) {
8357                         chomp $line;
8358                         $nr++;
8359                         $line = untabify($line);
8360                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
8361                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8362                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8363                 }
8364         }
8365         close $fd
8366                 or print "Reading blob failed.\n";
8367         print "</div>";
8368         git_footer_html();
8369 }
8370
8371 sub git_tree {
8372         my $fullhash;
8373         if (!defined $hash_base) {
8374                 $hash_base = "HEAD";
8375         }
8376         if (!defined $hash) {
8377                 if (defined $file_name) {
8378                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8379                         $fullhash = $hash;
8380                 } else {
8381                         $hash = $hash_base;
8382                 }
8383         }
8384         die_error(404, "No such tree") unless defined($hash);
8385         $fullhash = $hash if !$fullhash && $hash =~ m/^[0-9a-fA-F]{40}$/;
8386         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8387
8388         my $show_sizes = gitweb_check_feature('show-sizes');
8389         my $have_blame = gitweb_check_feature('blame');
8390
8391         my @entries = ();
8392         {
8393                 local $/ = "\0";
8394                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8395                         ($show_sizes ? '-l' : ()), @extra_options, $hash)
8396                         or die_error(500, "Open git-ls-tree failed");
8397                 @entries = map { chomp; to_utf8($_) } <$fd>;
8398                 close $fd
8399                         or die_error(404, "Reading tree failed");
8400         }
8401
8402         git_header_html();
8403         my $basedir = '';
8404         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8405                 my $refs = git_get_references();
8406                 my $ref = format_ref_marker($refs, $co{'id'});
8407                 my @views_nav = ();
8408                 if (defined $file_name) {
8409                         push @views_nav,
8410                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8411                                         "history"),
8412                                 $cgi->a({-href => href(action=>"tree",
8413                                                        hash_base=>"HEAD", file_name=>$file_name)},
8414                                         "HEAD"),
8415                 }
8416                 my $snapshot_links = format_snapshot_links($hash);
8417                 if (defined $snapshot_links) {
8418                         # FIXME: Should be available when we have no hash base as well.
8419                         push @views_nav, $snapshot_links;
8420                 }
8421                 git_print_page_nav('tree','', $hash_base, undef, undef,
8422                                    join(' | ', @views_nav));
8423                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8424         } else {
8425                 undef $hash_base;
8426                 print "<div class=\"page_nav\">\n";
8427                 print "<br/><br/></div>\n";
8428                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8429         }
8430         if (defined $file_name) {
8431                 $basedir = $file_name;
8432                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8433                         $basedir .= '/';
8434                 }
8435                 git_print_page_path($file_name, 'tree', $hash_base);
8436         }
8437         print "<div class=\"title_text\">\n" .
8438               "<table class=\"object_header\">\n";
8439         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8440         print "</table>".
8441               "</div>\n";
8442         print "<div class=\"page_body\">\n";
8443         print "<table class=\"tree\">\n";
8444         my $alternate = 1;
8445         # '..' (top directory) link if possible
8446         if (defined $hash_base &&
8447             defined $file_name && $file_name =~ m![^/]+$!) {
8448                 if ($alternate) {
8449                         print "<tr class=\"dark\">\n";
8450                 } else {
8451                         print "<tr class=\"light\">\n";
8452                 }
8453                 $alternate ^= 1;
8454
8455                 my $up = $file_name;
8456                 $up =~ s!/?[^/]+$!!;
8457                 undef $up unless $up;
8458                 # based on git_print_tree_entry
8459                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8460                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8461                 print '<td class="list">';
8462                 print $cgi->a({-href => href(action=>"tree",
8463                                              hash_base=>$hash_base,
8464                                              file_name=>$up)},
8465                               "..");
8466                 print "</td>\n";
8467                 print "<td class=\"link\"></td>\n";
8468
8469                 print "</tr>\n";
8470         }
8471         foreach my $line (@entries) {
8472                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8473
8474                 if ($alternate) {
8475                         print "<tr class=\"dark\">\n";
8476                 } else {
8477                         print "<tr class=\"light\">\n";
8478                 }
8479                 $alternate ^= 1;
8480
8481                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8482
8483                 print "</tr>\n";
8484         }
8485         print "</table>\n" .
8486               "</div>";
8487         git_footer_html();
8488 }
8489
8490 sub sanitize_for_filename {
8491     my $name = shift;
8492
8493     $name =~ s!/!-!g;
8494     $name =~ s/[^[:alnum:]_.-]//g;
8495
8496     return $name;
8497 }
8498
8499 sub snapshot_name {
8500         my ($project, $hash) = @_;
8501
8502         # path/to/project.git  -> project
8503         # path/to/project/.git -> project
8504         my $name = to_utf8($project);
8505         $name =~ s,([^/])/*\.git$,$1,;
8506         $name = sanitize_for_filename(basename($name));
8507
8508         my $ver = $hash;
8509         if ($hash =~ /^[0-9a-fA-F]+$/) {
8510                 # shorten SHA-1 hash
8511                 my $full_hash = git_get_full_hash($project, $hash);
8512                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8513                         $ver = git_get_short_hash($project, $hash);
8514                 }
8515         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8516                 # tags don't need shortened SHA-1 hash
8517                 $ver = $1;
8518         } else {
8519                 # branches and other need shortened SHA-1 hash
8520                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8521                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8522                         my $ref_dir = (defined $1) ? $1 : '';
8523                         $ver = $2;
8524
8525                         $ref_dir = sanitize_for_filename($ref_dir);
8526                         # for refs neither in heads nor remotes we want to
8527                         # add a ref dir to archive name
8528                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8529                                 $ver = $ref_dir . '-' . $ver;
8530                         }
8531                 }
8532                 $ver .= '-' . git_get_short_hash($project, $hash);
8533         }
8534         # special case of sanitization for filename - we change
8535         # slashes to dots instead of dashes
8536         # in case of hierarchical branch names
8537         $ver =~ s!/!.!g;
8538         $ver =~ s/[^[:alnum:]_.-]//g;
8539
8540         # name = project-version_string
8541         $name = "$name-$ver";
8542
8543         return wantarray ? ($name, $name) : $name;
8544 }
8545
8546 sub exit_if_unmodified_since {
8547         my ($latest_epoch) = @_;
8548         our $cgi;
8549
8550         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8551         if (defined $if_modified) {
8552                 my $since;
8553                 if (eval { require HTTP::Date; 1; }) {
8554                         $since = HTTP::Date::str2time($if_modified);
8555                 } elsif (eval { require Time::ParseDate; 1; }) {
8556                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8557                 }
8558                 if (defined $since && $latest_epoch <= $since) {
8559                         my %latest_date = parse_date($latest_epoch);
8560                         print $cgi->header(
8561                                 -last_modified => $latest_date{'rfc2822'},
8562                                 -status => '304 Not Modified');
8563                         goto DONE_GITWEB;
8564                 }
8565         }
8566 }
8567
8568 sub git_snapshot {
8569         my $format = $input_params{'snapshot_format'};
8570         if (!@snapshot_fmts) {
8571                 die_error(403, "Snapshots not allowed");
8572         }
8573         # default to first supported snapshot format
8574         $format ||= $snapshot_fmts[0];
8575         if ($format !~ m/^[a-z0-9]+$/) {
8576                 die_error(400, "Invalid snapshot format parameter");
8577         } elsif (!exists($known_snapshot_formats{$format})) {
8578                 die_error(400, "Unknown snapshot format");
8579         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8580                 die_error(403, "Snapshot format not allowed");
8581         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8582                 die_error(403, "Unsupported snapshot format");
8583         }
8584
8585         my $type = git_get_type("$hash^{}");
8586         if (!$type) {
8587                 die_error(404, 'Object does not exist');
8588         }  elsif ($type eq 'blob') {
8589                 die_error(400, 'Object is not a tree-ish');
8590         }
8591
8592         my ($name, $prefix) = snapshot_name($project, $hash);
8593         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8594
8595         my %co = parse_commit($hash);
8596         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8597
8598         my @cmd = (
8599                 git_cmd(), 'archive',
8600                 "--format=$known_snapshot_formats{$format}{'format'}",
8601                 "--prefix=$prefix/", $hash);
8602         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8603                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8604                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8605         }
8606
8607         $filename =~ s/(["\\])/\\$1/g;
8608         my %latest_date;
8609         if (%co) {
8610                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8611         }
8612
8613         print $cgi->header(
8614                 -type => $known_snapshot_formats{$format}{'type'},
8615                 -content_disposition => 'inline; filename="' . $filename . '"',
8616                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8617                 -status => '200 OK');
8618
8619         defined(my $fd = cmd_pipe @cmd)
8620                 or die_error(500, "Execute git-archive failed");
8621         binmode($fd);
8622         binmode STDOUT, ':raw';
8623         $fcgi_raw_mode = 1;
8624         my $buf;
8625         while (read($fd, $buf, 32768)) {
8626                 print $buf;
8627         }
8628         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8629         $fcgi_raw_mode = 0;
8630         close $fd;
8631 }
8632
8633 sub git_log_generic {
8634         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8635
8636         my $head = git_get_head_hash($project);
8637         if (!defined $base) {
8638                 $base = $head;
8639         }
8640         if (!defined $page) {
8641                 $page = 0;
8642         }
8643         my $refs = git_get_references();
8644
8645         my $commit_hash = $base;
8646         if (defined $parent) {
8647                 $commit_hash = "$parent..$base";
8648         }
8649         my @commitlist =
8650                 parse_commits($commit_hash, 101, (100 * $page),
8651                               defined $file_name ? ($file_name, "--full-history") : ());
8652
8653         my $ftype;
8654         if (!defined $file_hash && defined $file_name) {
8655                 # some commits could have deleted file in question,
8656                 # and not have it in tree, but one of them has to have it
8657                 for (my $i = 0; $i < @commitlist; $i++) {
8658                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8659                         last if defined $file_hash;
8660                 }
8661         }
8662         if (defined $file_hash) {
8663                 $ftype = git_get_type($file_hash);
8664         }
8665         if (defined $file_name && !defined $ftype) {
8666                 die_error(500, "Unknown type of object");
8667         }
8668         my %co;
8669         if (defined $file_name) {
8670                 %co = parse_commit($base)
8671                         or die_error(404, "Unknown commit object");
8672         }
8673
8674
8675         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100);
8676         my $next_link = '';
8677         if ($#commitlist >= 100) {
8678                 $next_link =
8679                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8680                                  -accesskey => "n", -title => "Alt-n"}, "next");
8681         }
8682         my ($patch_max) = gitweb_get_feature('patches');
8683         if ($patch_max && !defined $file_name) {
8684                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8685                         $paging_nav .= " &#183; " .
8686                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
8687                                         "patches");
8688                 }
8689         }
8690
8691         {
8692                 local $action = 'fulllog';
8693                 git_header_html();
8694         }
8695         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8696         if (defined $file_name) {
8697                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8698         } else {
8699                 git_print_header_div('summary', $project)
8700         }
8701         git_print_page_path($file_name, $ftype, $hash_base)
8702                 if (defined $file_name);
8703
8704         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8705                      $file_name, $file_hash, $ftype);
8706
8707         git_footer_html();
8708 }
8709
8710 sub git_log {
8711         git_log_generic('log', \&git_log_body,
8712                         $hash, $hash_parent);
8713 }
8714
8715 sub git_commit {
8716         $hash ||= $hash_base || "HEAD";
8717         my %co = parse_commit($hash)
8718             or die_error(404, "Unknown commit object");
8719
8720         my $parent  = $co{'parent'};
8721         my $parents = $co{'parents'}; # listref
8722
8723         # we need to prepare $formats_nav before any parameter munging
8724         my $formats_nav;
8725         if (!defined $parent) {
8726                 # --root commitdiff
8727                 $formats_nav .= '(initial)';
8728         } elsif (@$parents == 1) {
8729                 # single parent commit
8730                 $formats_nav .=
8731                         '(parent: ' .
8732                         $cgi->a({-href => href(action=>"commit",
8733                                                hash=>$parent)},
8734                                 esc_html(substr($parent, 0, 7))) .
8735                         ')';
8736         } else {
8737                 # merge commit
8738                 $formats_nav .=
8739                         '(merge: ' .
8740                         join(' ', map {
8741                                 $cgi->a({-href => href(action=>"commit",
8742                                                        hash=>$_)},
8743                                         esc_html(substr($_, 0, 7)));
8744                         } @$parents ) .
8745                         ')';
8746         }
8747         if (gitweb_check_feature('patches') && @$parents <= 1) {
8748                 $formats_nav .= " | " .
8749                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8750                                 "patch");
8751         }
8752
8753         if (!defined $parent) {
8754                 $parent = "--root";
8755         }
8756         my @difftree;
8757         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8758                 @diff_opts,
8759                 (@$parents <= 1 ? $parent : '-c'),
8760                 $hash, "--")
8761                 or die_error(500, "Open git-diff-tree failed");
8762         @difftree = map { chomp; to_utf8($_) } <$fd>;
8763         close $fd or die_error(404, "Reading git-diff-tree failed");
8764
8765         # non-textual hash id's can be cached
8766         my $expires;
8767         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8768                 $expires = "+1d";
8769         }
8770         my $refs = git_get_references();
8771         my $ref = format_ref_marker($refs, $co{'id'});
8772
8773         git_header_html(undef, $expires);
8774         git_print_page_nav('commit', '',
8775                            $hash, $co{'tree'}, $hash,
8776                            $formats_nav);
8777
8778         if (defined $co{'parent'}) {
8779                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
8780         } else {
8781                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
8782         }
8783         print "<div class=\"title_text\">\n" .
8784               "<table class=\"object_header\">\n";
8785         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8786         git_print_authorship_rows(\%co);
8787         print "<tr>" .
8788               "<td>tree</td>" .
8789               "<td class=\"sha1\">" .
8790               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8791                        class => "list"}, $co{'tree'}) .
8792               "</td>" .
8793               "<td class=\"link\">" .
8794               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8795                       "tree");
8796         my $snapshot_links = format_snapshot_links($hash);
8797         if (defined $snapshot_links) {
8798                 print " | " . $snapshot_links;
8799         }
8800         print "</td>" .
8801               "</tr>\n";
8802
8803         foreach my $par (@$parents) {
8804                 print "<tr>" .
8805                       "<td>parent</td>" .
8806                       "<td class=\"sha1\">" .
8807                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8808                                class => "list"}, $par) .
8809                       "</td>" .
8810                       "<td class=\"link\">" .
8811                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8812                       " | " .
8813                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8814                       "</td>" .
8815                       "</tr>\n";
8816         }
8817         print "</table>".
8818               "</div>\n";
8819
8820         print "<div class=\"page_body\">\n";
8821         git_print_log($co{'comment'});
8822         print "</div>\n";
8823
8824         git_difftree_body(\@difftree, $hash, @$parents);
8825
8826         git_footer_html();
8827 }
8828
8829 sub git_object {
8830         # object is defined by:
8831         # - hash or hash_base alone
8832         # - hash_base and file_name
8833         my $type;
8834
8835         # - hash or hash_base alone
8836         if ($hash || ($hash_base && !defined $file_name)) {
8837                 my $object_id = $hash || $hash_base;
8838
8839                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8840                         or die_error(404, "Object does not exist");
8841                 $type = <$fd>;
8842                 chomp $type;
8843                 close $fd
8844                         or die_error(404, "Object does not exist");
8845
8846         # - hash_base and file_name
8847         } elsif ($hash_base && defined $file_name) {
8848                 $file_name =~ s,/+$,,;
8849
8850                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
8851                         or die_error(404, "Base object does not exist");
8852
8853                 # here errors should not happen
8854                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
8855                         or die_error(500, "Open git-ls-tree failed");
8856                 my $line = to_utf8(scalar <$fd>);
8857                 close $fd;
8858
8859                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
8860                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
8861                         die_error(404, "File or directory for given base does not exist");
8862                 }
8863                 $type = $2;
8864                 $hash = $3;
8865         } else {
8866                 die_error(400, "Not enough information to find object");
8867         }
8868
8869         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
8870                                           hash=>$hash, hash_base=>$hash_base,
8871                                           file_name=>$file_name),
8872                              -status => '302 Found');
8873 }
8874
8875 sub git_blobdiff {
8876         my $format = shift || 'html';
8877         my $diff_style = $input_params{'diff_style'} || 'inline';
8878
8879         my $fd;
8880         my @difftree;
8881         my %diffinfo;
8882         my $expires;
8883
8884         # preparing $fd and %diffinfo for git_patchset_body
8885         # new style URI
8886         if (defined $hash_base && defined $hash_parent_base) {
8887                 if (defined $file_name) {
8888                         # read raw output
8889                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8890                                 $hash_parent_base, $hash_base,
8891                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
8892                                 or die_error(500, "Open git-diff-tree failed");
8893                         @difftree = map { chomp; to_utf8($_) } <$fd>;
8894                         close $fd
8895                                 or die_error(404, "Reading git-diff-tree failed");
8896                         @difftree
8897                                 or die_error(404, "Blob diff not found");
8898
8899                 } elsif (defined $hash &&
8900                          $hash =~ /[0-9a-fA-F]{40}/) {
8901                         # try to find filename from $hash
8902
8903                         # read filtered raw output
8904                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8905                                 $hash_parent_base, $hash_base, "--")
8906                                 or die_error(500, "Open git-diff-tree failed");
8907                         @difftree =
8908                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
8909                                 # $hash == to_id
8910                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
8911                                 map { chomp; to_utf8($_) } <$fd>;
8912                         close $fd
8913                                 or die_error(404, "Reading git-diff-tree failed");
8914                         @difftree
8915                                 or die_error(404, "Blob diff not found");
8916
8917                 } else {
8918                         die_error(400, "Missing one of the blob diff parameters");
8919                 }
8920
8921                 if (@difftree > 1) {
8922                         die_error(400, "Ambiguous blob diff specification");
8923                 }
8924
8925                 %diffinfo = parse_difftree_raw_line($difftree[0]);
8926                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
8927                 $file_name   ||= $diffinfo{'to_file'};
8928
8929                 $hash_parent ||= $diffinfo{'from_id'};
8930                 $hash        ||= $diffinfo{'to_id'};
8931
8932                 # non-textual hash id's can be cached
8933                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
8934                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
8935                         $expires = '+1d';
8936                 }
8937
8938                 # open patch output
8939                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8940                         '-p', ($format eq 'html' ? "--full-index" : ()),
8941                         $hash_parent_base, $hash_base,
8942                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
8943                         or die_error(500, "Open git-diff-tree failed");
8944         }
8945
8946         # old/legacy style URI -- not generated anymore since 1.4.3.
8947         if (!%diffinfo) {
8948                 die_error('404 Not Found', "Missing one of the blob diff parameters")
8949         }
8950
8951         # header
8952         if ($format eq 'html') {
8953                 my $formats_nav =
8954                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
8955                                 "raw");
8956                 $formats_nav .= diff_style_nav($diff_style);
8957                 git_header_html(undef, $expires);
8958                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8959                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8960                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8961                 } else {
8962                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
8963                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
8964                 }
8965                 if (defined $file_name) {
8966                         git_print_page_path($file_name, "blob", $hash_base);
8967                 } else {
8968                         print "<div class=\"page_path\"></div>\n";
8969                 }
8970
8971         } elsif ($format eq 'plain') {
8972                 print $cgi->header(
8973                         -type => 'text/plain',
8974                         -charset => 'utf-8',
8975                         -expires => $expires,
8976                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
8977
8978                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8979
8980         } else {
8981                 die_error(400, "Unknown blobdiff format");
8982         }
8983
8984         # patch
8985         if ($format eq 'html') {
8986                 print "<div class=\"page_body\">\n";
8987
8988                 git_patchset_body($fd, $diff_style,
8989                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
8990                 close $fd;
8991
8992                 print "</div>\n"; # class="page_body"
8993                 git_footer_html();
8994
8995         } else {
8996                 while (my $line = to_utf8(scalar <$fd>)) {
8997                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
8998                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
8999
9000                         print $line;
9001
9002                         last if $line =~ m!^\+\+\+!;
9003                 }
9004                 while (<$fd>) {
9005                         print to_utf8($_);
9006                 }
9007                 close $fd;
9008         }
9009 }
9010
9011 sub git_blobdiff_plain {
9012         git_blobdiff('plain');
9013 }
9014
9015 # assumes that it is added as later part of already existing navigation,
9016 # so it returns "| foo | bar" rather than just "foo | bar"
9017 sub diff_style_nav {
9018         my ($diff_style, $is_combined) = @_;
9019         $diff_style ||= 'inline';
9020
9021         return "" if ($is_combined);
9022
9023         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
9024         my %styles = @styles;
9025         @styles =
9026                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9027
9028         return join '',
9029                 map { " | ".$_ }
9030                 map {
9031                         $_ eq $diff_style ? $styles{$_} :
9032                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
9033                 } @styles;
9034 }
9035
9036 sub git_commitdiff {
9037         my %params = @_;
9038         my $format = $params{-format} || 'html';
9039         my $diff_style = $input_params{'diff_style'} || 'inline';
9040
9041         my ($patch_max) = gitweb_get_feature('patches');
9042         if ($format eq 'patch') {
9043                 die_error(403, "Patch view not allowed") unless $patch_max;
9044         }
9045
9046         $hash ||= $hash_base || "HEAD";
9047         my %co = parse_commit($hash)
9048             or die_error(404, "Unknown commit object");
9049
9050         # choose format for commitdiff for merge
9051         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9052                 $hash_parent = '--cc';
9053         }
9054         # we need to prepare $formats_nav before almost any parameter munging
9055         my $formats_nav;
9056         if ($format eq 'html') {
9057                 $formats_nav =
9058                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9059                                 "raw");
9060                 if ($patch_max && @{$co{'parents'}} <= 1) {
9061                         $formats_nav .= " | " .
9062                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9063                                         "patch");
9064                 }
9065                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9066
9067                 if (defined $hash_parent &&
9068                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9069                         # commitdiff with two commits given
9070                         my $hash_parent_short = $hash_parent;
9071                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9072                                 $hash_parent_short = substr($hash_parent, 0, 7);
9073                         }
9074                         $formats_nav .=
9075                                 ' (from';
9076                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9077                                 if ($co{'parents'}[$i] eq $hash_parent) {
9078                                         $formats_nav .= ' parent ' . ($i+1);
9079                                         last;
9080                                 }
9081                         }
9082                         $formats_nav .= ': ' .
9083                                 $cgi->a({-href => href(-replay=>1,
9084                                                        hash=>$hash_parent, hash_base=>undef)},
9085                                         esc_html($hash_parent_short)) .
9086                                 ')';
9087                 } elsif (!$co{'parent'}) {
9088                         # --root commitdiff
9089                         $formats_nav .= ' (initial)';
9090                 } elsif (scalar @{$co{'parents'}} == 1) {
9091                         # single parent commit
9092                         $formats_nav .=
9093                                 ' (parent: ' .
9094                                 $cgi->a({-href => href(-replay=>1,
9095                                                        hash=>$co{'parent'}, hash_base=>undef)},
9096                                         esc_html(substr($co{'parent'}, 0, 7))) .
9097                                 ')';
9098                 } else {
9099                         # merge commit
9100                         if ($hash_parent eq '--cc') {
9101                                 $formats_nav .= ' | ' .
9102                                         $cgi->a({-href => href(-replay=>1,
9103                                                                hash=>$hash, hash_parent=>'-c')},
9104                                                 'combined');
9105                         } else { # $hash_parent eq '-c'
9106                                 $formats_nav .= ' | ' .
9107                                         $cgi->a({-href => href(-replay=>1,
9108                                                                hash=>$hash, hash_parent=>'--cc')},
9109                                                 'compact');
9110                         }
9111                         $formats_nav .=
9112                                 ' (merge: ' .
9113                                 join(' ', map {
9114                                         $cgi->a({-href => href(-replay=>1,
9115                                                                hash=>$_, hash_base=>undef)},
9116                                                 esc_html(substr($_, 0, 7)));
9117                                 } @{$co{'parents'}} ) .
9118                                 ')';
9119                 }
9120         }
9121
9122         my $hash_parent_param = $hash_parent;
9123         if (!defined $hash_parent_param) {
9124                 # --cc for multiple parents, --root for parentless
9125                 $hash_parent_param =
9126                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9127         }
9128
9129         # read commitdiff
9130         my $fd;
9131         my @difftree;
9132         if ($format eq 'html') {
9133                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9134                         "--no-commit-id", "--patch-with-raw", "--full-index",
9135                         $hash_parent_param, $hash, "--")
9136                         or die_error(500, "Open git-diff-tree failed");
9137
9138                 while (my $line = to_utf8(scalar <$fd>)) {
9139                         chomp $line;
9140                         # empty line ends raw part of diff-tree output
9141                         last unless $line;
9142                         push @difftree, scalar parse_difftree_raw_line($line);
9143                 }
9144
9145         } elsif ($format eq 'plain') {
9146                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9147                         '-p', $hash_parent_param, $hash, "--")
9148                         or die_error(500, "Open git-diff-tree failed");
9149         } elsif ($format eq 'patch') {
9150                 # For commit ranges, we limit the output to the number of
9151                 # patches specified in the 'patches' feature.
9152                 # For single commits, we limit the output to a single patch,
9153                 # diverging from the git-format-patch default.
9154                 my @commit_spec = ();
9155                 if ($hash_parent) {
9156                         if ($patch_max > 0) {
9157                                 push @commit_spec, "-$patch_max";
9158                         }
9159                         push @commit_spec, '-n', "$hash_parent..$hash";
9160                 } else {
9161                         if ($params{-single}) {
9162                                 push @commit_spec, '-1';
9163                         } else {
9164                                 if ($patch_max > 0) {
9165                                         push @commit_spec, "-$patch_max";
9166                                 }
9167                                 push @commit_spec, "-n";
9168                         }
9169                         push @commit_spec, '--root', $hash;
9170                 }
9171                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9172                         '--encoding=utf8', '--stdout', @commit_spec)
9173                         or die_error(500, "Open git-format-patch failed");
9174         } else {
9175                 die_error(400, "Unknown commitdiff format");
9176         }
9177
9178         # non-textual hash id's can be cached
9179         my $expires;
9180         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9181                 $expires = "+1d";
9182         }
9183
9184         # write commit message
9185         if ($format eq 'html') {
9186                 my $refs = git_get_references();
9187                 my $ref = format_ref_marker($refs, $co{'id'});
9188
9189                 git_header_html(undef, $expires);
9190                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9191                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9192                 print "<div class=\"title_text\">\n" .
9193                       "<table class=\"object_header\">\n";
9194                 git_print_authorship_rows(\%co);
9195                 print "</table>".
9196                       "</div>\n";
9197                 print "<div class=\"page_body\">\n";
9198                 if (@{$co{'comment'}} > 1) {
9199                         print "<div class=\"log\">\n";
9200                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9201                         print "</div>\n"; # class="log"
9202                 }
9203
9204         } elsif ($format eq 'plain') {
9205                 my $refs = git_get_references("tags");
9206                 my $tagname = git_get_rev_name_tags($hash);
9207                 my $filename = basename($project) . "-$hash.patch";
9208
9209                 print $cgi->header(
9210                         -type => 'text/plain',
9211                         -charset => 'utf-8',
9212                         -expires => $expires,
9213                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9214                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9215                 print "From: " . to_utf8($co{'author'}) . "\n";
9216                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9217                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9218
9219                 print "X-Git-Tag: $tagname\n" if $tagname;
9220                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9221
9222                 foreach my $line (@{$co{'comment'}}) {
9223                         print to_utf8($line) . "\n";
9224                 }
9225                 print "---\n\n";
9226         } elsif ($format eq 'patch') {
9227                 my $filename = basename($project) . "-$hash.patch";
9228
9229                 print $cgi->header(
9230                         -type => 'text/plain',
9231                         -charset => 'utf-8',
9232                         -expires => $expires,
9233                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9234         }
9235
9236         # write patch
9237         if ($format eq 'html') {
9238                 my $use_parents = !defined $hash_parent ||
9239                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9240                 git_difftree_body(\@difftree, $hash,
9241                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9242                 print "<br/>\n";
9243
9244                 git_patchset_body($fd, $diff_style,
9245                                   \@difftree, $hash,
9246                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9247                 close $fd;
9248                 print "</div>\n"; # class="page_body"
9249                 git_footer_html();
9250
9251         } elsif ($format eq 'plain') {
9252                 while (<$fd>) {
9253                         print to_utf8($_);
9254                 }
9255                 close $fd
9256                         or print "Reading git-diff-tree failed\n";
9257         } elsif ($format eq 'patch') {
9258                 while (<$fd>) {
9259                         print to_utf8($_);
9260                 }
9261                 close $fd
9262                         or print "Reading git-format-patch failed\n";
9263         }
9264 }
9265
9266 sub git_commitdiff_plain {
9267         git_commitdiff(-format => 'plain');
9268 }
9269
9270 # format-patch-style patches
9271 sub git_patch {
9272         git_commitdiff(-format => 'patch', -single => 1);
9273 }
9274
9275 sub git_patches {
9276         git_commitdiff(-format => 'patch');
9277 }
9278
9279 sub git_history {
9280         git_log_generic('history', \&git_history_body,
9281                         $hash_base, $hash_parent_base,
9282                         $file_name, $hash);
9283 }
9284
9285 sub git_search {
9286         $searchtype ||= 'commit';
9287
9288         # check if appropriate features are enabled
9289         gitweb_check_feature('search')
9290                 or die_error(403, "Search is disabled");
9291         if ($searchtype eq 'pickaxe') {
9292                 # pickaxe may take all resources of your box and run for several minutes
9293                 # with every query - so decide by yourself how public you make this feature
9294                 gitweb_check_feature('pickaxe')
9295                         or die_error(403, "Pickaxe search is disabled");
9296         }
9297         if ($searchtype eq 'grep') {
9298                 # grep search might be potentially CPU-intensive, too
9299                 gitweb_check_feature('grep')
9300                         or die_error(403, "Grep search is disabled");
9301         }
9302
9303         if (!defined $searchtext) {
9304                 die_error(400, "Text field is empty");
9305         }
9306         if (!defined $hash) {
9307                 $hash = git_get_head_hash($project);
9308         }
9309         my %co = parse_commit($hash);
9310         if (!%co) {
9311                 die_error(404, "Unknown commit object");
9312         }
9313         if (!defined $page) {
9314                 $page = 0;
9315         }
9316
9317         if ($searchtype eq 'commit' ||
9318             $searchtype eq 'author' ||
9319             $searchtype eq 'committer') {
9320                 git_search_message(%co);
9321         } elsif ($searchtype eq 'pickaxe') {
9322                 git_search_changes(%co);
9323         } elsif ($searchtype eq 'grep') {
9324                 git_search_files(%co);
9325         } else {
9326                 die_error(400, "Unknown search type");
9327         }
9328 }
9329
9330 sub git_search_help {
9331         git_header_html();
9332         git_print_page_nav('','', $hash,$hash,$hash);
9333         print <<EOT;
9334 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9335 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9336 the pattern entered is recognized as the POSIX extended
9337 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9338 insensitive).</p>
9339 <dl>
9340 <dt><b>commit</b></dt>
9341 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9342 EOT
9343         my $have_grep = gitweb_check_feature('grep');
9344         if ($have_grep) {
9345                 print <<EOT;
9346 <dt><b>grep</b></dt>
9347 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9348     a different one) are searched for the given pattern. On large trees, this search can take
9349 a while and put some strain on the server, so please use it with some consideration. Note that
9350 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9351 case-sensitive.</dd>
9352 EOT
9353         }
9354         print <<EOT;
9355 <dt><b>author</b></dt>
9356 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9357 <dt><b>committer</b></dt>
9358 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9359 EOT
9360         my $have_pickaxe = gitweb_check_feature('pickaxe');
9361         if ($have_pickaxe) {
9362                 print <<EOT;
9363 <dt><b>pickaxe</b></dt>
9364 <dd>All commits that caused the string to appear or disappear from any file (changes that
9365 added, removed or "modified" the string) will be listed. This search can take a while and
9366 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9367 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9368 EOT
9369         }
9370         print "</dl>\n";
9371         git_footer_html();
9372 }
9373
9374 sub git_shortlog {
9375         git_log_generic('shortlog', \&git_shortlog_body,
9376                         $hash, $hash_parent);
9377 }
9378
9379 ## ......................................................................
9380 ## feeds (RSS, Atom; OPML)
9381
9382 sub git_feed {
9383         my $format = shift || 'atom';
9384         my $have_blame = gitweb_check_feature('blame');
9385
9386         # Atom: http://www.atomenabled.org/developers/syndication/
9387         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9388         if ($format ne 'rss' && $format ne 'atom') {
9389                 die_error(400, "Unknown web feed format");
9390         }
9391
9392         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9393         my $head = $hash || 'HEAD';
9394         my @commitlist = parse_commits($head, 150, 0, $file_name);
9395
9396         my %latest_commit;
9397         my %latest_date;
9398         my $content_type = "application/$format+xml";
9399         if (defined $cgi->http('HTTP_ACCEPT') &&
9400                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9401                 # browser (feed reader) prefers text/xml
9402                 $content_type = 'text/xml';
9403         }
9404         if (defined($commitlist[0])) {
9405                 %latest_commit = %{$commitlist[0]};
9406                 my $latest_epoch = $latest_commit{'committer_epoch'};
9407                 exit_if_unmodified_since($latest_epoch);
9408                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9409         }
9410         print $cgi->header(
9411                 -type => $content_type,
9412                 -charset => 'utf-8',
9413                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9414                 -status => '200 OK');
9415
9416         # Optimization: skip generating the body if client asks only
9417         # for Last-Modified date.
9418         return if ($cgi->request_method() eq 'HEAD');
9419
9420         # header variables
9421         my $title = "$site_name - $project/$action";
9422         my $feed_type = 'log';
9423         if (defined $hash) {
9424                 $title .= " - '$hash'";
9425                 $feed_type = 'branch log';
9426                 if (defined $file_name) {
9427                         $title .= " :: $file_name";
9428                         $feed_type = 'history';
9429                 }
9430         } elsif (defined $file_name) {
9431                 $title .= " - $file_name";
9432                 $feed_type = 'history';
9433         }
9434         $title .= " $feed_type";
9435         $title = esc_html($title);
9436         my $descr = git_get_project_description($project);
9437         if (defined $descr) {
9438                 $descr = esc_html($descr);
9439         } else {
9440                 $descr = "$project " .
9441                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9442                          " feed";
9443         }
9444         my $owner = git_get_project_owner($project);
9445         $owner = esc_html($owner);
9446
9447         #header
9448         my $alt_url;
9449         if (defined $file_name) {
9450                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9451         } elsif (defined $hash) {
9452                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9453         } else {
9454                 $alt_url = href(-full=>1, action=>"summary");
9455         }
9456         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9457         if ($format eq 'rss') {
9458                 print <<XML;
9459 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9460 <channel>
9461 XML
9462                 print "<title>$title</title>\n" .
9463                       "<link>$alt_url</link>\n" .
9464                       "<description>$descr</description>\n" .
9465                       "<language>en</language>\n" .
9466                       # project owner is responsible for 'editorial' content
9467                       "<managingEditor>$owner</managingEditor>\n";
9468                 if (defined $logo || defined $favicon) {
9469                         # prefer the logo to the favicon, since RSS
9470                         # doesn't allow both
9471                         my $img = esc_url($logo || $favicon);
9472                         print "<image>\n" .
9473                               "<url>$img</url>\n" .
9474                               "<title>$title</title>\n" .
9475                               "<link>$alt_url</link>\n" .
9476                               "</image>\n";
9477                 }
9478                 if (%latest_date) {
9479                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9480                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9481                 }
9482                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9483         } elsif ($format eq 'atom') {
9484                 print <<XML;
9485 <feed xmlns="http://www.w3.org/2005/Atom">
9486 XML
9487                 print "<title>$title</title>\n" .
9488                       "<subtitle>$descr</subtitle>\n" .
9489                       '<link rel="alternate" type="text/html" href="' .
9490                       $alt_url . '" />' . "\n" .
9491                       '<link rel="self" type="' . $content_type . '" href="' .
9492                       $cgi->self_url() . '" />' . "\n" .
9493                       "<id>" . href(-full=>1) . "</id>\n" .
9494                       # use project owner for feed author
9495                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9496                 if (defined $favicon) {
9497                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9498                 }
9499                 if (defined $logo) {
9500                         # not twice as wide as tall: 72 x 27 pixels
9501                         print "<logo>" . esc_url($logo) . "</logo>\n";
9502                 }
9503                 if (! %latest_date) {
9504                         # dummy date to keep the feed valid until commits trickle in:
9505                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9506                 } else {
9507                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9508                 }
9509                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9510         }
9511
9512         # contents
9513         for (my $i = 0; $i <= $#commitlist; $i++) {
9514                 my %co = %{$commitlist[$i]};
9515                 my $commit = $co{'id'};
9516                 # we read 150, we always show 30 and the ones more recent than 48 hours
9517                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9518                         last;
9519                 }
9520                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9521
9522                 # get list of changed files
9523                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9524                         $co{'parent'} || "--root",
9525                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9526                         or next;
9527                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9528                 close $fd
9529                         or next;
9530
9531                 # print element (entry, item)
9532                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9533                 if ($format eq 'rss') {
9534                         print "<item>\n" .
9535                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9536                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9537                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9538                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9539                               "<link>$co_url</link>\n" .
9540                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9541                               "<content:encoded>" .
9542                               "<![CDATA[\n";
9543                 } elsif ($format eq 'atom') {
9544                         print "<entry>\n" .
9545                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9546                               "<updated>$cd{'iso-8601'}</updated>\n" .
9547                               "<author>\n" .
9548                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9549                         if ($co{'author_email'}) {
9550                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9551                         }
9552                         print "</author>\n" .
9553                               # use committer for contributor
9554                               "<contributor>\n" .
9555                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9556                         if ($co{'committer_email'}) {
9557                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9558                         }
9559                         print "</contributor>\n" .
9560                               "<published>$cd{'iso-8601'}</published>\n" .
9561                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9562                               "<id>$co_url</id>\n" .
9563                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9564                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9565                 }
9566                 my $comment = $co{'comment'};
9567                 print "<pre>\n";
9568                 foreach my $line (@$comment) {
9569                         $line = esc_html($line);
9570                         print "$line\n";
9571                 }
9572                 print "</pre><ul>\n";
9573                 foreach my $difftree_line (@difftree) {
9574                         my %difftree = parse_difftree_raw_line($difftree_line);
9575                         next if !$difftree{'from_id'};
9576
9577                         my $file = $difftree{'file'} || $difftree{'to_file'};
9578
9579                         print "<li>" .
9580                               "[" .
9581                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9582                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9583                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9584                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9585                                       -title => "diff"}, 'D');
9586                         if ($have_blame) {
9587                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9588                                                              file_name=>$file, hash_base=>$commit),
9589                                               -class => "blamelink",
9590                                               -title => "blame"}, 'B');
9591                         }
9592                         # if this is not a feed of a file history
9593                         if (!defined $file_name || $file_name ne $file) {
9594                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9595                                                              file_name=>$file, hash=>$commit),
9596                                               -title => "history"}, 'H');
9597                         }
9598                         $file = esc_path($file);
9599                         print "] ".
9600                               "$file</li>\n";
9601                 }
9602                 if ($format eq 'rss') {
9603                         print "</ul>]]>\n" .
9604                               "</content:encoded>\n" .
9605                               "</item>\n";
9606                 } elsif ($format eq 'atom') {
9607                         print "</ul>\n</div>\n" .
9608                               "</content>\n" .
9609                               "</entry>\n";
9610                 }
9611         }
9612
9613         # end of feed
9614         if ($format eq 'rss') {
9615                 print "</channel>\n</rss>\n";
9616         } elsif ($format eq 'atom') {
9617                 print "</feed>\n";
9618         }
9619 }
9620
9621 sub git_rss {
9622         git_feed('rss');
9623 }
9624
9625 sub git_atom {
9626         git_feed('atom');
9627 }
9628
9629 sub git_opml {
9630         my @list = git_get_projects_list($project_filter, $strict_export);
9631         if (!@list) {
9632                 die_error(404, "No projects found");
9633         }
9634
9635         print $cgi->header(
9636                 -type => 'text/xml',
9637                 -charset => 'utf-8',
9638                 -content_disposition => 'inline; filename="opml.xml"');
9639
9640         my $title = esc_html($site_name);
9641         my $filter = " within subdirectory ";
9642         if (defined $project_filter) {
9643                 $filter .= esc_html($project_filter);
9644         } else {
9645                 $filter = "";
9646         }
9647         print <<XML;
9648 <?xml version="1.0" encoding="utf-8"?>
9649 <opml version="1.0">
9650 <head>
9651   <title>$title OPML Export$filter</title>
9652 </head>
9653 <body>
9654 <outline text="git RSS feeds">
9655 XML
9656
9657         foreach my $pr (@list) {
9658                 my %proj = %$pr;
9659                 my $head = git_get_head_hash($proj{'path'});
9660                 if (!defined $head) {
9661                         next;
9662                 }
9663                 $git_dir = "$projectroot/$proj{'path'}";
9664                 my %co = parse_commit($head);
9665                 if (!%co) {
9666                         next;
9667                 }
9668
9669                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9670                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9671                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9672                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9673         }
9674         print <<XML;
9675 </outline>
9676 </body>
9677 </opml>
9678 XML
9679 }