gitweb/gitweb.perl

   1 #!/usr/bin/perl
   2
   3 # gitweb - simple web interface to track changes in git repositories
   4 #
   5 # (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
   6 # (C) 2005, Christian Gierke
   7 #
   8 # This program is licensed under the GPLv2
   9
  10 use 5.008;
  11 use strict;
  12 use warnings;
  13 use CGI qw(:standard :escapeHTML -nosticky);
  14 use CGI::Util qw(unescape);
  15 use CGI::Carp qw(fatalsToBrowser set_message);
  16 use Encode;
  17 use Fcntl ':mode';
  18 use File::Find qw();
  19 use File::Basename qw(basename);
  20 use File::Spec;
  21 use Time::HiRes qw(gettimeofday tv_interval);
  22 use Time::Local;
  23 use constant GITWEB_CACHE_FORMAT => "Gitweb Cache Format 3";
  24 binmode STDOUT, ':utf8';
  25
  26 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
  27         eval 'sub CGI::multi_param { CGI::param(@_) }'
  28 }
  29
  30 our $t0 = [ gettimeofday() ];
  31 our $number_of_git_cmds = 0;
  32
  33 BEGIN {
  34         CGI->compile() if $ENV{'MOD_PERL'};
  35 }
  36
  37 our $version = "++GIT_VERSION++";
  38
  39 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  40 sub evaluate_uri {
  41         our $cgi;
  42
  43         our $my_url = $cgi->url();
  44         our $my_uri = $cgi->url(-absolute => 1);
  45
  46         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  47         # needed and used only for URLs with nonempty PATH_INFO
  48         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  49         our $base_url = $my_uri || '/';
  50
  51         # When the script is used as DirectoryIndex, the URL does not contain the name
  52         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  53         # have to do it ourselves. We make $path_info global because it's also used
  54         # later on.
  55         #
  56         # Another issue with the script being the DirectoryIndex is that the resulting
  57         # $my_url data is not the full script URL: this is good, because we want
  58         # generated links to keep implying the script name if it wasn't explicitly
  59         # indicated in the URL we're handling, but it means that $my_url cannot be used
  60         # as base URL.
  61         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  62         # to build the base URL ourselves:
  63         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  64         if ($path_info) {
  65                 # $path_info has already been URL-decoded by the web server, but
  66                 # $my_url and $my_uri have not. URL-decode them so we can properly
  67                 # strip $path_info.
  68                 $my_url = unescape($my_url);
  69                 $my_uri = unescape($my_uri);
  70                 if ($my_url =~ s,\Q$path_info\E$,, &&
  71                     $my_uri =~ s,\Q$path_info\E$,, &&
  72                     defined $ENV{'SCRIPT_NAME'}) {
  73                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  74                 }
  75         }
  76
  77         # target of the home link on top of all pages
  78         our $home_link = $my_uri || "/";
  79 }
  80
  81 # core git executable to use
  82 # this can just be "git" if your webserver has a sensible PATH
  83 our $GIT = "++GIT_BINDIR++/git";
  84
  85 # absolute fs-path which will be prepended to the project path
  86 #our $projectroot = "/pub/scm";
  87 our $projectroot = "++GITWEB_PROJECTROOT++";
  88
  89 # fs traversing limit for getting project list
  90 # the number is relative to the projectroot
  91 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  92
  93 # string of the home link on top of all pages
  94 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  95
  96 # extra breadcrumbs preceding the home link
  97 our @extra_breadcrumbs = ();
  98
  99 # name of your site or organization to appear in page titles
 100 # replace this with something more descriptive for clearer bookmarks
 101 our $site_name = "++GITWEB_SITENAME++"
 102                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 103
 104 # html snippet to include in the <head> section of each page
 105 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 106 # filename of html text to include at top of each page
 107 our $site_header = "++GITWEB_SITE_HEADER++";
 108 # html text to include at home page
 109 our $home_text = "++GITWEB_HOMETEXT++";
 110 # filename of html text to include at bottom of each page
 111 our $site_footer = "++GITWEB_SITE_FOOTER++";
 112
 113 # URI of stylesheets
 114 our @stylesheets = ("++GITWEB_CSS++");
 115 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 116 our $stylesheet = undef;
 117 # URI of GIT logo (72x27 size)
 118 our $logo = "++GITWEB_LOGO++";
 119 # URI of GIT favicon, assumed to be image/png type
 120 our $favicon = "++GITWEB_FAVICON++";
 121 # URI of gitweb.js (JavaScript code for gitweb)
 122 our $javascript = "++GITWEB_JS++";
 123
 124 # URI and label (title) of GIT logo link
 125 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 126 #our $logo_label = "git documentation";
 127 our $logo_url = "http://git-scm.com/";
 128 our $logo_label = "git homepage";
 129
 130 # source of projects list
 131 our $projects_list = "++GITWEB_LIST++";
 132
 133 # the width (in characters) of the projects list "Description" column
 134 our $projects_list_description_width = 25;
 135
 136 # group projects by category on the projects list
 137 # (enabled if this variable evaluates to true)
 138 our $projects_list_group_categories = 0;
 139
 140 # default category if none specified
 141 # (leave the empty string for no category)
 142 our $project_list_default_category = "";
 143
 144 # default order of projects list
 145 # valid values are none, project, descr, owner, and age
 146 our $default_projects_order = "project";
 147
 148 # default order of refs list
 149 # valid values are age and name
 150 our $default_refs_order = "age";
 151
 152 # show repository only if this file exists
 153 # (only effective if this variable evaluates to true)
 154 our $export_ok = "++GITWEB_EXPORT_OK++";
 155
 156 # don't generate age column on the projects list page
 157 our $omit_age_column = 0;
 158
 159 # use contents of this file (in iso, iso-strict or raw format) as
 160 # the last activity data if it exists and is a valid date
 161 our $lastactivity_file = undef;
 162
 163 # don't generate information about owners of repositories
 164 our $omit_owner=0;
 165
 166 # owner link hook given owner name (full and NOT obfuscated)
 167 # should return full URL-escaped link to attach to owner, for example:
 168 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 169 our $owner_link_hook = undef;
 170
 171 # show repository only if this subroutine returns true
 172 # when given the path to the project, for example:
 173 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 174 our $export_auth_hook = undef;
 175
 176 # only allow viewing of repositories also shown on the overview page
 177 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 178
 179 # base URL for bundle info link shown on summary page, but only if
 180 # this config item is defined AND a 'bundles' subdirectory exists
 181 # in the project's repository.
 182 # i.e. full URL is "git_base_bundles_url/$project/bundles"
 183 our $git_base_bundles_url = undef;
 184
 185 # list of git base URLs used for URL to where fetch project from,
 186 # i.e. full URL is "$git_base_url/$project"
 187 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 188
 189 # URLs designated for pushing new changes, extended by the
 190 # project name (i.e. "$git_base_push_url[0]/$project")
 191 our @git_base_push_urls = ();
 192
 193 # https hint html inserted right after any https push URL (undef for none)
 194 our $https_hint_html = undef;
 195
 196 # default blob_plain mimetype and default charset for text/plain blob
 197 our $default_blob_plain_mimetype = 'application/octet-stream';
 198 our $default_text_plain_charset  = undef;
 199
 200 # file to use for guessing MIME types before trying /etc/mime.types
 201 # (relative to the current git repository)
 202 our $mimetypes_file = undef;
 203
 204 # assume this charset if line contains non-UTF-8 characters;
 205 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 206 # for which encoding all byte sequences are valid, for example
 207 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 208 # could be even 'utf-8' for the old behavior)
 209 our $fallback_encoding = 'latin1';
 210
 211 # rename detection options for git-diff and git-diff-tree
 212 # - default is '-M', with the cost proportional to
 213 #   (number of removed files) * (number of new files).
 214 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 215 #   (number of changed files + number of removed files) * (number of new files)
 216 # - even more costly is '-C', '--find-copies-harder' with cost
 217 #   (number of files in the original tree) * (number of new files)
 218 # - one might want to include '-B' option, e.g. '-B', '-M'
 219 our @diff_opts = ('-M'); # taken from git_commit
 220
 221 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 222 # the directory must exist and be writable by the process running gitweb.
 223 # additionally some actions must be selected for caching in %html_cache_actions
 224 # - default is 'htmlcache'
 225 our $html_cache_dir = 'htmlcache';
 226
 227 # which actions to cache in $html_cache_dir
 228 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 229 # process running gitweb, then any actions selected here will have their output
 230 # cached and the cache file will be returned instead of regenerating the page
 231 # if it exists.  For this to be useful, an external process must create the
 232 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 233 # the project information has been changed.  Alternatively it may create a
 234 # "$action.changed" file (if it does not exist) instead to limit the changes
 235 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 236 # exist, then the cached version will never be used for "$action" and a new
 237 # cache page will be regenerated (and the "changed" files removed as appropriate).
 238 #
 239 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 240 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 241 # process must create the 'forkchange' file or update its timestamp if it already
 242 # exists whenever a fork is added to or removed from the project (as well as
 243 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 244 # section on the summary page may remain out-of-date indefinately.
 245 #
 246 # - default is none
 247 #   currently only caching of the summary page is supported
 248 # - to enable caching of the summary page use:
 249 #   $html_cache_actions{'summary'} = 1;
 250 our %html_cache_actions = ();
 251
 252 # utility to automatically produce a default README.html if README.html is
 253 # enabled and it does not exist or is 0 bytes in length.  If this is set to an
 254 # executable utility that takes an absolute path to a .git directory as its
 255 # first argument and outputs an HTML fragment to use for README.html, then
 256 # it will be called when README.html is enabled but empty or missing.
 257 our $git_automatic_readme_html = undef;
 258
 259 # Disables features that would allow repository owners to inject script into
 260 # the gitweb domain.
 261 our $prevent_xss = 0;
 262
 263 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 264 # Only used when highlight is enabled or snapshots with compressors are enabled.
 265 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 266
 267 # Path to the highlight executable to use (must be the one from
 268 # http://www.andre-simon.de due to assumptions about parameters and output).
 269 # Useful if highlight is not installed on your webserver's PATH.
 270 # [Default: highlight]
 271 our $highlight_bin = "++HIGHLIGHT_BIN++";
 272
 273 # Whether to include project list on the gitweb front page; 0 means yes,
 274 # 1 means no list but show tag cloud if enabled (all projects still need
 275 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 276 # (very fast)
 277 our $frontpage_no_project_list = 0;
 278
 279 # projects list cache for busy sites with many projects;
 280 # if you set this to non-zero, it will be used as the cached
 281 # index lifetime in minutes
 282 #
 283 # the cached list version is stored in $cache_dir/$cache_name and can
 284 # be tweaked by other scripts running with the same uid as gitweb -
 285 # use this ONLY at secure installations; only single gitweb project
 286 # root per system is supported, unless you tweak configuration!
 287 our $projlist_cache_lifetime = 0; # in minutes
 288 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 289 our $cache_dir =
 290         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 291 our $projlist_cache_name = 'gitweb.index.cache';
 292 our $cache_grpshared = 0;
 293
 294 # information about snapshot formats that gitweb is capable of serving
 295 our %known_snapshot_formats = (
 296         # name => {
 297         #       'display' => display name,
 298         #       'type' => mime type,
 299         #       'suffix' => filename suffix,
 300         #       'format' => --format for git-archive,
 301         #       'compressor' => [compressor command and arguments]
 302         #                       (array reference, optional)
 303         #       'disabled' => boolean (optional)}
 304         #
 305         'tgz' => {
 306                 'display' => 'tar.gz',
 307                 'type' => 'application/x-gzip',
 308                 'suffix' => '.tar.gz',
 309                 'format' => 'tar',
 310                 'compressor' => ['gzip', '-n']},
 311
 312         'tbz2' => {
 313                 'display' => 'tar.bz2',
 314                 'type' => 'application/x-bzip2',
 315                 'suffix' => '.tar.bz2',
 316                 'format' => 'tar',
 317                 'compressor' => ['bzip2']},
 318
 319         'txz' => {
 320                 'display' => 'tar.xz',
 321                 'type' => 'application/x-xz',
 322                 'suffix' => '.tar.xz',
 323                 'format' => 'tar',
 324                 'compressor' => ['xz'],
 325                 'disabled' => 1},
 326
 327         'zip' => {
 328                 'display' => 'zip',
 329                 'type' => 'application/x-zip',
 330                 'suffix' => '.zip',
 331                 'format' => 'zip'},
 332 );
 333
 334 # Aliases so we understand old gitweb.snapshot values in repository
 335 # configuration.
 336 our %known_snapshot_format_aliases = (
 337         'gzip'  => 'tgz',
 338         'bzip2' => 'tbz2',
 339         'xz'    => 'txz',
 340
 341         # backward compatibility: legacy gitweb config support
 342         'x-gzip' => undef, 'gz' => undef,
 343         'x-bzip2' => undef, 'bz2' => undef,
 344         'x-zip' => undef, '' => undef,
 345 );
 346
 347 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 348 # are changed, it may be appropriate to change these values too via
 349 # $GITWEB_CONFIG.
 350 our %avatar_size = (
 351         'default' => 16,
 352         'double'  => 32
 353 );
 354
 355 # Used to set the maximum load that we will still respond to gitweb queries.
 356 # If server load exceed this value then return "503 server busy" error.
 357 # If gitweb cannot determined server load, it is taken to be 0.
 358 # Leave it undefined (or set to 'undef') to turn off load checking.
 359 our $maxload = 300;
 360
 361 # configuration for 'highlight' (http://www.andre-simon.de/)
 362 # match by basename
 363 our %highlight_basename = (
 364         #'Program' => 'py',
 365         #'Library' => 'py',
 366         'SConstruct' => 'py', # SCons equivalent of Makefile
 367         'Makefile' => 'make',
 368         'makefile' => 'make',
 369         'GNUmakefile' => 'make',
 370         'BSDmakefile' => 'make',
 371 );
 372 # match by shebang regex
 373 our %highlight_shebang = (
 374         # Each entry has a key which is the syntax to use and
 375         # a value which is either a qr regex or an array of qr regexs to match
 376         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 377         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 378         # allow a limited subset of NAME=value items to appear.
 379         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 380                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 381         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 382                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 383         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 384                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 385         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 386                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 387         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 388                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 389         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 390                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 391         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 392                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 393 );
 394 # match by extension
 395 our %highlight_ext = (
 396         # main extensions, defining name of syntax;
 397         # see files in /usr/share/highlight/langDefs/ directory
 398         (map { $_ => $_ } qw(
 399                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 400                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 401                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 402                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 403                 go haskell hcl html httpd hx icl icn idl idlang ili
 404                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 405                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 406                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 407                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 408                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 409                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 410                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 411                 yaiff znn)),
 412         # alternate extensions, see /etc/highlight/filetypes.conf
 413         (map { $_ => '4gl' } qw(informix)),
 414         (map { $_ => 'a4c' } qw(ascend)),
 415         (map { $_ => 'abp' } qw(abp4)),
 416         (map { $_ => 'ada' } qw(a adb ads gnad)),
 417         (map { $_ => 'ahk' } qw(autohotkey)),
 418         (map { $_ => 'ampl' } qw(dat run)),
 419         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 420         (map { $_ => 'as' } qw(actionscript)),
 421         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 422         (map { $_ => 'asp' } qw(asa)),
 423         (map { $_ => 'aspect' } qw(was wud)),
 424         (map { $_ => 'ats' } qw(dats)),
 425         (map { $_ => 'au3' } qw(autoit)),
 426         (map { $_ => 'bat' } qw(cmd)),
 427         (map { $_ => 'bb' } qw(blitzbasic)),
 428         (map { $_ => 'bib' } qw(bibtex)),
 429         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 430         (map { $_ => 'cb' } qw(clearbasic)),
 431         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 432         (map { $_ => 'chl' } qw(chill)),
 433         (map { $_ => 'cob' } qw(cbl cobol)),
 434         (map { $_ => 'cs' } qw(csharp)),
 435         (map { $_ => 'diff' } qw(patch)),
 436         (map { $_ => 'dot' } qw(graphviz)),
 437         (map { $_ => 'e' } qw(eiffel se)),
 438         (map { $_ => 'erl' } qw(erlang hrl)),
 439         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 440         (map { $_ => 'exp' } qw(express)),
 441         (map { $_ => 'f90' } qw(f95)),
 442         (map { $_ => 'flx' } qw(felix)),
 443         (map { $_ => 'for' } qw(f f77 ftn)),
 444         (map { $_ => 'fs' } qw(fsharp fsx)),
 445         (map { $_ => 'haskell' } qw(hs)),
 446         (map { $_ => 'html' } qw(htm xhtml)),
 447         (map { $_ => 'hx' } qw(haxe)),
 448         (map { $_ => 'icl' } qw(clean)),
 449         (map { $_ => 'icn' } qw(icon)),
 450         (map { $_ => 'ili' } qw(interlis)),
 451         (map { $_ => 'inp' } qw(fame)),
 452         (map { $_ => 'iss' } qw(innosetup)),
 453         (map { $_ => 'j' } qw(jasmin)),
 454         (map { $_ => 'java' } qw(groovy grv)),
 455         (map { $_ => 'lbn' } qw(luban)),
 456         (map { $_ => 'lgt' } qw(logtalk)),
 457         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 458         (map { $_ => 'ls' } qw(lotus)),
 459         (map { $_ => 'lsl' } qw(lindenscript)),
 460         (map { $_ => 'ly' } qw(lilypond)),
 461         (map { $_ => 'make' } qw(mak mk kmk)),
 462         (map { $_ => 'mel' } qw(maya)),
 463         (map { $_ => 'mib' } qw(smi snmp)),
 464         (map { $_ => 'ml' } qw(mli ocaml)),
 465         (map { $_ => 'mo' } qw(modelica)),
 466         (map { $_ => 'mod2' } qw(def mod)),
 467         (map { $_ => 'mod3' } qw(i3 m3)),
 468         (map { $_ => 'mpl' } qw(maple)),
 469         (map { $_ => 'n' } qw(nemerle)),
 470         (map { $_ => 'nas' } qw(nasal)),
 471         (map { $_ => 'nrx' } qw(netrexx)),
 472         (map { $_ => 'nsi' } qw(nsis)),
 473         (map { $_ => 'nut' } qw(squirrel)),
 474         (map { $_ => 'oberon' } qw(ooc)),
 475         (map { $_ => 'objc' } qw(M m mm)),
 476         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 477         (map { $_ => 'pike' } qw(pmod)),
 478         (map { $_ => 'pl' } qw(perl plex plx pm)),
 479         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 480         (map { $_ => 'progress' } qw(i p w)),
 481         (map { $_ => 'py' } qw(python)),
 482         (map { $_ => 'pyx' } qw(pyrex)),
 483         (map { $_ => 'rb' } qw(pp rjs ruby)),
 484         (map { $_ => 'rexx' } qw(rex rx the)),
 485         (map { $_ => 'sc' } qw(paradox)),
 486         (map { $_ => 'scilab' } qw(sce sci)),
 487         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 488         (map { $_ => 'sma' } qw(small)),
 489         (map { $_ => 'smalltalk' } qw(gst sq st)),
 490         (map { $_ => 'sno' } qw(snobal)),
 491         (map { $_ => 'sybase' } qw(sp)),
 492         (map { $_ => 'tcl' } qw(itcl wish)),
 493         (map { $_ => 'tex' } qw(cls sty)),
 494         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 495         (map { $_ => 'verilog' } qw(v)),
 496         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 497         (map { $_ => 'y' } qw(bison)),
 498 );
 499
 500 # You define site-wide feature defaults here; override them with
 501 # $GITWEB_CONFIG as necessary.
 502 our %feature = (
 503         # feature => {
 504         #       'sub' => feature-sub (subroutine),
 505         #       'override' => allow-override (boolean),
 506         #       'default' => [ default options...] (array reference)}
 507         #
 508         # if feature is overridable (it means that allow-override has true value),
 509         # then feature-sub will be called with default options as parameters;
 510         # return value of feature-sub indicates if to enable specified feature
 511         #
 512         # if there is no 'sub' key (no feature-sub), then feature cannot be
 513         # overridden
 514         #
 515         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 516         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 517         # is enabled
 518
 519         # Enable the 'blame' blob view, showing the last commit that modified
 520         # each line in the file. This can be very CPU-intensive.
 521
 522         # To enable system wide have in $GITWEB_CONFIG
 523         # $feature{'blame'}{'default'} = [1];
 524         # To have project specific config enable override in $GITWEB_CONFIG
 525         # $feature{'blame'}{'override'} = 1;
 526         # and in project config gitweb.blame = 0|1;
 527         'blame' => {
 528                 'sub' => sub { feature_bool('blame', @_) },
 529                 'override' => 0,
 530                 'default' => [0]},
 531
 532         # Enable the 'incremental blame' blob view, which uses javascript to
 533         # incrementally show the revisions of lines as they are discovered
 534         # in the history. It is better for large histories, files and slow
 535         # servers, but requires javascript in the client and can slow down the
 536         # browser on large files.
 537
 538         # To enable system wide have in $GITWEB_CONFIG
 539         # $feature{'blame_incremental'}{'default'} = [1];
 540         # To have project specific config enable override in $GITWEB_CONFIG
 541         # $feature{'blame_incremental'}{'override'} = 1;
 542         # and in project config gitweb.blame_incremental = 0|1;
 543         'blame_incremental' => {
 544                 'sub' => sub { feature_bool('blame_incremental', @_) },
 545                 'override' => 0,
 546                 'default' => [0]},
 547
 548         # Enable the 'snapshot' link, providing a compressed archive of any
 549         # tree. This can potentially generate high traffic if you have large
 550         # project.
 551
 552         # Value is a list of formats defined in %known_snapshot_formats that
 553         # you wish to offer.
 554         # To disable system wide have in $GITWEB_CONFIG
 555         # $feature{'snapshot'}{'default'} = [];
 556         # To have project specific config enable override in $GITWEB_CONFIG
 557         # $feature{'snapshot'}{'override'} = 1;
 558         # and in project config, a comma-separated list of formats or "none"
 559         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 560         'snapshot' => {
 561                 'sub' => \&feature_snapshot,
 562                 'override' => 0,
 563                 'default' => ['tgz']},
 564
 565         # Enable text search, which will list the commits which match author,
 566         # committer or commit text to a given string.  Enabled by default.
 567         # Project specific override is not supported.
 568         #
 569         # Note that this controls all search features, which means that if
 570         # it is disabled, then 'grep' and 'pickaxe' search would also be
 571         # disabled.
 572         'search' => {
 573                 'override' => 0,
 574                 'default' => [1]},
 575
 576         # Enable grep search, which will list the files in currently selected
 577         # tree containing the given string. Enabled by default. This can be
 578         # potentially CPU-intensive, of course.
 579         # Note that you need to have 'search' feature enabled too.
 580
 581         # To enable system wide have in $GITWEB_CONFIG
 582         # $feature{'grep'}{'default'} = [1];
 583         # To have project specific config enable override in $GITWEB_CONFIG
 584         # $feature{'grep'}{'override'} = 1;
 585         # and in project config gitweb.grep = 0|1;
 586         'grep' => {
 587                 'sub' => sub { feature_bool('grep', @_) },
 588                 'override' => 0,
 589                 'default' => [1]},
 590
 591         # Enable the pickaxe search, which will list the commits that modified
 592         # a given string in a file. This can be practical and quite faster
 593         # alternative to 'blame', but still potentially CPU-intensive.
 594         # Note that you need to have 'search' feature enabled too.
 595
 596         # To enable system wide have in $GITWEB_CONFIG
 597         # $feature{'pickaxe'}{'default'} = [1];
 598         # To have project specific config enable override in $GITWEB_CONFIG
 599         # $feature{'pickaxe'}{'override'} = 1;
 600         # and in project config gitweb.pickaxe = 0|1;
 601         'pickaxe' => {
 602                 'sub' => sub { feature_bool('pickaxe', @_) },
 603                 'override' => 0,
 604                 'default' => [1]},
 605
 606         # Enable showing size of blobs in a 'tree' view, in a separate
 607         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 608
 609         # To disable system wide have in $GITWEB_CONFIG
 610         # $feature{'show-sizes'}{'default'} = [0];
 611         # To have project specific config enable override in $GITWEB_CONFIG
 612         # $feature{'show-sizes'}{'override'} = 1;
 613         # and in project config gitweb.showsizes = 0|1;
 614         'show-sizes' => {
 615                 'sub' => sub { feature_bool('showsizes', @_) },
 616                 'override' => 0,
 617                 'default' => [1]},
 618
 619         # Make gitweb use an alternative format of the URLs which can be
 620         # more readable and natural-looking: project name is embedded
 621         # directly in the path and the query string contains other
 622         # auxiliary information. All gitweb installations recognize
 623         # URL in either format; this configures in which formats gitweb
 624         # generates links.
 625
 626         # To enable system wide have in $GITWEB_CONFIG
 627         # $feature{'pathinfo'}{'default'} = [1];
 628         # Project specific override is not supported.
 629
 630         # Note that you will need to change the default location of CSS,
 631         # favicon, logo and possibly other files to an absolute URL. Also,
 632         # if gitweb.cgi serves as your indexfile, you will need to force
 633         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 634         # will also likely want to set $home_link if you're setting $my_uri).
 635         'pathinfo' => {
 636                 'override' => 0,
 637                 'default' => [0]},
 638
 639         # Make gitweb consider projects in project root subdirectories
 640         # to be forks of existing projects. Given project $projname.git,
 641         # projects matching $projname/*.git will not be shown in the main
 642         # projects list, instead a '+' mark will be added to $projname
 643         # there and a 'forks' view will be enabled for the project, listing
 644         # all the forks. If project list is taken from a file, forks have
 645         # to be listed after the main project.
 646
 647         # To enable system wide have in $GITWEB_CONFIG
 648         # $feature{'forks'}{'default'} = [1];
 649         # Project specific override is not supported.
 650         'forks' => {
 651                 'override' => 0,
 652                 'default' => [0]},
 653
 654         # Insert custom links to the action bar of all project pages.
 655         # This enables you mainly to link to third-party scripts integrating
 656         # into gitweb; e.g. git-browser for graphical history representation
 657         # or custom web-based repository administration interface.
 658
 659         # The 'default' value consists of a list of triplets in the form
 660         # (label, link, position) where position is the label after which
 661         # to insert the link and link is a format string where %n expands
 662         # to the project name, %f to the project path within the filesystem,
 663         # %h to the current hash (h gitweb parameter) and %b to the current
 664         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 665         # project name where all '+' characters have been replaced with '%2B'.
 666
 667         # To enable system wide have in $GITWEB_CONFIG e.g.
 668         # $feature{'actions'}{'default'} = [('graphiclog',
 669         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 670         # Project specific override is not supported.
 671         'actions' => {
 672                 'override' => 0,
 673                 'default' => []},
 674
 675         # Allow gitweb scan project content tags of project repository,
 676         # and display the popular Web 2.0-ish "tag cloud" near the projects
 677         # list.  Note that this is something COMPLETELY different from the
 678         # normal Git tags.
 679
 680         # gitweb by itself can show existing tags, but it does not handle
 681         # tagging itself; you need to do it externally, outside gitweb.
 682         # The format is described in git_get_project_ctags() subroutine.
 683         # You may want to install the HTML::TagCloud Perl module to get
 684         # a pretty tag cloud instead of just a list of tags.
 685
 686         # To enable system wide have in $GITWEB_CONFIG
 687         # $feature{'ctags'}{'default'} = [1];
 688         # Project specific override is not supported.
 689
 690         # A value of 0 means no ctags display or editing.  A value of
 691         # 1 enables ctags display but never editing.  A non-empty value
 692         # that is not a string of digits enables ctags display AND the
 693         # ability to add tags using a form that uses method POST and
 694         # an action value set to the configured 'ctags' value.
 695         'ctags' => {
 696                 'override' => 0,
 697                 'default' => [0]},
 698
 699         # The maximum number of patches in a patchset generated in patch
 700         # view. Set this to 0 or undef to disable patch view, or to a
 701         # negative number to remove any limit.
 702
 703         # To disable system wide have in $GITWEB_CONFIG
 704         # $feature{'patches'}{'default'} = [0];
 705         # To have project specific config enable override in $GITWEB_CONFIG
 706         # $feature{'patches'}{'override'} = 1;
 707         # and in project config gitweb.patches = 0|n;
 708         # where n is the maximum number of patches allowed in a patchset.
 709         'patches' => {
 710                 'sub' => \&feature_patches,
 711                 'override' => 0,
 712                 'default' => [16]},
 713
 714         # Avatar support. When this feature is enabled, views such as
 715         # shortlog or commit will display an avatar associated with
 716         # the email of the committer(s) and/or author(s).
 717
 718         # Currently available providers are gravatar and picon.
 719         # If an unknown provider is specified, the feature is disabled.
 720
 721         # Gravatar depends on Digest::MD5.
 722         # Picon currently relies on the indiana.edu database.
 723
 724         # To enable system wide have in $GITWEB_CONFIG
 725         # $feature{'avatar'}{'default'} = ['<provider>'];
 726         # where <provider> is either gravatar or picon.
 727         # To have project specific config enable override in $GITWEB_CONFIG
 728         # $feature{'avatar'}{'override'} = 1;
 729         # and in project config gitweb.avatar = <provider>;
 730         'avatar' => {
 731                 'sub' => \&feature_avatar,
 732                 'override' => 0,
 733                 'default' => ['']},
 734
 735         # Enable displaying how much time and how many git commands
 736         # it took to generate and display page.  Disabled by default.
 737         # Project specific override is not supported.
 738         'timed' => {
 739                 'override' => 0,
 740                 'default' => [0]},
 741
 742         # Enable turning some links into links to actions which require
 743         # JavaScript to run (like 'blame_incremental').  Not enabled by
 744         # default.  Project specific override is currently not supported.
 745         'javascript-actions' => {
 746                 'override' => 0,
 747                 'default' => [0]},
 748
 749         # Enable and configure ability to change common timezone for dates
 750         # in gitweb output via JavaScript.  Enabled by default.
 751         # Project specific override is not supported.
 752         'javascript-timezone' => {
 753                 'override' => 0,
 754                 'default' => [
 755                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 756                                      # or undef to turn off this feature
 757                         'gitweb_tz', # name of cookie where to store selected timezone
 758                         'datetime',  # CSS class used to mark up dates for manipulation
 759                 ]},
 760
 761         # Syntax highlighting support. This is based on Daniel Svensson's
 762         # and Sham Chukoury's work in gitweb-xmms2.git.
 763         # It requires the 'highlight' program present in $PATH,
 764         # and therefore is disabled by default.
 765
 766         # To enable system wide have in $GITWEB_CONFIG
 767         # $feature{'highlight'}{'default'} = [1];
 768
 769         'highlight' => {
 770                 'sub' => sub { feature_bool('highlight', @_) },
 771                 'override' => 0,
 772                 'default' => [0]},
 773
 774         # Enable displaying of remote heads in the heads list
 775
 776         # To enable system wide have in $GITWEB_CONFIG
 777         # $feature{'remote_heads'}{'default'} = [1];
 778         # To have project specific config enable override in $GITWEB_CONFIG
 779         # $feature{'remote_heads'}{'override'} = 1;
 780         # and in project config gitweb.remoteheads = 0|1;
 781         'remote_heads' => {
 782                 'sub' => sub { feature_bool('remote_heads', @_) },
 783                 'override' => 0,
 784                 'default' => [0]},
 785
 786         # Enable showing branches under other refs in addition to heads
 787
 788         # To set system wide extra branch refs have in $GITWEB_CONFIG
 789         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 790         # To have project specific config enable override in $GITWEB_CONFIG
 791         # $feature{'extra-branch-refs'}{'override'} = 1;
 792         # and in project config gitweb.extrabranchrefs = dirs of choice
 793         # Every directory is separated with whitespace.
 794
 795         'extra-branch-refs' => {
 796                 'sub' => \&feature_extra_branch_refs,
 797                 'override' => 0,
 798                 'default' => []},
 799 );
 800
 801 sub gitweb_get_feature {
 802         my ($name) = @_;
 803         return unless exists $feature{$name};
 804         my ($sub, $override, @defaults) = (
 805                 $feature{$name}{'sub'},
 806                 $feature{$name}{'override'},
 807                 @{$feature{$name}{'default'}});
 808         # project specific override is possible only if we have project
 809         our $git_dir; # global variable, declared later
 810         if (!$override || !defined $git_dir) {
 811                 return @defaults;
 812         }
 813         if (!defined $sub) {
 814                 warn "feature $name is not overridable";
 815                 return @defaults;
 816         }
 817         return $sub->(@defaults);
 818 }
 819
 820 # A wrapper to check if a given feature is enabled.
 821 # With this, you can say
 822 #
 823 #   my $bool_feat = gitweb_check_feature('bool_feat');
 824 #   gitweb_check_feature('bool_feat') or somecode;
 825 #
 826 # instead of
 827 #
 828 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 829 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 830 #
 831 sub gitweb_check_feature {
 832         return (gitweb_get_feature(@_))[0];
 833 }
 834
 835
 836 sub feature_bool {
 837         my $key = shift;
 838         my ($val) = git_get_project_config($key, '--bool');
 839
 840         if (!defined $val) {
 841                 return ($_[0]);
 842         } elsif ($val eq 'true') {
 843                 return (1);
 844         } elsif ($val eq 'false') {
 845                 return (0);
 846         }
 847 }
 848
 849 sub feature_snapshot {
 850         my (@fmts) = @_;
 851
 852         my ($val) = git_get_project_config('snapshot');
 853
 854         if ($val) {
 855                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 856         }
 857
 858         return @fmts;
 859 }
 860
 861 sub feature_patches {
 862         my @val = (git_get_project_config('patches', '--int'));
 863
 864         if (@val) {
 865                 return @val;
 866         }
 867
 868         return ($_[0]);
 869 }
 870
 871 sub feature_avatar {
 872         my @val = (git_get_project_config('avatar'));
 873
 874         return @val ? @val : @_;
 875 }
 876
 877 sub feature_extra_branch_refs {
 878         my (@branch_refs) = @_;
 879         my $values = git_get_project_config('extrabranchrefs');
 880
 881         if ($values) {
 882                 $values = config_to_multi ($values);
 883                 @branch_refs = ();
 884                 foreach my $value (@{$values}) {
 885                         push @branch_refs, split /\s+/, $value;
 886                 }
 887         }
 888
 889         return @branch_refs;
 890 }
 891
 892 # checking HEAD file with -e is fragile if the repository was
 893 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 894 # and then pruned.
 895 sub check_head_link {
 896         my ($dir) = @_;
 897         return 0 unless -d "$dir/objects" && -x _;
 898         return 0 unless -d "$dir/refs" && -x _;
 899         my $headfile = "$dir/HEAD";
 900         return -l $headfile ?
 901                 readlink($headfile) =~ /^refs\/heads\// : -f $headfile;
 902 }
 903
 904 sub check_export_ok {
 905         my ($dir) = @_;
 906         return (check_head_link($dir) &&
 907                 (!$export_ok || -e "$dir/$export_ok") &&
 908                 (!$export_auth_hook || $export_auth_hook->($dir)));
 909 }
 910
 911 # process alternate names for backward compatibility
 912 # filter out unsupported (unknown) snapshot formats
 913 sub filter_snapshot_fmts {
 914         my @fmts = @_;
 915
 916         @fmts = map {
 917                 exists $known_snapshot_format_aliases{$_} ?
 918                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 919         @fmts = grep {
 920                 exists $known_snapshot_formats{$_} &&
 921                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 922 }
 923
 924 sub filter_and_validate_refs {
 925         my @refs = @_;
 926         my %unique_refs = ();
 927
 928         foreach my $ref (@refs) {
 929                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 930                 # 'heads' are added implicitly in get_branch_refs().
 931                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 932         }
 933         return sort keys %unique_refs;
 934 }
 935
 936 # If it is set to code reference, it is code that it is to be run once per
 937 # request, allowing updating configurations that change with each request,
 938 # while running other code in config file only once.
 939 #
 940 # Otherwise, if it is false then gitweb would process config file only once;
 941 # if it is true then gitweb config would be run for each request.
 942 our $per_request_config = 1;
 943
 944 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 945 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 946 # same way as though the --fcgi option had been given instead.
 947 our $auto_fcgi = 0;
 948
 949 # read and parse gitweb config file given by its parameter.
 950 # returns true on success, false on recoverable error, allowing
 951 # to chain this subroutine, using first file that exists.
 952 # dies on errors during parsing config file, as it is unrecoverable.
 953 sub read_config_file {
 954         my $filename = shift;
 955         return unless defined $filename;
 956         # die if there are errors parsing config file
 957         if (-e $filename) {
 958                 do $filename;
 959                 die $@ if $@;
 960                 return 1;
 961         }
 962         return;
 963 }
 964
 965 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
 966 sub evaluate_gitweb_config {
 967         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
 968         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
 969         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
 970
 971         # Protect against duplications of file names, to not read config twice.
 972         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
 973         # there possibility of duplication of filename there doesn't matter.
 974         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
 975         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
 976
 977         # Common system-wide settings for convenience.
 978         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
 979         read_config_file($GITWEB_CONFIG_COMMON);
 980
 981         # Use first config file that exists.  This means use the per-instance
 982         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
 983         read_config_file($GITWEB_CONFIG) and return;
 984         read_config_file($GITWEB_CONFIG_SYSTEM);
 985 }
 986
 987 our $encode_object;
 988
 989 sub evaluate_encoding {
 990         my $requested = $fallback_encoding || 'ISO-8859-1';
 991         my $obj = Encode::find_encoding($requested) or
 992                 die_error(400, "Requested fallback encoding not found");
 993         if ($obj->name eq 'iso-8859-1') {
 994                 # Use Windows-1252 instead as required by the HTML 5 standard
 995                 my $altobj = Encode::find_encoding('Windows-1252');
 996                 $obj = $altobj if $altobj;
 997         }
 998         $encode_object = $obj;
 999 }
1000
1001 sub evaluate_email_obfuscate {
1002         # email obfuscation
1003         our $email;
1004         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
1005                 $email = HTML::Email::Obfuscate->new(lite => 1);
1006         }
1007 }
1008
1009 # Get loadavg of system, to compare against $maxload.
1010 # Currently it requires '/proc/loadavg' present to get loadavg;
1011 # if it is not present it returns 0, which means no load checking.
1012 sub get_loadavg {
1013         if( -e '/proc/loadavg' ){
1014                 open my $fd, '<', '/proc/loadavg'
1015                         or return 0;
1016                 my @load = split(/\s+/, scalar <$fd>);
1017                 close $fd;
1018
1019                 # The first three columns measure CPU and IO utilization of the last one,
1020                 # five, and 10 minute periods.  The fourth column shows the number of
1021                 # currently running processes and the total number of processes in the m/n
1022                 # format.  The last column displays the last process ID used.
1023                 return $load[0] || 0;
1024         }
1025         # additional checks for load average should go here for things that don't export
1026         # /proc/loadavg
1027
1028         return 0;
1029 }
1030
1031 # version of the core git binary
1032 our $git_version;
1033 sub evaluate_git_version {
1034         our $git_version = $version;
1035 }
1036
1037 sub check_loadavg {
1038         if (defined $maxload && get_loadavg() > $maxload) {
1039                 die_error(503, "The load average on the server is too high");
1040         }
1041 }
1042
1043 # ======================================================================
1044 # input validation and dispatch
1045
1046 # input parameters can be collected from a variety of sources (presently, CGI
1047 # and PATH_INFO), so we define an %input_params hash that collects them all
1048 # together during validation: this allows subsequent uses (e.g. href()) to be
1049 # agnostic of the parameter origin
1050
1051 our %input_params = ();
1052
1053 # input parameters are stored with the long parameter name as key. This will
1054 # also be used in the href subroutine to convert parameters to their CGI
1055 # equivalent, and since the href() usage is the most frequent one, we store
1056 # the name -> CGI key mapping here, instead of the reverse.
1057 #
1058 # XXX: Warning: If you touch this, check the search form for updating,
1059 # too.
1060
1061 our @cgi_param_mapping = (
1062         project => "p",
1063         action => "a",
1064         file_name => "f",
1065         file_parent => "fp",
1066         hash => "h",
1067         hash_parent => "hp",
1068         hash_base => "hb",
1069         hash_parent_base => "hpb",
1070         page => "pg",
1071         order => "o",
1072         searchtext => "s",
1073         searchtype => "st",
1074         snapshot_format => "sf",
1075         ctag_filter => 't',
1076         extra_options => "opt",
1077         search_use_regexp => "sr",
1078         ctag => "by_tag",
1079         diff_style => "ds",
1080         project_filter => "pf",
1081         # this must be last entry (for manipulation from JavaScript)
1082         javascript => "js"
1083 );
1084 our %cgi_param_mapping = @cgi_param_mapping;
1085
1086 # we will also need to know the possible actions, for validation
1087 our %actions = (
1088         "blame" => \&git_blame,
1089         "blame_incremental" => \&git_blame_incremental,
1090         "blame_data" => \&git_blame_data,
1091         "blobdiff" => \&git_blobdiff,
1092         "blobdiff_plain" => \&git_blobdiff_plain,
1093         "blob" => \&git_blob,
1094         "blob_plain" => \&git_blob_plain,
1095         "commitdiff" => \&git_commitdiff,
1096         "commitdiff_plain" => \&git_commitdiff_plain,
1097         "commit" => \&git_commit,
1098         "forks" => \&git_forks,
1099         "heads" => \&git_heads,
1100         "history" => \&git_history,
1101         "log" => \&git_log,
1102         "patch" => \&git_patch,
1103         "patches" => \&git_patches,
1104         "refs" => \&git_refs,
1105         "remotes" => \&git_remotes,
1106         "rss" => \&git_rss,
1107         "atom" => \&git_atom,
1108         "search" => \&git_search,
1109         "search_help" => \&git_search_help,
1110         "shortlog" => \&git_shortlog,
1111         "summary" => \&git_summary,
1112         "tag" => \&git_tag,
1113         "tags" => \&git_tags,
1114         "tree" => \&git_tree,
1115         "snapshot" => \&git_snapshot,
1116         "object" => \&git_object,
1117         # those below don't need $project
1118         "opml" => \&git_opml,
1119         "frontpage" => \&git_frontpage,
1120         "project_list" => \&git_project_list,
1121         "project_index" => \&git_project_index,
1122 );
1123
1124 # the only actions we will allow to be cached
1125 my %supported_cache_actions;
1126 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1127
1128 # finally, we have the hash of allowed extra_options for the commands that
1129 # allow them
1130 our %allowed_options = (
1131         "--no-merges" => [ qw(rss atom log shortlog history) ],
1132 );
1133
1134 # fill %input_params with the CGI parameters. All values except for 'opt'
1135 # should be single values, but opt can be an array. We should probably
1136 # build an array of parameters that can be multi-valued, but since for the time
1137 # being it's only this one, we just single it out
1138 sub evaluate_query_params {
1139         our $cgi;
1140
1141         while (my ($name, $symbol) = each %cgi_param_mapping) {
1142                 if ($symbol eq 'opt') {
1143                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1144                 } else {
1145                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1146                 }
1147         }
1148
1149         # Backwards compatibility - by_tag= <=> t=
1150         if ($input_params{'ctag'}) {
1151                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1152         }
1153 }
1154
1155 # now read PATH_INFO and update the parameter list for missing parameters
1156 sub evaluate_path_info {
1157         return if defined $input_params{'project'};
1158         return if !$path_info;
1159         $path_info =~ s,^/+,,;
1160         return if !$path_info;
1161
1162         # find which part of PATH_INFO is project
1163         my $project = $path_info;
1164         $project =~ s,/+$,,;
1165         while ($project && !check_head_link("$projectroot/$project")) {
1166                 $project =~ s,/*[^/]*$,,;
1167         }
1168         return unless $project;
1169         $input_params{'project'} = $project;
1170
1171         # do not change any parameters if an action is given using the query string
1172         return if $input_params{'action'};
1173         $path_info =~ s,^\Q$project\E/*,,;
1174
1175         # next, check if we have an action
1176         my $action = $path_info;
1177         $action =~ s,/.*$,,;
1178         if (exists $actions{$action}) {
1179                 $path_info =~ s,^$action/*,,;
1180                 $input_params{'action'} = $action;
1181         }
1182
1183         # list of actions that want hash_base instead of hash, but can have no
1184         # pathname (f) parameter
1185         my @wants_base = (
1186                 'tree',
1187                 'history',
1188         );
1189
1190         # we want to catch, among others
1191         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1192         my ($parentrefname, $parentpathname, $refname, $pathname) =
1193                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1194
1195         # first, analyze the 'current' part
1196         if (defined $pathname) {
1197                 # we got "branch:filename" or "branch:dir/"
1198                 # we could use git_get_type(branch:pathname), but:
1199                 # - it needs $git_dir
1200                 # - it does a git() call
1201                 # - the convention of terminating directories with a slash
1202                 #   makes it superfluous
1203                 # - embedding the action in the PATH_INFO would make it even
1204                 #   more superfluous
1205                 $pathname =~ s,^/+,,;
1206                 if (!$pathname || substr($pathname, -1) eq "/") {
1207                         $input_params{'action'} ||= "tree";
1208                         $pathname =~ s,/$,,;
1209                 } else {
1210                         # the default action depends on whether we had parent info
1211                         # or not
1212                         if ($parentrefname) {
1213                                 $input_params{'action'} ||= "blobdiff_plain";
1214                         } else {
1215                                 $input_params{'action'} ||= "blob_plain";
1216                         }
1217                 }
1218                 $input_params{'hash_base'} ||= $refname;
1219                 $input_params{'file_name'} ||= $pathname;
1220         } elsif (defined $refname) {
1221                 # we got "branch". In this case we have to choose if we have to
1222                 # set hash or hash_base.
1223                 #
1224                 # Most of the actions without a pathname only want hash to be
1225                 # set, except for the ones specified in @wants_base that want
1226                 # hash_base instead. It should also be noted that hand-crafted
1227                 # links having 'history' as an action and no pathname or hash
1228                 # set will fail, but that happens regardless of PATH_INFO.
1229                 if (defined $parentrefname) {
1230                         # if there is parent let the default be 'shortlog' action
1231                         # (for http://git.example.com/repo.git/A..B links); if there
1232                         # is no parent, dispatch will detect type of object and set
1233                         # action appropriately if required (if action is not set)
1234                         $input_params{'action'} ||= "shortlog";
1235                 }
1236                 if ($input_params{'action'} &&
1237                     grep { $_ eq $input_params{'action'} } @wants_base) {
1238                         $input_params{'hash_base'} ||= $refname;
1239                 } else {
1240                         $input_params{'hash'} ||= $refname;
1241                 }
1242         }
1243
1244         # next, handle the 'parent' part, if present
1245         if (defined $parentrefname) {
1246                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1247                 # someproject/blobdiff/oldrev..newrev:/filename
1248                 if ($parentpathname) {
1249                         $parentpathname =~ s,^/+,,;
1250                         $parentpathname =~ s,/$,,;
1251                         $input_params{'file_parent'} ||= $parentpathname;
1252                 } else {
1253                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1254                 }
1255                 # we assume that hash_parent_base is wanted if a path was specified,
1256                 # or if the action wants hash_base instead of hash
1257                 if (defined $input_params{'file_parent'} ||
1258                         grep { $_ eq $input_params{'action'} } @wants_base) {
1259                         $input_params{'hash_parent_base'} ||= $parentrefname;
1260                 } else {
1261                         $input_params{'hash_parent'} ||= $parentrefname;
1262                 }
1263         }
1264
1265         # for the snapshot action, we allow URLs in the form
1266         # $project/snapshot/$hash.ext
1267         # where .ext determines the snapshot and gets removed from the
1268         # passed $refname to provide the $hash.
1269         #
1270         # To be able to tell that $refname includes the format extension, we
1271         # require the following two conditions to be satisfied:
1272         # - the hash input parameter MUST have been set from the $refname part
1273         #   of the URL (i.e. they must be equal)
1274         # - the snapshot format MUST NOT have been defined already (e.g. from
1275         #   CGI parameter sf)
1276         # It's also useless to try any matching unless $refname has a dot,
1277         # so we check for that too
1278         if (defined $input_params{'action'} &&
1279                 $input_params{'action'} eq 'snapshot' &&
1280                 defined $refname && index($refname, '.') != -1 &&
1281                 $refname eq $input_params{'hash'} &&
1282                 !defined $input_params{'snapshot_format'}) {
1283                 # We loop over the known snapshot formats, checking for
1284                 # extensions. Allowed extensions are both the defined suffix
1285                 # (which includes the initial dot already) and the snapshot
1286                 # format key itself, with a prepended dot
1287                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1288                         my $hash = $refname;
1289                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1290                                 next;
1291                         }
1292                         my $sfx = $1;
1293                         # a valid suffix was found, so set the snapshot format
1294                         # and reset the hash parameter
1295                         $input_params{'snapshot_format'} = $fmt;
1296                         $input_params{'hash'} = $hash;
1297                         # we also set the format suffix to the one requested
1298                         # in the URL: this way a request for e.g. .tgz returns
1299                         # a .tgz instead of a .tar.gz
1300                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1301                         last;
1302                 }
1303         }
1304 }
1305
1306 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1307      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1308      $searchtext, $search_regexp, $project_filter);
1309 sub evaluate_and_validate_params {
1310         our $action = $input_params{'action'};
1311         if (defined $action) {
1312                 if (!is_valid_action($action)) {
1313                         die_error(400, "Invalid action parameter");
1314                 }
1315         }
1316
1317         # parameters which are pathnames
1318         our $project = $input_params{'project'};
1319         if (defined $project) {
1320                 if (!is_valid_project($project)) {
1321                         undef $project;
1322                         die_error(404, "No such project");
1323                 }
1324         }
1325
1326         our $project_filter = $input_params{'project_filter'};
1327         if (defined $project_filter) {
1328                 if (!is_valid_pathname($project_filter)) {
1329                         die_error(404, "Invalid project_filter parameter");
1330                 }
1331         }
1332
1333         our $file_name = $input_params{'file_name'};
1334         if (defined $file_name) {
1335                 if (!is_valid_pathname($file_name)) {
1336                         die_error(400, "Invalid file parameter");
1337                 }
1338         }
1339
1340         our $file_parent = $input_params{'file_parent'};
1341         if (defined $file_parent) {
1342                 if (!is_valid_pathname($file_parent)) {
1343                         die_error(400, "Invalid file parent parameter");
1344                 }
1345         }
1346
1347         # parameters which are refnames
1348         our $hash = $input_params{'hash'};
1349         if (defined $hash) {
1350                 if (!is_valid_refname($hash)) {
1351                         die_error(400, "Invalid hash parameter");
1352                 }
1353         }
1354
1355         our $hash_parent = $input_params{'hash_parent'};
1356         if (defined $hash_parent) {
1357                 if (!is_valid_refname($hash_parent)) {
1358                         die_error(400, "Invalid hash parent parameter");
1359                 }
1360         }
1361
1362         our $hash_base = $input_params{'hash_base'};
1363         if (defined $hash_base) {
1364                 if (!is_valid_refname($hash_base)) {
1365                         die_error(400, "Invalid hash base parameter");
1366                 }
1367         }
1368
1369         our @extra_options = @{$input_params{'extra_options'}};
1370         # @extra_options is always defined, since it can only be (currently) set from
1371         # CGI, and $cgi->param() returns the empty array in array context if the param
1372         # is not set
1373         foreach my $opt (@extra_options) {
1374                 if (not exists $allowed_options{$opt}) {
1375                         die_error(400, "Invalid option parameter");
1376                 }
1377                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1378                         die_error(400, "Invalid option parameter for this action");
1379                 }
1380         }
1381
1382         our $hash_parent_base = $input_params{'hash_parent_base'};
1383         if (defined $hash_parent_base) {
1384                 if (!is_valid_refname($hash_parent_base)) {
1385                         die_error(400, "Invalid hash parent base parameter");
1386                 }
1387         }
1388
1389         # other parameters
1390         our $page = $input_params{'page'};
1391         if (defined $page) {
1392                 if ($page =~ m/[^0-9]/) {
1393                         die_error(400, "Invalid page parameter");
1394                 }
1395         }
1396
1397         our $searchtype = $input_params{'searchtype'};
1398         if (defined $searchtype) {
1399                 if ($searchtype =~ m/[^a-z]/) {
1400                         die_error(400, "Invalid searchtype parameter");
1401                 }
1402         }
1403
1404         our $search_use_regexp = $input_params{'search_use_regexp'};
1405
1406         our $searchtext = $input_params{'searchtext'};
1407         our $search_regexp = undef;
1408         if (defined $searchtext) {
1409                 if (length($searchtext) < 2) {
1410                         die_error(403, "At least two characters are required for search parameter");
1411                 }
1412                 if ($search_use_regexp) {
1413                         $search_regexp = $searchtext;
1414                         if (!eval { qr/$search_regexp/; 1; }) {
1415                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1416                                 die_error(400, "Invalid search regexp '$search_regexp'",
1417                                           esc_html($error));
1418                         }
1419                 } else {
1420                         $search_regexp = quotemeta $searchtext;
1421                 }
1422         }
1423 }
1424
1425 # path to the current git repository
1426 our $git_dir;
1427 sub evaluate_git_dir {
1428         our $git_dir = $project ? "$projectroot/$project" : undef;
1429 }
1430
1431 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1432 sub configure_gitweb_features {
1433         # list of supported snapshot formats
1434         our @snapshot_fmts = gitweb_get_feature('snapshot');
1435         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1436
1437         # check that the avatar feature is set to a known provider name,
1438         # and for each provider check if the dependencies are satisfied.
1439         # if the provider name is invalid or the dependencies are not met,
1440         # reset $git_avatar to the empty string.
1441         our ($git_avatar) = gitweb_get_feature('avatar');
1442         if ($git_avatar eq 'gravatar') {
1443                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1444         } elsif ($git_avatar eq 'picon') {
1445                 # no dependencies
1446         } else {
1447                 $git_avatar = '';
1448         }
1449
1450         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1451         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1452 }
1453
1454 sub get_branch_refs {
1455         return ('heads', @extra_branch_refs);
1456 }
1457
1458 # custom error handler: 'die <message>' is Internal Server Error
1459 sub handle_errors_html {
1460         my $msg = shift; # it is already HTML escaped
1461
1462         # to avoid infinite loop where error occurs in die_error,
1463         # change handler to default handler, disabling handle_errors_html
1464         set_message("Error occurred when inside die_error:\n$msg");
1465
1466         # you cannot jump out of die_error when called as error handler;
1467         # the subroutine set via CGI::Carp::set_message is called _after_
1468         # HTTP headers are already written, so it cannot write them itself
1469         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1470 }
1471 set_message(\&handle_errors_html);
1472
1473 our $shown_stale_message = 0;
1474 our $cache_dump = undef;
1475 our $cache_dump_mtime = undef;
1476
1477 # dispatch
1478 my $cache_mode_active;
1479 sub dispatch {
1480         $shown_stale_message = 0;
1481         if (!defined $action) {
1482                 if (defined $hash) {
1483                         $action = git_get_type($hash);
1484                         $action or die_error(404, "Object does not exist");
1485                 } elsif (defined $hash_base && defined $file_name) {
1486                         $action = git_get_type("$hash_base:$file_name");
1487                         $action or die_error(404, "File or directory does not exist");
1488                 } elsif (defined $project) {
1489                         $action = 'summary';
1490                 } else {
1491                         $action = 'frontpage';
1492                 }
1493         }
1494         if (!defined($actions{$action})) {
1495                 die_error(400, "Unknown action");
1496         }
1497         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1498             !$project) {
1499                 die_error(400, "Project needed");
1500         }
1501
1502         my $cached_page = $supported_cache_actions{$action}
1503                 ? cached_action_page($action)
1504                 : undef;
1505         goto DUMPCACHE if $cached_page;
1506         local *SAVEOUT = *STDOUT;
1507         $cache_mode_active = $supported_cache_actions{$action}
1508                 ? cached_action_start($action)
1509                 : undef;
1510
1511         configure_gitweb_features();
1512         $actions{$action}->();
1513
1514         return unless $cache_mode_active;
1515
1516         $cached_page = cached_action_finish($action);
1517         *STDOUT = *SAVEOUT;
1518
1519         DUMPCACHE:
1520
1521         $cache_mode_active = 0;
1522         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1523         binmode STDOUT, ':raw';
1524         our $fcgi_raw_mode = 1;
1525         print expand_gitweb_pi($cached_page, time);
1526         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1527         $fcgi_raw_mode = 0;
1528 }
1529
1530 sub reset_timer {
1531         our $t0 = [ gettimeofday() ]
1532                 if defined $t0;
1533         our $number_of_git_cmds = 0;
1534 }
1535
1536 our $first_request = 1;
1537 our $evaluate_uri_force = undef;
1538 sub run_request {
1539         reset_timer();
1540
1541         # do not reuse stale config or project list from prior FCGI request
1542         our $config_file = '';
1543         our $gitweb_project_owner = undef;
1544
1545         # Only allow GET and HEAD methods
1546         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1547                 print <<EOT;
1548 Status: 405 Method Not Allowed
1549 Content-Type: text/plain
1550 Allow: GET,HEAD
1551
1552 405 Method Not Allowed
1553 EOT
1554                 return;
1555         }
1556
1557         evaluate_uri();
1558         &$evaluate_uri_force() if $evaluate_uri_force;
1559         if ($per_request_config) {
1560                 if (ref($per_request_config) eq 'CODE') {
1561                         $per_request_config->();
1562                 } elsif (!$first_request) {
1563                         evaluate_gitweb_config();
1564                         evaluate_email_obfuscate();
1565                 }
1566         }
1567         check_loadavg();
1568
1569         # $projectroot and $projects_list might be set in gitweb config file
1570         $projects_list ||= $projectroot;
1571
1572         evaluate_query_params();
1573         evaluate_path_info();
1574         evaluate_and_validate_params();
1575         evaluate_git_dir();
1576
1577         dispatch();
1578 }
1579
1580 our $is_last_request = sub { 1 };
1581 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1582 our $CGI = 'CGI';
1583 our $cgi;
1584 our $fcgi_mode = 0;
1585 our $fcgi_nproc_active = 0;
1586 our $fcgi_raw_mode = 0;
1587 sub is_fcgi {
1588         use Errno;
1589         my $stdinfno = fileno STDIN;
1590         return 0 unless defined $stdinfno && $stdinfno == 0;
1591         return 0 unless getsockname STDIN;
1592         return 0 if getpeername STDIN;
1593         return $!{ENOTCONN}?1:0;
1594 }
1595 sub configure_as_fcgi {
1596         return if $fcgi_mode;
1597
1598         require FCGI;
1599         require CGI::Fast;
1600
1601         # We have gone to great effort to make sure that all incoming data has
1602         # been converted from whatever format it was in into UTF-8.  We have
1603         # even taken care to make sure the output handle is in ':utf8' mode.
1604         # Now along comes FCGI and blows it with:
1605         #
1606         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1607         #      and will stop wprking[sic] in a future version of FCGI
1608         #
1609         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1610         # first encodes everything and then calls the original routine, but
1611         # not if $fcgi_raw_mode is true (then we just call the original routine).
1612         #
1613         # Note that we could do this by using utf8::is_utf8 to check instead
1614         # of having a $fcgi_raw_mode global, but that would be slower to run
1615         # the test on each element and much slower than skipping the conversion
1616         # entirely when we know we're outputting raw bytes.
1617         my $orig = \&FCGI::Stream::PRINT;
1618         undef *FCGI::Stream::PRINT;
1619         *FCGI::Stream::PRINT = sub {
1620                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1621                         unless $fcgi_raw_mode;
1622                 goto $orig;
1623         };
1624
1625         our $CGI = 'CGI::Fast';
1626
1627         $fcgi_mode = 1;
1628         $first_request = 0;
1629         my $request_number = 0;
1630         # let each child service 100 requests
1631         our $is_last_request = sub { ++$request_number > 100 };
1632 }
1633 sub evaluate_argv {
1634         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1635         configure_as_fcgi()
1636                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1637
1638         my $nproc_sub = sub {
1639                 my ($arg, $val) = @_;
1640                 return unless eval { require FCGI::ProcManager; 1; };
1641                 $fcgi_nproc_active = 1;
1642                 my $proc_manager = FCGI::ProcManager->new({
1643                         n_processes => $val,
1644                 });
1645                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1646                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1647                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1648         };
1649         if (@ARGV) {
1650                 require Getopt::Long;
1651                 Getopt::Long::GetOptions(
1652                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1653                         'nproc|n=i' => $nproc_sub,
1654                 );
1655         };
1656         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1657                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1658         }
1659 }
1660
1661 sub run {
1662         evaluate_gitweb_config();
1663         evaluate_encoding();
1664         evaluate_email_obfuscate();
1665         evaluate_git_version();
1666         my ($mu, $hl, $subroutine) = ($my_uri, $home_link, '');
1667         $subroutine .= '$my_uri = $mu;' if defined $my_uri && $my_uri ne '';
1668         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1669         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1670         $first_request = 1;
1671         evaluate_argv();
1672
1673         $pre_listen_hook->()
1674                 if $pre_listen_hook;
1675
1676  REQUEST:
1677         while ($cgi = $CGI->new()) {
1678                 $pre_dispatch_hook->()
1679                         if $pre_dispatch_hook;
1680
1681                 run_request();
1682
1683                 $post_dispatch_hook->()
1684                         if $post_dispatch_hook;
1685                 $first_request = 0;
1686
1687                 last REQUEST if ($is_last_request->());
1688         }
1689
1690  DONE_GITWEB:
1691         1;
1692 }
1693
1694 run();
1695
1696 if (defined caller) {
1697         # wrapped in a subroutine processing requests,
1698         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1699         return;
1700 } else {
1701         # pure CGI script, serving single request
1702         exit;
1703 }
1704
1705 ## ======================================================================
1706 ## action links
1707
1708 # possible values of extra options
1709 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1710 # -replay => 1      - start from a current view (replay with modifications)
1711 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1712 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1713 sub href {
1714         my %params = @_;
1715         # default is to use -absolute url() i.e. $my_uri
1716         my $href = $params{-full} ? $my_url : $my_uri;
1717
1718         # implicit -replay, must be first of implicit params
1719         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1720
1721         $params{'project'} = $project unless exists $params{'project'};
1722
1723         if ($params{-replay}) {
1724                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1725                         if (!exists $params{$name}) {
1726                                 $params{$name} = $input_params{$name};
1727                         }
1728                 }
1729         }
1730
1731         my $use_pathinfo = gitweb_check_feature('pathinfo');
1732         if (defined $params{'project'} &&
1733             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1734                 # try to put as many parameters as possible in PATH_INFO:
1735                 #   - project name
1736                 #   - action
1737                 #   - hash_parent or hash_parent_base:/file_parent
1738                 #   - hash or hash_base:/filename
1739                 #   - the snapshot_format as an appropriate suffix
1740
1741                 # When the script is the root DirectoryIndex for the domain,
1742                 # $href here would be something like http://gitweb.example.com/
1743                 # Thus, we strip any trailing / from $href, to spare us double
1744                 # slashes in the final URL
1745                 $href =~ s,/$,,;
1746
1747                 # Then add the project name, if present
1748                 $href .= "/".esc_path_info($params{'project'});
1749                 delete $params{'project'};
1750
1751                 # since we destructively absorb parameters, we keep this
1752                 # boolean that remembers if we're handling a snapshot
1753                 my $is_snapshot = $params{'action'} eq 'snapshot';
1754
1755                 # Summary just uses the project path URL, any other action is
1756                 # added to the URL
1757                 if (defined $params{'action'}) {
1758                         $href .= "/".esc_path_info($params{'action'})
1759                                 unless $params{'action'} eq 'summary';
1760                         delete $params{'action'};
1761                 }
1762
1763                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1764                 # stripping nonexistent or useless pieces
1765                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1766                         || $params{'hash_parent'} || $params{'hash'});
1767                 if (defined $params{'hash_base'}) {
1768                         if (defined $params{'hash_parent_base'}) {
1769                                 $href .= esc_path_info($params{'hash_parent_base'});
1770                                 # skip the file_parent if it's the same as the file_name
1771                                 if (defined $params{'file_parent'}) {
1772                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1773                                                 delete $params{'file_parent'};
1774                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1775                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1776                                                 delete $params{'file_parent'};
1777                                         }
1778                                 }
1779                                 $href .= "..";
1780                                 delete $params{'hash_parent'};
1781                                 delete $params{'hash_parent_base'};
1782                         } elsif (defined $params{'hash_parent'}) {
1783                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1784                                 delete $params{'hash_parent'};
1785                         }
1786
1787                         $href .= esc_path_info($params{'hash_base'});
1788                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1789                                 $href .= ":/".esc_path_info($params{'file_name'});
1790                                 delete $params{'file_name'};
1791                         }
1792                         delete $params{'hash'};
1793                         delete $params{'hash_base'};
1794                 } elsif (defined $params{'hash'}) {
1795                         $href .= esc_path_info($params{'hash'});
1796                         delete $params{'hash'};
1797                 }
1798
1799                 # If the action was a snapshot, we can absorb the
1800                 # snapshot_format parameter too
1801                 if ($is_snapshot) {
1802                         my $fmt = $params{'snapshot_format'};
1803                         # snapshot_format should always be defined when href()
1804                         # is called, but just in case some code forgets, we
1805                         # fall back to the default
1806                         $fmt ||= $snapshot_fmts[0];
1807                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1808                         delete $params{'snapshot_format'};
1809                 }
1810         }
1811
1812         # now encode the parameters explicitly
1813         my @result = ();
1814         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1815                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1816                 if (defined $params{$name}) {
1817                         if (ref($params{$name}) eq "ARRAY") {
1818                                 foreach my $par (@{$params{$name}}) {
1819                                         push @result, $symbol . "=" . esc_param($par);
1820                                 }
1821                         } else {
1822                                 push @result, $symbol . "=" . esc_param($params{$name});
1823                         }
1824                 }
1825         }
1826         $href .= "?" . join(';', @result) if scalar @result;
1827
1828         # final transformation: trailing spaces must be escaped (URI-encoded)
1829         $href =~ s/(\s+)$/CGI::escape($1)/e;
1830
1831         if ($params{-anchor}) {
1832                 $href .= "#".esc_param($params{-anchor});
1833         }
1834
1835         return $href;
1836 }
1837
1838
1839 ## ======================================================================
1840 ## validation, quoting/unquoting and escaping
1841
1842 sub is_valid_action {
1843         my $input = shift;
1844         return undef unless exists $actions{$input};
1845         return 1;
1846 }
1847
1848 sub is_valid_project {
1849         my $input = shift;
1850
1851         return unless defined $input;
1852         if (!is_valid_pathname($input) ||
1853                 !(-d "$projectroot/$input") ||
1854                 !check_export_ok("$projectroot/$input") ||
1855                 ($strict_export && !project_in_list($input))) {
1856                 return undef;
1857         } else {
1858                 return 1;
1859         }
1860 }
1861
1862 sub is_valid_pathname {
1863         my $input = shift;
1864
1865         return undef unless defined $input;
1866         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1867         # at the beginning, at the end, and between slashes.
1868         # also this catches doubled slashes
1869         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1870                 return undef;
1871         }
1872         # no null characters
1873         if ($input =~ m!\0!) {
1874                 return undef;
1875         }
1876         return 1;
1877 }
1878
1879 sub is_valid_ref_format {
1880         my $input = shift;
1881
1882         return undef unless defined $input;
1883         # restrictions on ref name according to git-check-ref-format
1884         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1885                 return undef;
1886         }
1887         return 1;
1888 }
1889
1890 sub is_valid_refname {
1891         my $input = shift;
1892
1893         return undef unless defined $input;
1894         # textual hashes are O.K.
1895         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1896                 return 1;
1897         }
1898         # it must be correct pathname
1899         is_valid_pathname($input) or return undef;
1900         # check git-check-ref-format restrictions
1901         is_valid_ref_format($input) or return undef;
1902         return 1;
1903 }
1904
1905 # decode sequences of octets in utf8 into Perl's internal form,
1906 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1907 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1908 sub to_utf8 {
1909         my $str = shift;
1910         return undef unless defined $str;
1911
1912         if (utf8::is_utf8($str) || utf8::decode($str)) {
1913                 return $str;
1914         } else {
1915                 return $encode_object->decode($str, Encode::FB_DEFAULT);
1916         }
1917 }
1918
1919 # quote unsafe chars, but keep the slash, even when it's not
1920 # correct, but quoted slashes look too horrible in bookmarks
1921 sub esc_param {
1922         my $str = shift;
1923         return undef unless defined $str;
1924         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1925         $str =~ s/ /\+/g;
1926         return $str;
1927 }
1928
1929 # the quoting rules for path_info fragment are slightly different
1930 sub esc_path_info {
1931         my $str = shift;
1932         return undef unless defined $str;
1933
1934         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1935         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1936
1937         return $str;
1938 }
1939
1940 # quote unsafe chars in whole URL, so some characters cannot be quoted
1941 sub esc_url {
1942         my $str = shift;
1943         return undef unless defined $str;
1944         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1945         $str =~ s/ /\+/g;
1946         return $str;
1947 }
1948
1949 # quote unsafe characters in HTML attributes
1950 sub esc_attr {
1951
1952         # for XHTML conformance escaping '"' to '&quot;' is not enough
1953         return esc_html(@_);
1954 }
1955
1956 # replace invalid utf8 character with SUBSTITUTION sequence
1957 sub esc_html {
1958         my $str = shift;
1959         my %opts = @_;
1960
1961         return undef unless defined $str;
1962
1963         $str = to_utf8($str);
1964         $str = $cgi->escapeHTML($str);
1965         if ($opts{'-nbsp'}) {
1966                 $str =~ s/ /&#160;/g;
1967         }
1968         use bytes;
1969         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
1970         return $str;
1971 }
1972
1973 # quote control characters and escape filename to HTML
1974 sub esc_path {
1975         my $str = shift;
1976         my %opts = @_;
1977
1978         return undef unless defined $str;
1979
1980         $str = to_utf8($str);
1981         $str = $cgi->escapeHTML($str);
1982         if ($opts{'-nbsp'}) {
1983                 $str =~ s/ /&#160;/g;
1984         }
1985         use bytes;
1986         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
1987         return $str;
1988 }
1989
1990 # Sanitize for use in XHTML + application/xml+xhtm (valid XML 1.0)
1991 sub sanitize {
1992         my $str = shift;
1993
1994         return undef unless defined $str;
1995
1996         $str = to_utf8($str);
1997         use bytes;
1998         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
1999         return $str;
2000 }
2001
2002 # Make control characters "printable", using character escape codes (CEC)
2003 sub quot_cec {
2004         my $cntrl = shift;
2005         my %opts = @_;
2006         my %es = ( # character escape codes, aka escape sequences
2007                 "\t" => '\t',   # tab            (HT)
2008                 "\n" => '\n',   # line feed      (LF)
2009                 "\r" => '\r',   # carrige return (CR)
2010                 "\f" => '\f',   # form feed      (FF)
2011                 "\b" => '\b',   # backspace      (BS)
2012                 "\a" => '\a',   # alarm (bell)   (BEL)
2013                 "\e" => '\e',   # escape         (ESC)
2014                 "\013" => '\v', # vertical tab   (VT)
2015                 "\000" => '\0', # nul character  (NUL)
2016         );
2017         my $chr = ( (exists $es{$cntrl})
2018                     ? $es{$cntrl}
2019                     : sprintf('\x%02x', ord($cntrl)) );
2020         if ($opts{-nohtml}) {
2021                 return $chr;
2022         } else {
2023                 return "<span class=\"cntrl\">$chr</span>";
2024         }
2025 }
2026
2027 # Alternatively use unicode control pictures codepoints,
2028 # Unicode "printable representation" (PR)
2029 sub quot_upr {
2030         my $cntrl = shift;
2031         my %opts = @_;
2032
2033         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2034         if ($opts{-nohtml}) {
2035                 return $chr;
2036         } else {
2037                 return "<span class=\"cntrl\">$chr</span>";
2038         }
2039 }
2040
2041 # git may return quoted and escaped filenames
2042 sub unquote {
2043         my $str = shift;
2044
2045         sub unq {
2046                 my $seq = shift;
2047                 my %es = ( # character escape codes, aka escape sequences
2048                         't' => "\t",   # tab            (HT, TAB)
2049                         'n' => "\n",   # newline        (NL)
2050                         'r' => "\r",   # return         (CR)
2051                         'f' => "\f",   # form feed      (FF)
2052                         'b' => "\b",   # backspace      (BS)
2053                         'a' => "\a",   # alarm (bell)   (BEL)
2054                         'e' => "\e",   # escape         (ESC)
2055                         'v' => "\013", # vertical tab   (VT)
2056                 );
2057
2058                 if ($seq =~ m/^[0-7]{1,3}$/) {
2059                         # octal char sequence
2060                         return chr(oct($seq));
2061                 } elsif (exists $es{$seq}) {
2062                         # C escape sequence, aka character escape code
2063                         return $es{$seq};
2064                 }
2065                 # quoted ordinary character
2066                 return $seq;
2067         }
2068
2069         if ($str =~ m/^"(.*)"$/) {
2070                 # needs unquoting
2071                 $str = $1;
2072                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2073         }
2074         return $str;
2075 }
2076
2077 # escape tabs (convert tabs to spaces)
2078 sub untabify {
2079         my $line = shift;
2080
2081         while ((my $pos = index($line, "\t")) != -1) {
2082                 if (my $count = (8 - ($pos % 8))) {
2083                         my $spaces = ' ' x $count;
2084                         $line =~ s/\t/$spaces/;
2085                 }
2086         }
2087
2088         return $line;
2089 }
2090
2091 sub project_in_list {
2092         my $project = shift;
2093         my @list = git_get_projects_list();
2094         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2095 }
2096
2097 sub cached_page_precondition_check {
2098         my $action = shift;
2099         return 1 unless
2100                 $action eq 'summary' &&
2101                 $projlist_cache_lifetime > 0 &&
2102                 gitweb_check_feature('forks');
2103
2104         # Note that ALL the 'forkchange' logic is in this function.
2105         # It does NOT belong in cached_action_page NOR in cached_action_start
2106         # NOR in cached_action_finish.  None of those functions should know anything
2107         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2108
2109         # besides the basic 'changed' "$action.changed" check, we may only use
2110         # a summary cache if:
2111         #
2112         #   1) we are not using a project list cache file
2113         #   -OR-
2114         #   2) we are not using the 'forks' feature
2115         #   -OR-
2116         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2117         #   -OR-
2118         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2119         #   -OR-
2120         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2121         #
2122         # Otherwise we must re-generate the cache because we've had a fork change
2123         # (either a fork was added or a fork was removed) AND the change has been
2124         # picked up in the cache file AND we've not got that in our cached copy
2125         #
2126         # For (5) regenerating the cached page wouldn't get us anything if the project
2127         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2128         # forks information comes from the project cache file and it's clearly not
2129         # picked up the changes yet so we may continue to use a cached page until it does.
2130
2131         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2132         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2133         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2134         return 1 unless defined($fc_mt) || defined($afc_mt);
2135         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2136         return 1 unless $prj_mt;
2137         my $old_mt = $fc_mt;
2138         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2139         return 1 if $old_mt > $prj_mt;
2140
2141         # We're going to regenerate the cached page because we know the project cache
2142         # has new fork information that we cannot possibly have in our cached copy.
2143         #
2144         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2145         # them is older than the project cache and one of them is newer, we still
2146         # need to regenerate the page cache, but we will also need to do it again
2147         # in the future because there's yet another fork update not yet in the cache.
2148         #
2149         # So we make sure to touch "$action.changed" to force a cache regeneration
2150         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2151         # they're older than the project cache (they've served their purpose, we're
2152         # forcing a page regeneration by touching "$action.changed" but the project
2153         # cache was rebuilt since then so there are no more pending fork updates to
2154         # pick up in the future and they need to go).
2155
2156         # For best results, the external code that touches 'forkchange' should always
2157         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2158         # if it does not already exist.  That way the cached page will be regenerated
2159         # each time it's requested and ANY fork updates are available in the proj
2160         # cache rather than waiting until they all are before updating.
2161
2162         # Note that we take a shortcut here and will zap 'forkchange' since we know
2163         # that it only affects the 'summary' cache.  If, in the future, it affects
2164         # other cache types, it will first need to be propogated down to
2165         # "$action.forkchange" for those types before we zap it.
2166
2167         my $fd;
2168         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2169         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2170         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2171
2172         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2173         # one and not the other.
2174
2175         if (defined $fc_mt && ! defined $afc_mt) {
2176                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2177                 -e "$htmlcd/$action.forkchange" and
2178                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2179                 unlink "$htmlcd/forkchange";
2180         }
2181
2182         return 0;
2183 }
2184
2185 sub cached_action_page {
2186         my $action = shift;
2187
2188         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2189         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2190         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2191         return undef unless cached_page_precondition_check($action);
2192         open my $fd, '<', "$htmlcd/$action" or return undef;
2193         binmode $fd;
2194         local $/;
2195         my $cached_page = <$fd>;
2196         close $fd or return undef;
2197         return $cached_page;
2198 }
2199
2200 package Git::Gitweb::CacheFile;
2201
2202 sub TIEHANDLE {
2203         use POSIX qw(:fcntl_h);
2204         my $class = shift;
2205         my $cachefile = shift;
2206
2207         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2208                 or return undef;
2209         $$self->{'cachefile'} = $cachefile;
2210         $$self->{'opened'} = 1;
2211         $$self->{'contents'} = '';
2212         return bless $self, $class;
2213 }
2214
2215 sub CLOSE {
2216         my $self = shift;
2217         if ($$self->{'opened'}) {
2218                 $$self->{'opened'} = 0;
2219                 my $result = close $self;
2220                 unlink $$self->{'cachefile'} unless $result;
2221                 return $result;
2222         }
2223         return 0;
2224 }
2225
2226 sub DESTROY {
2227         my $self = shift;
2228         if ($$self->{'opened'}) {
2229                 $self->CLOSE() and unlink $$self->{'cachefile'};
2230         }
2231 }
2232
2233 sub PRINT {
2234         my $self = shift;
2235         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2236         print $self @_ if $$self->{'opened'};
2237         $$self->{'contents'} .= join('', @_);
2238         return 1;
2239 }
2240
2241 sub PRINTF {
2242         my $self = shift;
2243         my $template = shift;
2244         return $self->PRINT(sprintf $template, @_);
2245 }
2246
2247 sub contents {
2248         my $self = shift;
2249         return $$self->{'contents'};
2250 }
2251
2252 package main;
2253
2254 # Caller is responsible for preserving STDOUT beforehand if needed
2255 sub cached_action_start {
2256         my $action = shift;
2257
2258         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2259         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2260         return undef unless -d $htmlcd;
2261         if (-e "$htmlcd/changed") {
2262                 foreach my $cacheable (keys(%html_cache_actions)) {
2263                         next unless $supported_cache_actions{$cacheable} &&
2264                                     $html_cache_actions{$cacheable};
2265                         my $fd;
2266                         open $fd, '>', "$htmlcd/$cacheable.changed"
2267                         and close $fd;
2268                 }
2269                 unlink "$htmlcd/changed";
2270         }
2271         local *CACHEFILE;
2272         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2273         *STDOUT = *CACHEFILE;
2274         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2275         return 1;
2276 }
2277
2278 # Caller is responsible for restoring STDOUT afterward if needed
2279 sub cached_action_finish {
2280         my $action = shift;
2281
2282         use File::Spec;
2283
2284         my $obj = tied *STDOUT;
2285         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2286         my $cached_page = $obj->contents;
2287         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2288         # Do not leave STDOUT file descriptor invalid!
2289         local *NULL;
2290         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2291         *STDOUT = *NULL;
2292         return $cached_page unless $result;
2293         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2294         return $cached_page unless -d $htmlcd;
2295         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2296         return $cached_page;
2297 }
2298
2299 my %expand_pi_subs;
2300 BEGIN {%expand_pi_subs = (
2301         'age_string'              => \&age_string,
2302         'age_string_date'         => \&age_string_date,
2303         'age_string_age'          => \&age_string_age,
2304         'compute_timed_interval'  => \&compute_timed_interval,
2305         'compute_commands_count'  => \&compute_commands_count,
2306         'format_lastrefresh_row'  => \&format_lastrefresh_row,
2307 )}
2308
2309 # Expands any <?gitweb...> processing instructions and returns the result
2310 sub expand_gitweb_pi {
2311         my $page = shift;
2312         $page .= '';
2313         my @time_now = gettimeofday();
2314         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2315                   {defined($1) ?
2316                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2317                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2318                                   '') :
2319                           '' }goes;
2320         return $page;
2321 }
2322
2323 ## ----------------------------------------------------------------------
2324 ## HTML aware string manipulation
2325
2326 # Try to chop given string on a word boundary between position
2327 # $len and $len+$add_len. If there is no word boundary there,
2328 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2329 # (marking chopped part) would be longer than given string.
2330 sub chop_str {
2331         my $str = shift;
2332         my $len = shift;
2333         my $add_len = shift || 10;
2334         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2335
2336         # Make sure perl knows it is utf8 encoded so we don't
2337         # cut in the middle of a utf8 multibyte char.
2338         $str = to_utf8($str);
2339
2340         # allow only $len chars, but don't cut a word if it would fit in $add_len
2341         # if it doesn't fit, cut it if it's still longer than the dots we would add
2342         # remove chopped character entities entirely
2343
2344         # when chopping in the middle, distribute $len into left and right part
2345         # return early if chopping wouldn't make string shorter
2346         if ($where eq 'center') {
2347                 return $str if ($len + 5 >= length($str)); # filler is length 5
2348                 $len = int($len/2);
2349         } else {
2350                 return $str if ($len + 4 >= length($str)); # filler is length 4
2351         }
2352
2353         # regexps: ending and beginning with word part up to $add_len
2354         my $endre = qr/.{$len}\w{0,$add_len}/;
2355         my $begre = qr/\w{0,$add_len}.{$len}/;
2356
2357         if ($where eq 'left') {
2358                 $str =~ m/^(.*?)($begre)$/;
2359                 my ($lead, $body) = ($1, $2);
2360                 if (length($lead) > 4) {
2361                         $lead = " ...";
2362                 }
2363                 return "$lead$body";
2364
2365         } elsif ($where eq 'center') {
2366                 $str =~ m/^($endre)(.*)$/;
2367                 my ($left, $str)  = ($1, $2);
2368                 $str =~ m/^(.*?)($begre)$/;
2369                 my ($mid, $right) = ($1, $2);
2370                 if (length($mid) > 5) {
2371                         $mid = " ... ";
2372                 }
2373                 return "$left$mid$right";
2374
2375         } else {
2376                 $str =~ m/^($endre)(.*)$/;
2377                 my $body = $1;
2378                 my $tail = $2;
2379                 if (length($tail) > 4) {
2380                         $tail = "... ";
2381                 }
2382                 return "$body$tail";
2383         }
2384 }
2385
2386 # pass-through email filter, obfuscating it when possible
2387 sub email_obfuscate {
2388         our $email;
2389         my ($str) = @_;
2390         if ($email) {
2391                 $str = $email->escape_html($str);
2392                 # Stock HTML::Email::Obfuscate version likes to produce
2393                 # invalid XHTML...
2394                 $str =~ s#<(/?)B>#<$1b>#g;
2395                 return $str;
2396         } else {
2397                 $str = esc_html($str);
2398                 $str =~ s/@/&#x40;/;
2399                 return $str;
2400         }
2401 }
2402
2403 # takes the same arguments as chop_str, but also wraps a <span> around the
2404 # result with a title attribute if it does get chopped. Additionally, the
2405 # string is HTML-escaped.
2406 sub chop_and_escape_str {
2407         my ($str) = @_;
2408
2409         my $chopped = chop_str(@_);
2410         $str = to_utf8($str);
2411         if ($chopped eq $str) {
2412                 return email_obfuscate($chopped);
2413         } else {
2414                 use bytes;
2415                 $str =~ s/[[:cntrl:]]/?/g;
2416                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2417         }
2418 }
2419
2420 # Highlight selected fragments of string, using given CSS class,
2421 # and escape HTML.  It is assumed that fragments do not overlap.
2422 # Regions are passed as list of pairs (array references).
2423 #
2424 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2425 # '<span class="mark">foo</span>bar'
2426 sub esc_html_hl_regions {
2427         my ($str, $css_class, @sel) = @_;
2428         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2429         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2430         return esc_html($str, %opts) unless @sel;
2431
2432         my $out = '';
2433         my $pos = 0;
2434
2435         for my $s (@sel) {
2436                 my ($begin, $end) = @$s;
2437
2438                 # Don't create empty <span> elements.
2439                 next if $end <= $begin;
2440
2441                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2442                                        %opts);
2443
2444                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2445                         if ($begin - $pos > 0);
2446                 $out .= $cgi->span({-class => $css_class}, $escaped);
2447
2448                 $pos = $end;
2449         }
2450         $out .= esc_html(substr($str, $pos), %opts)
2451                 if ($pos < length($str));
2452
2453         return $out;
2454 }
2455
2456 # return positions of beginning and end of each match
2457 sub matchpos_list {
2458         my ($str, $regexp) = @_;
2459         return unless (defined $str && defined $regexp);
2460
2461         my @matches;
2462         while ($str =~ /$regexp/g) {
2463                 push @matches, [$-[0], $+[0]];
2464         }
2465         return @matches;
2466 }
2467
2468 # highlight match (if any), and escape HTML
2469 sub esc_html_match_hl {
2470         my ($str, $regexp) = @_;
2471         return esc_html($str) unless defined $regexp;
2472
2473         my @matches = matchpos_list($str, $regexp);
2474         return esc_html($str) unless @matches;
2475
2476         return esc_html_hl_regions($str, 'match', @matches);
2477 }
2478
2479
2480 # highlight match (if any) of shortened string, and escape HTML
2481 sub esc_html_match_hl_chopped {
2482         my ($str, $chopped, $regexp) = @_;
2483         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2484
2485         my @matches = matchpos_list($str, $regexp);
2486         return esc_html($chopped) unless @matches;
2487
2488         # filter matches so that we mark chopped string
2489         my $tail = "... "; # see chop_str
2490         unless ($chopped =~ s/\Q$tail\E$//) {
2491                 $tail = '';
2492         }
2493         my $chop_len = length($chopped);
2494         my $tail_len = length($tail);
2495         my @filtered;
2496
2497         for my $m (@matches) {
2498                 if ($m->[0] > $chop_len) {
2499                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2500                         last;
2501                 } elsif ($m->[1] > $chop_len) {
2502                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2503                         last;
2504                 }
2505                 push @filtered, $m;
2506         }
2507
2508         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2509 }
2510
2511 ## ----------------------------------------------------------------------
2512 ## functions returning short strings
2513
2514 # CSS class for given age epoch value (in seconds)
2515 # and reference time (optional, defaults to now) as second value
2516 sub age_class {
2517         my ($age_epoch, $time_now) = @_;
2518         return "noage" unless defined $age_epoch;
2519         defined $time_now or $time_now = time;
2520         my $age = $time_now - $age_epoch;
2521
2522         if ($age < 60*60*2) {
2523                 return "age0";
2524         } elsif ($age < 60*60*24*2) {
2525                 return "age1";
2526         } else {
2527                 return "age2";
2528         }
2529 }
2530
2531 # convert age epoch in seconds to "nn units ago" string
2532 # reference time used is now unless second argument passed in
2533 # to get the old behavior, pass 0 as the first argument and
2534 # the time in seconds as the second
2535 sub age_string {
2536         my ($age_epoch, $time_now) = @_;
2537         return "unknown" unless defined $age_epoch;
2538         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2539         defined $time_now or $time_now = time;
2540         my $age = $time_now - $age_epoch;
2541         my $age_str;
2542
2543         if ($age > 60*60*24*365*2) {
2544                 $age_str = (int $age/60/60/24/365);
2545                 $age_str .= " years ago";
2546         } elsif ($age > 60*60*24*(365/12)*2) {
2547                 $age_str = int $age/60/60/24/(365/12);
2548                 $age_str .= " months ago";
2549         } elsif ($age > 60*60*24*7*2) {
2550                 $age_str = int $age/60/60/24/7;
2551                 $age_str .= " weeks ago";
2552         } elsif ($age > 60*60*24*2) {
2553                 $age_str = int $age/60/60/24;
2554                 $age_str .= " days ago";
2555         } elsif ($age > 60*60*2) {
2556                 $age_str = int $age/60/60;
2557                 $age_str .= " hours ago";
2558         } elsif ($age > 60*2) {
2559                 $age_str = int $age/60;
2560                 $age_str .= " min ago";
2561         } elsif ($age > 2) {
2562                 $age_str = int $age;
2563                 $age_str .= " sec ago";
2564         } else {
2565                 $age_str .= " right now";
2566         }
2567         return $age_str;
2568 }
2569
2570 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2571 # this is typically shown to the user directly with the age_string_age as a title
2572 sub age_string_date {
2573         my ($age_epoch, $time_now) = @_;
2574         return "unknown" unless defined $age_epoch;
2575         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2576         defined $time_now or $time_now = time;
2577         my $age = $time_now - $age_epoch;
2578
2579         if ($age > 60*60*24*7*2) {
2580                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2581                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2582         } else {
2583                 return age_string($age_epoch, $time_now);
2584         }
2585 }
2586
2587 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2588 # this is typically used for the 'title' attribute so it will show as a tooltip
2589 sub age_string_age {
2590         my ($age_epoch, $time_now) = @_;
2591         return "unknown" unless defined $age_epoch;
2592         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2593         defined $time_now or $time_now = time;
2594         my $age = $time_now - $age_epoch;
2595
2596         if ($age > 60*60*24*7*2) {
2597                 return age_string($age_epoch, $time_now);
2598         } else {
2599                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2600                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2601         }
2602 }
2603
2604 use constant {
2605         S_IFINVALID => 0030000,
2606         S_IFGITLINK => 0160000,
2607 };
2608
2609 # submodule/subproject, a commit object reference
2610 sub S_ISGITLINK {
2611         my $mode = shift;
2612
2613         return (($mode & S_IFMT) == S_IFGITLINK)
2614 }
2615
2616 # convert file mode in octal to symbolic file mode string
2617 sub mode_str {
2618         my $mode = oct shift;
2619
2620         if (S_ISGITLINK($mode)) {
2621                 return 'm---------';
2622         } elsif (S_ISDIR($mode & S_IFMT)) {
2623                 return 'drwxr-xr-x';
2624         } elsif (S_ISLNK($mode)) {
2625                 return 'lrwxrwxrwx';
2626         } elsif (S_ISREG($mode)) {
2627                 # git cares only about the executable bit
2628                 if ($mode & S_IXUSR) {
2629                         return '-rwxr-xr-x';
2630                 } else {
2631                         return '-rw-r--r--';
2632                 };
2633         } else {
2634                 return '----------';
2635         }
2636 }
2637
2638 # convert file mode in octal to file type string
2639 sub file_type {
2640         my $mode = shift;
2641
2642         if ($mode !~ m/^[0-7]+$/) {
2643                 return $mode;
2644         } else {
2645                 $mode = oct $mode;
2646         }
2647
2648         if (S_ISGITLINK($mode)) {
2649                 return "submodule";
2650         } elsif (S_ISDIR($mode & S_IFMT)) {
2651                 return "directory";
2652         } elsif (S_ISLNK($mode)) {
2653                 return "symlink";
2654         } elsif (S_ISREG($mode)) {
2655                 return "file";
2656         } else {
2657                 return "unknown";
2658         }
2659 }
2660
2661 # convert file mode in octal to file type description string
2662 sub file_type_long {
2663         my $mode = shift;
2664
2665         if ($mode !~ m/^[0-7]+$/) {
2666                 return $mode;
2667         } else {
2668                 $mode = oct $mode;
2669         }
2670
2671         if (S_ISGITLINK($mode)) {
2672                 return "submodule";
2673         } elsif (S_ISDIR($mode & S_IFMT)) {
2674                 return "directory";
2675         } elsif (S_ISLNK($mode)) {
2676                 return "symlink";
2677         } elsif (S_ISREG($mode)) {
2678                 if ($mode & S_IXUSR) {
2679                         return "executable";
2680                 } else {
2681                         return "file";
2682                 };
2683         } else {
2684                 return "unknown";
2685         }
2686 }
2687
2688
2689 ## ----------------------------------------------------------------------
2690 ## functions returning short HTML fragments, or transforming HTML fragments
2691 ## which don't belong to other sections
2692
2693 # format line of commit message.
2694 sub format_log_line_html {
2695         my $line = shift;
2696
2697         $line = esc_html($line, -nbsp=>1);
2698         $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
2699                 $cgi->a({-href => href(action=>"object", hash=>$1),
2700                                         -class => "text"}, $1);
2701         }eg unless $line =~ /^\s*git-svn-id:/;
2702
2703         return $line;
2704 }
2705
2706 # format marker of refs pointing to given object
2707
2708 # the destination action is chosen based on object type and current context:
2709 # - for annotated tags, we choose the tag view unless it's the current view
2710 #   already, in which case we go to shortlog view
2711 # - for other refs, we keep the current view if we're in history, shortlog or
2712 #   log view, and select shortlog otherwise
2713 sub format_ref_marker {
2714         my ($refs, $id) = @_;
2715         my $markers = '';
2716
2717         if (defined $refs->{$id}) {
2718                 foreach my $ref (@{$refs->{$id}}) {
2719                         # this code exploits the fact that non-lightweight tags are the
2720                         # only indirect objects, and that they are the only objects for which
2721                         # we want to use tag instead of shortlog as action
2722                         my ($type, $name) = qw();
2723                         my $indirect = ($ref =~ s/\^\{\}$//);
2724                         # e.g. tags/v2.6.11 or heads/next
2725                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2726                                 $type = $1;
2727                                 $name = $2;
2728                         } else {
2729                                 $type = "ref";
2730                                 $name = $ref;
2731                         }
2732
2733                         my $class = $type;
2734                         $class .= " indirect" if $indirect;
2735
2736                         my $dest_action = "shortlog";
2737
2738                         if ($indirect) {
2739                                 $dest_action = "tag" unless $action eq "tag";
2740                         } elsif ($action =~ /^(history|(short)?log)$/) {
2741                                 $dest_action = $action;
2742                         }
2743
2744                         my $dest = "";
2745                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2746                         $dest .= $ref;
2747
2748                         my $link = $cgi->a({
2749                                 -href => href(
2750                                         action=>$dest_action,
2751                                         hash=>$dest
2752                                 )}, $name);
2753
2754                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2755                                 $link . "</span>";
2756                 }
2757         }
2758
2759         if ($markers) {
2760                 return '<span class="refs">'. $markers . '</span>';
2761         } else {
2762                 return "";
2763         }
2764 }
2765
2766 # format, perhaps shortened and with markers, title line
2767 sub format_subject_html {
2768         my ($long, $short, $href, $extra) = @_;
2769         $extra = '' unless defined($extra);
2770
2771         if (length($short) < length($long)) {
2772                 use bytes;
2773                 $long =~ s/[[:cntrl:]]/?/g;
2774                 return $cgi->a({-href => $href, -class => "list subject",
2775                                 -title => to_utf8($long)},
2776                        esc_html($short)) . $extra;
2777         } else {
2778                 return $cgi->a({-href => $href, -class => "list subject"},
2779                        esc_html($long)) . $extra;
2780         }
2781 }
2782
2783 # Rather than recomputing the url for an email multiple times, we cache it
2784 # after the first hit. This gives a visible benefit in views where the avatar
2785 # for the same email is used repeatedly (e.g. shortlog).
2786 # The cache is shared by all avatar engines (currently gravatar only), which
2787 # are free to use it as preferred. Since only one avatar engine is used for any
2788 # given page, there's no risk for cache conflicts.
2789 our %avatar_cache = ();
2790
2791 # Compute the picon url for a given email, by using the picon search service over at
2792 # http://www.cs.indiana.edu/picons/search.html
2793 sub picon_url {
2794         my $email = lc shift;
2795         if (!$avatar_cache{$email}) {
2796                 my ($user, $domain) = split('@', $email);
2797                 $avatar_cache{$email} =
2798                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2799                         "$domain/$user/" .
2800                         "users+domains+unknown/up/single";
2801         }
2802         return $avatar_cache{$email};
2803 }
2804
2805 # Compute the gravatar url for a given email, if it's not in the cache already.
2806 # Gravatar stores only the part of the URL before the size, since that's the
2807 # one computationally more expensive. This also allows reuse of the cache for
2808 # different sizes (for this particular engine).
2809 sub gravatar_url {
2810         my $email = lc shift;
2811         my $size = shift;
2812         $avatar_cache{$email} ||=
2813                 "//www.gravatar.com/avatar/" .
2814                         Digest::MD5::md5_hex($email) . "?s=";
2815         return $avatar_cache{$email} . $size;
2816 }
2817
2818 # Insert an avatar for the given $email at the given $size if the feature
2819 # is enabled.
2820 sub git_get_avatar {
2821         my ($email, %opts) = @_;
2822         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2823         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2824         $opts{-size} ||= 'default';
2825         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2826         my $url = "";
2827         if ($git_avatar eq 'gravatar') {
2828                 $url = gravatar_url($email, $size);
2829         } elsif ($git_avatar eq 'picon') {
2830                 $url = picon_url($email);
2831         }
2832         # Other providers can be added by extending the if chain, defining $url
2833         # as needed. If no variant puts something in $url, we assume avatars
2834         # are completely disabled/unavailable.
2835         if ($url) {
2836                 return $pre_white .
2837                        "<img width=\"$size\" " .
2838                             "class=\"avatar\" " .
2839                             "src=\"".esc_url($url)."\" " .
2840                             "alt=\"\" " .
2841                        "/>" . $post_white;
2842         } else {
2843                 return "";
2844         }
2845 }
2846
2847 sub format_search_author {
2848         my ($author, $searchtype, $displaytext) = @_;
2849         my $have_search = gitweb_check_feature('search');
2850
2851         if ($have_search) {
2852                 my $performed = "";
2853                 if ($searchtype eq 'author') {
2854                         $performed = "authored";
2855                 } elsif ($searchtype eq 'committer') {
2856                         $performed = "committed";
2857                 }
2858
2859                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2860                                 searchtext=>$author,
2861                                 searchtype=>$searchtype), class=>"list",
2862                                 title=>"Search for commits $performed by $author"},
2863                                 $displaytext);
2864
2865         } else {
2866                 return $displaytext;
2867         }
2868 }
2869
2870 # format the author name of the given commit with the given tag
2871 # the author name is chopped and escaped according to the other
2872 # optional parameters (see chop_str).
2873 sub format_author_html {
2874         my $tag = shift;
2875         my $co = shift;
2876         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2877         return "<$tag class=\"author\">" .
2878                format_search_author($co->{'author_name'}, "author",
2879                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2880                        $author) .
2881                "</$tag>";
2882 }
2883
2884 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2885 sub format_git_diff_header_line {
2886         my $line = shift;
2887         my $diffinfo = shift;
2888         my ($from, $to) = @_;
2889
2890         if ($diffinfo->{'nparents'}) {
2891                 # combined diff
2892                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2893                 if ($to->{'href'}) {
2894                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2895                                          esc_path($to->{'file'}));
2896                 } else { # file was deleted (no href)
2897                         $line .= esc_path($to->{'file'});
2898                 }
2899         } else {
2900                 # "ordinary" diff
2901                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2902                 if ($from->{'href'}) {
2903                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2904                                          'a/' . esc_path($from->{'file'}));
2905                 } else { # file was added (no href)
2906                         $line .= 'a/' . esc_path($from->{'file'});
2907                 }
2908                 $line .= ' ';
2909                 if ($to->{'href'}) {
2910                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2911                                          'b/' . esc_path($to->{'file'}));
2912                 } else { # file was deleted
2913                         $line .= 'b/' . esc_path($to->{'file'});
2914                 }
2915         }
2916
2917         return "<div class=\"diff header\">$line</div>\n";
2918 }
2919
2920 # format extended diff header line, before patch itself
2921 sub format_extended_diff_header_line {
2922         my $line = shift;
2923         my $diffinfo = shift;
2924         my ($from, $to) = @_;
2925
2926         # match <path>
2927         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2928                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2929                                        esc_path($from->{'file'}));
2930         }
2931         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2932                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2933                                  esc_path($to->{'file'}));
2934         }
2935         # match single <mode>
2936         if ($line =~ m/\s(\d{6})$/) {
2937                 $line .= '<span class="info"> (' .
2938                          file_type_long($1) .
2939                          ')</span>';
2940         }
2941         # match <hash>
2942         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2943                 # can match only for combined diff
2944                 $line = 'index ';
2945                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2946                         if ($from->{'href'}[$i]) {
2947                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
2948                                                   -class=>"hash"},
2949                                                  substr($diffinfo->{'from_id'}[$i],0,7));
2950                         } else {
2951                                 $line .= '0' x 7;
2952                         }
2953                         # separator
2954                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
2955                 }
2956                 $line .= '..';
2957                 if ($to->{'href'}) {
2958                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2959                                          substr($diffinfo->{'to_id'},0,7));
2960                 } else {
2961                         $line .= '0' x 7;
2962                 }
2963
2964         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
2965                 # can match only for ordinary diff
2966                 my ($from_link, $to_link);
2967                 if ($from->{'href'}) {
2968                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
2969                                              substr($diffinfo->{'from_id'},0,7));
2970                 } else {
2971                         $from_link = '0' x 7;
2972                 }
2973                 if ($to->{'href'}) {
2974                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2975                                            substr($diffinfo->{'to_id'},0,7));
2976                 } else {
2977                         $to_link = '0' x 7;
2978                 }
2979                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
2980                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
2981         }
2982
2983         return $line . "<br/>\n";
2984 }
2985
2986 # format from-file/to-file diff header
2987 sub format_diff_from_to_header {
2988         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
2989         my $line;
2990         my $result = '';
2991
2992         $line = $from_line;
2993         #assert($line =~ m/^---/) if DEBUG;
2994         # no extra formatting for "^--- /dev/null"
2995         if (! $diffinfo->{'nparents'}) {
2996                 # ordinary (single parent) diff
2997                 if ($line =~ m!^--- "?a/!) {
2998                         if ($from->{'href'}) {
2999                                 $line = '--- a/' .
3000                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
3001                                                 esc_path($from->{'file'}));
3002                         } else {
3003                                 $line = '--- a/' .
3004                                         esc_path($from->{'file'});
3005                         }
3006                 }
3007                 $result .= qq!<div class="diff from_file">$line</div>\n!;
3008
3009         } else {
3010                 # combined diff (merge commit)
3011                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3012                         if ($from->{'href'}[$i]) {
3013                                 $line = '--- ' .
3014                                         $cgi->a({-href=>href(action=>"blobdiff",
3015                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3016                                                              hash_parent_base=>$parents[$i],
3017                                                              file_parent=>$from->{'file'}[$i],
3018                                                              hash=>$diffinfo->{'to_id'},
3019                                                              hash_base=>$hash,
3020                                                              file_name=>$to->{'file'}),
3021                                                  -class=>"path",
3022                                                  -title=>"diff" . ($i+1)},
3023                                                 $i+1) .
3024                                         '/' .
3025                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3026                                                 esc_path($from->{'file'}[$i]));
3027                         } else {
3028                                 $line = '--- /dev/null';
3029                         }
3030                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3031                 }
3032         }
3033
3034         $line = $to_line;
3035         #assert($line =~ m/^\+\+\+/) if DEBUG;
3036         # no extra formatting for "^+++ /dev/null"
3037         if ($line =~ m!^\+\+\+ "?b/!) {
3038                 if ($to->{'href'}) {
3039                         $line = '+++ b/' .
3040                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3041                                         esc_path($to->{'file'}));
3042                 } else {
3043                         $line = '+++ b/' .
3044                                 esc_path($to->{'file'});
3045                 }
3046         }
3047         $result .= qq!<div class="diff to_file">$line</div>\n!;
3048
3049         return $result;
3050 }
3051
3052 # create note for patch simplified by combined diff
3053 sub format_diff_cc_simplified {
3054         my ($diffinfo, @parents) = @_;
3055         my $result = '';
3056
3057         $result .= "<div class=\"diff header\">" .
3058                    "diff --cc ";
3059         if (!is_deleted($diffinfo)) {
3060                 $result .= $cgi->a({-href => href(action=>"blob",
3061                                                   hash_base=>$hash,
3062                                                   hash=>$diffinfo->{'to_id'},
3063                                                   file_name=>$diffinfo->{'to_file'}),
3064                                     -class => "path"},
3065                                    esc_path($diffinfo->{'to_file'}));
3066         } else {
3067                 $result .= esc_path($diffinfo->{'to_file'});
3068         }
3069         $result .= "</div>\n" . # class="diff header"
3070                    "<div class=\"diff nodifferences\">" .
3071                    "Simple merge" .
3072                    "</div>\n"; # class="diff nodifferences"
3073
3074         return $result;
3075 }
3076
3077 sub diff_line_class {
3078         my ($line, $from, $to) = @_;
3079
3080         # ordinary diff
3081         my $num_sign = 1;
3082         # combined diff
3083         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3084                 $num_sign = scalar @{$from->{'href'}};
3085         }
3086
3087         my @diff_line_classifier = (
3088                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3089                 { regexp => qr/^\\/,               class => "incomplete"  },
3090                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3091                 # classifier for context must come before classifier add/rem,
3092                 # or we would have to use more complicated regexp, for example
3093                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3094                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3095                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3096         );
3097         for my $clsfy (@diff_line_classifier) {
3098                 return $clsfy->{'class'}
3099                         if ($line =~ $clsfy->{'regexp'});
3100         }
3101
3102         # fallback
3103         return "";
3104 }
3105
3106 # assumes that $from and $to are defined and correctly filled,
3107 # and that $line holds a line of chunk header for unified diff
3108 sub format_unidiff_chunk_header {
3109         my ($line, $from, $to) = @_;
3110
3111         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3112                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3113
3114         $from_lines = 0 unless defined $from_lines;
3115         $to_lines   = 0 unless defined $to_lines;
3116
3117         if ($from->{'href'}) {
3118                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3119                                      -class=>"list"}, $from_text);
3120         }
3121         if ($to->{'href'}) {
3122                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3123                                      -class=>"list"}, $to_text);
3124         }
3125         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3126                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3127         return $line;
3128 }
3129
3130 # assumes that $from and $to are defined and correctly filled,
3131 # and that $line holds a line of chunk header for combined diff
3132 sub format_cc_diff_chunk_header {
3133         my ($line, $from, $to) = @_;
3134
3135         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3136         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3137
3138         @from_text = split(' ', $ranges);
3139         for (my $i = 0; $i < @from_text; ++$i) {
3140                 ($from_start[$i], $from_nlines[$i]) =
3141                         (split(',', substr($from_text[$i], 1)), 0);
3142         }
3143
3144         $to_text   = pop @from_text;
3145         $to_start  = pop @from_start;
3146         $to_nlines = pop @from_nlines;
3147
3148         $line = "<span class=\"chunk_info\">$prefix ";
3149         for (my $i = 0; $i < @from_text; ++$i) {
3150                 if ($from->{'href'}[$i]) {
3151                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3152                                           -class=>"list"}, $from_text[$i]);
3153                 } else {
3154                         $line .= $from_text[$i];
3155                 }
3156                 $line .= " ";
3157         }
3158         if ($to->{'href'}) {
3159                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3160                                   -class=>"list"}, $to_text);
3161         } else {
3162                 $line .= $to_text;
3163         }
3164         $line .= " $prefix</span>" .
3165                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3166         return $line;
3167 }
3168
3169 # process patch (diff) line (not to be used for diff headers),
3170 # returning HTML-formatted (but not wrapped) line.
3171 # If the line is passed as a reference, it is treated as HTML and not
3172 # esc_html()'ed.
3173 sub format_diff_line {
3174         my ($line, $diff_class, $from, $to) = @_;
3175
3176         if (ref($line)) {
3177                 $line = $$line;
3178         } else {
3179                 chomp $line;
3180                 $line = untabify($line);
3181
3182                 if ($from && $to && $line =~ m/^\@{2} /) {
3183                         $line = format_unidiff_chunk_header($line, $from, $to);
3184                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3185                         $line = format_cc_diff_chunk_header($line, $from, $to);
3186                 } else {
3187                         $line = esc_html($line, -nbsp=>1);
3188                 }
3189         }
3190
3191         my $diff_classes = "diff diff_body";
3192         $diff_classes .= " $diff_class" if ($diff_class);
3193         $line = "<div class=\"$diff_classes\">$line</div>\n";
3194
3195         return $line;
3196 }
3197
3198 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3199 # linked.  Pass the hash of the tree/commit to snapshot.
3200 sub format_snapshot_links {
3201         my ($hash) = @_;
3202         my $num_fmts = @snapshot_fmts;
3203         if ($num_fmts > 1) {
3204                 # A parenthesized list of links bearing format names.
3205                 # e.g. "snapshot (_tar.gz_ _zip_)"
3206                 return "snapshot (" . join(' ', map
3207                         $cgi->a({
3208                                 -href => href(
3209                                         action=>"snapshot",
3210                                         hash=>$hash,
3211                                         snapshot_format=>$_
3212                                 )
3213                         }, $known_snapshot_formats{$_}{'display'})
3214                 , @snapshot_fmts) . ")";
3215         } elsif ($num_fmts == 1) {
3216                 # A single "snapshot" link whose tooltip bears the format name.
3217                 # i.e. "_snapshot_"
3218                 my ($fmt) = @snapshot_fmts;
3219                 return
3220                         $cgi->a({
3221                                 -href => href(
3222                                         action=>"snapshot",
3223                                         hash=>$hash,
3224                                         snapshot_format=>$fmt
3225                                 ),
3226                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3227                         }, "snapshot");
3228         } else { # $num_fmts == 0
3229                 return undef;
3230         }
3231 }
3232
3233 ## ......................................................................
3234 ## functions returning values to be passed, perhaps after some
3235 ## transformation, to other functions; e.g. returning arguments to href()
3236
3237 # returns hash to be passed to href to generate gitweb URL
3238 # in -title key it returns description of link
3239 sub get_feed_info {
3240         my $format = shift || 'Atom';
3241         my %res = (action => lc($format));
3242         my $matched_ref = 0;
3243
3244         # feed links are possible only for project views
3245         return unless (defined $project);
3246         # some views should link to OPML, or to generic project feed,
3247         # or don't have specific feed yet (so they should use generic)
3248         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3249
3250         my $branch = undef;
3251         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3252         # (fullname) to differentiate from tag links; this also makes
3253         # possible to detect branch links
3254         for my $ref (get_branch_refs()) {
3255                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3256                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3257                         $branch = $1;
3258                         $matched_ref = $ref;
3259                         last;
3260                 }
3261         }
3262         # find log type for feed description (title)
3263         my $type = 'log';
3264         if (defined $file_name) {
3265                 $type  = "history of $file_name";
3266                 $type .= "/" if ($action eq 'tree');
3267                 $type .= " on '$branch'" if (defined $branch);
3268         } else {
3269                 $type = "log of $branch" if (defined $branch);
3270         }
3271
3272         $res{-title} = $type;
3273         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3274         $res{'file_name'} = $file_name;
3275
3276         return %res;
3277 }
3278
3279 ## ----------------------------------------------------------------------
3280 ## git utility subroutines, invoking git commands
3281
3282 # returns path to the core git executable and the --git-dir parameter as list
3283 sub git_cmd {
3284         $number_of_git_cmds++;
3285         return $GIT, '--git-dir='.$git_dir;
3286 }
3287
3288 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3289 sub cmd_pipe {
3290
3291         # In order to be compatible with FCGI mode we must use POSIX
3292         # and access the STDERR_FILENO file descriptor directly
3293
3294         use POSIX qw(STDERR_FILENO dup dup2);
3295
3296         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3297         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3298         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3299         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3300         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3301         my $result = open(my $fd, "-|", @_);
3302         $dup2ok = dup2($saveerr, STDERR_FILENO);
3303         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3304         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3305
3306         return $result ? $fd : undef;
3307 }
3308
3309 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3310 sub git_cmd_pipe {
3311         return cmd_pipe git_cmd(), @_;
3312 }
3313
3314 # quote the given arguments for passing them to the shell
3315 # quote_command("command", "arg 1", "arg with ' and ! characters")
3316 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3317 # Try to avoid using this function wherever possible.
3318 sub quote_command {
3319         return join(' ',
3320                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3321 }
3322
3323 # get HEAD ref of given project as hash
3324 sub git_get_head_hash {
3325         return git_get_full_hash(shift, 'HEAD');
3326 }
3327
3328 sub git_get_full_hash {
3329         return git_get_hash(@_);
3330 }
3331
3332 sub git_get_short_hash {
3333         return git_get_hash(@_, '--short=7');
3334 }
3335
3336 sub git_get_hash {
3337         my ($project, $hash, @options) = @_;
3338         my $o_git_dir = $git_dir;
3339         my $retval = undef;
3340         $git_dir = "$projectroot/$project";
3341         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3342             '--verify', '-q', @options, $hash)) {
3343                 $retval = <$fd>;
3344                 chomp $retval if defined $retval;
3345                 close $fd;
3346         }
3347         if (defined $o_git_dir) {
3348                 $git_dir = $o_git_dir;
3349         }
3350         return $retval;
3351 }
3352
3353 # get type of given object
3354 sub git_get_type {
3355         my $hash = shift;
3356
3357         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3358         my $type = <$fd>;
3359         close $fd or return;
3360         chomp $type;
3361         return $type;
3362 }
3363
3364 # repository configuration
3365 our $config_file = '';
3366 our %config;
3367
3368 # store multiple values for single key as anonymous array reference
3369 # single values stored directly in the hash, not as [ <value> ]
3370 sub hash_set_multi {
3371         my ($hash, $key, $value) = @_;
3372
3373         if (!exists $hash->{$key}) {
3374                 $hash->{$key} = $value;
3375         } elsif (!ref $hash->{$key}) {
3376                 $hash->{$key} = [ $hash->{$key}, $value ];
3377         } else {
3378                 push @{$hash->{$key}}, $value;
3379         }
3380 }
3381
3382 # return hash of git project configuration
3383 # optionally limited to some section, e.g. 'gitweb'
3384 sub git_parse_project_config {
3385         my $section_regexp = shift;
3386         my %config;
3387
3388         local $/ = "\0";
3389
3390         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3391                 or return;
3392
3393         while (my $keyval = to_utf8(scalar <$fh>)) {
3394                 chomp $keyval;
3395                 my ($key, $value) = split(/\n/, $keyval, 2);
3396
3397                 hash_set_multi(\%config, $key, $value)
3398                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3399         }
3400         close $fh;
3401
3402         return %config;
3403 }
3404
3405 # convert config value to boolean: 'true' or 'false'
3406 # no value, number > 0, 'true' and 'yes' values are true
3407 # rest of values are treated as false (never as error)
3408 sub config_to_bool {
3409         my $val = shift;
3410
3411         return 1 if !defined $val;             # section.key
3412
3413         # strip leading and trailing whitespace
3414         $val =~ s/^\s+//;
3415         $val =~ s/\s+$//;
3416
3417         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3418                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3419 }
3420
3421 # convert config value to simple decimal number
3422 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3423 # to be multiplied by 1024, 1048576, or 1073741824
3424 sub config_to_int {
3425         my $val = shift;
3426
3427         # strip leading and trailing whitespace
3428         $val =~ s/^\s+//;
3429         $val =~ s/\s+$//;
3430
3431         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3432                 $unit = lc($unit);
3433                 # unknown unit is treated as 1
3434                 return $num * ($unit eq 'g' ? 1073741824 :
3435                                $unit eq 'm' ?    1048576 :
3436                                $unit eq 'k' ?       1024 : 1);
3437         }
3438         return $val;
3439 }
3440
3441 # convert config value to array reference, if needed
3442 sub config_to_multi {
3443         my $val = shift;
3444
3445         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3446 }
3447
3448 sub git_get_project_config {
3449         my ($key, $type) = @_;
3450
3451         return unless defined $git_dir;
3452
3453         # key sanity check
3454         return unless ($key);
3455         # only subsection, if exists, is case sensitive,
3456         # and not lowercased by 'git config -z -l'
3457         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3458                 $lo =~ s/_//g;
3459                 $key = join(".", lc($hi), $mi, lc($lo));
3460                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3461         } else {
3462                 $key = lc($key);
3463                 $key =~ s/_//g;
3464                 return if ($key =~ /\W/);
3465         }
3466         $key =~ s/^gitweb\.//;
3467
3468         # type sanity check
3469         if (defined $type) {
3470                 $type =~ s/^--//;
3471                 $type = undef
3472                         unless ($type eq 'bool' || $type eq 'int');
3473         }
3474
3475         # get config
3476         if (!defined $config_file ||
3477             $config_file ne "$git_dir/config") {
3478                 %config = git_parse_project_config('gitweb');
3479                 $config_file = "$git_dir/config";
3480         }
3481
3482         # check if config variable (key) exists
3483         return unless exists $config{"gitweb.$key"};
3484
3485         # ensure given type
3486         if (!defined $type) {
3487                 return $config{"gitweb.$key"};
3488         } elsif ($type eq 'bool') {
3489                 # backward compatibility: 'git config --bool' returns true/false
3490                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3491         } elsif ($type eq 'int') {
3492                 return config_to_int($config{"gitweb.$key"});
3493         }
3494         return $config{"gitweb.$key"};
3495 }
3496
3497 # get hash of given path at given ref
3498 sub git_get_hash_by_path {
3499         my $base = shift;
3500         my $path = shift || return undef;
3501         my $type = shift;
3502
3503         $path =~ s,/+$,,;
3504
3505         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3506                 or die_error(500, "Open git-ls-tree failed");
3507         my $line = to_utf8(scalar <$fd>);
3508         close $fd or return undef;
3509
3510         if (!defined $line) {
3511                 # there is no tree or hash given by $path at $base
3512                 return undef;
3513         }
3514
3515         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3516         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3517         if (defined $type && $type ne $2) {
3518                 # type doesn't match
3519                 return undef;
3520         }
3521         return $3;
3522 }
3523
3524 # get path of entry with given hash at given tree-ish (ref)
3525 # used to get 'from' filename for combined diff (merge commit) for renames
3526 sub git_get_path_by_hash {
3527         my $base = shift || return;
3528         my $hash = shift || return;
3529
3530         local $/ = "\0";
3531
3532         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3533                 or return undef;
3534         while (my $line = to_utf8(scalar <$fd>)) {
3535                 chomp $line;
3536
3537                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3538                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3539                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3540                         close $fd;
3541                         return $1;
3542                 }
3543         }
3544         close $fd;
3545         return undef;
3546 }
3547
3548 ## ......................................................................
3549 ## git utility functions, directly accessing git repository
3550
3551 # get the value of config variable either from file named as the variable
3552 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3553 # configuration variable in the repository config file.
3554 sub git_get_file_or_project_config {
3555         my ($path, $name) = @_;
3556
3557         $git_dir = "$projectroot/$path";
3558         open my $fd, '<', "$git_dir/$name"
3559                 or return git_get_project_config($name);
3560         my $conf = to_utf8(scalar <$fd>);
3561         close $fd;
3562         if (defined $conf) {
3563                 chomp $conf;
3564         }
3565         return $conf;
3566 }
3567
3568 sub git_get_project_description {
3569         my $path = shift;
3570         return git_get_file_or_project_config($path, 'description');
3571 }
3572
3573 sub git_get_project_category {
3574         my $path = shift;
3575         return git_get_file_or_project_config($path, 'category');
3576 }
3577
3578
3579 # supported formats:
3580 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3581 #   - if its contents is a number, use it as tag weight,
3582 #   - otherwise add a tag with weight 1
3583 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3584 #   the same value multiple times increases tag weight
3585 # * `gitweb.ctag' multi-valued repo config variable
3586 sub git_get_project_ctags {
3587         my $project = shift;
3588         my $ctags = {};
3589
3590         $git_dir = "$projectroot/$project";
3591         if (opendir my $dh, "$git_dir/ctags") {
3592                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3593                 foreach my $tagfile (@files) {
3594                         open my $ct, '<', $tagfile
3595                                 or next;
3596                         my $val = <$ct>;
3597                         chomp $val if $val;
3598                         close $ct;
3599
3600                         (my $ctag = $tagfile) =~ s#.*/##;
3601                         $ctag = to_utf8($ctag);
3602                         if ($val =~ /^\d+$/) {
3603                                 $ctags->{$ctag} = $val;
3604                         } else {
3605                                 $ctags->{$ctag} = 1;
3606                         }
3607                 }
3608                 closedir $dh;
3609
3610         } elsif (open my $fh, '<', "$git_dir/ctags") {
3611                 while (my $line = to_utf8(scalar <$fh>)) {
3612                         chomp $line;
3613                         $ctags->{$line}++ if $line;
3614                 }
3615                 close $fh;
3616
3617         } else {
3618                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3619                 foreach my $tag (@$taglist) {
3620                         $ctags->{$tag}++;
3621                 }
3622         }
3623
3624         return $ctags;
3625 }
3626
3627 # return hash, where keys are content tags ('ctags'),
3628 # and values are sum of weights of given tag in every project
3629 sub git_gather_all_ctags {
3630         my $projects = shift;
3631         my $ctags = {};
3632
3633         foreach my $p (@$projects) {
3634                 foreach my $ct (keys %{$p->{'ctags'}}) {
3635                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3636                 }
3637         }
3638
3639         return $ctags;
3640 }
3641
3642 sub git_populate_project_tagcloud {
3643         my ($ctags, $action) = @_;
3644
3645         # First, merge different-cased tags; tags vote on casing
3646         my %ctags_lc;
3647         foreach (keys %$ctags) {
3648                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3649                 if (not $ctags_lc{lc $_}->{topcount}
3650                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3651                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3652                         $ctags_lc{lc $_}->{topname} = $_;
3653                 }
3654         }
3655
3656         my $cloud;
3657         my $matched = $input_params{'ctag_filter'};
3658         if (eval { require HTML::TagCloud; 1; }) {
3659                 $cloud = HTML::TagCloud->new;
3660                 foreach my $ctag (sort keys %ctags_lc) {
3661                         # Pad the title with spaces so that the cloud looks
3662                         # less crammed.
3663                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3664                         $title =~ s/ /&#160;/g;
3665                         $title =~ s/^/&#160;/g;
3666                         $title =~ s/$/&#160;/g;
3667                         if (defined $matched && $matched eq $ctag) {
3668                                 $title = qq(<span class="match">$title</span>);
3669                         }
3670                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3671                                     $ctags_lc{$ctag}->{count});
3672                 }
3673         } else {
3674                 $cloud = {};
3675                 foreach my $ctag (keys %ctags_lc) {
3676                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3677                         if (defined $matched && $matched eq $ctag) {
3678                                 $title = qq(<span class="match">$title</span>);
3679                         }
3680                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3681                         $cloud->{$ctag}{ctag} =
3682                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3683                 }
3684         }
3685         return $cloud;
3686 }
3687
3688 sub git_show_project_tagcloud {
3689         my ($cloud, $count) = @_;
3690         if (ref $cloud eq 'HTML::TagCloud') {
3691                 return $cloud->html_and_css($count);
3692         } else {
3693                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3694                 return
3695                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3696                         join (', ', map {
3697                                 $cloud->{$_}->{'ctag'}
3698                         } splice(@tags, 0, $count)) .
3699                         '</div>';
3700         }
3701 }
3702
3703 sub git_get_project_url_list {
3704         my $path = shift;
3705
3706         $git_dir = "$projectroot/$path";
3707         open my $fd, '<', "$git_dir/cloneurl"
3708                 or return wantarray ?
3709                 @{ config_to_multi(git_get_project_config('url')) } :
3710                    config_to_multi(git_get_project_config('url'));
3711         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3712         close $fd;
3713
3714         return wantarray ? @git_project_url_list : \@git_project_url_list;
3715 }
3716
3717 sub git_get_projects_list {
3718         my $filter = shift || '';
3719         my $paranoid = shift;
3720         my @list;
3721
3722         if (-d $projects_list) {
3723                 # search in directory
3724                 my $dir = $projects_list;
3725                 # remove the trailing "/"
3726                 $dir =~ s!/+$!!;
3727                 my $pfxlen = length("$dir");
3728                 my $pfxdepth = ($dir =~ tr!/!!);
3729                 # when filtering, search only given subdirectory
3730                 if ($filter && !$paranoid) {
3731                         $dir .= "/$filter";
3732                         $dir =~ s!/+$!!;
3733                 }
3734
3735                 File::Find::find({
3736                         follow_fast => 1, # follow symbolic links
3737                         follow_skip => 2, # ignore duplicates
3738                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3739                         wanted => sub {
3740                                 # global variables
3741                                 our $project_maxdepth;
3742                                 our $projectroot;
3743                                 # skip project-list toplevel, if we get it.
3744                                 return if (m!^[/.]$!);
3745                                 # only directories can be git repositories
3746                                 return unless (-d $_);
3747                                 # don't traverse too deep (Find is super slow on os x)
3748                                 # $project_maxdepth excludes depth of $projectroot
3749                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3750                                         $File::Find::prune = 1;
3751                                         return;
3752                                 }
3753
3754                                 my $path = substr($File::Find::name, $pfxlen + 1);
3755                                 # paranoidly only filter here
3756                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3757                                         next;
3758                                 }
3759                                 # we check related file in $projectroot
3760                                 if (check_export_ok("$projectroot/$path")) {
3761                                         push @list, { path => $path };
3762                                         $File::Find::prune = 1;
3763                                 }
3764                         },
3765                 }, "$dir");
3766
3767         } elsif (-f $projects_list) {
3768                 # read from file(url-encoded):
3769                 # 'git%2Fgit.git Linus+Torvalds'
3770                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3771                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3772                 open my $fd, '<', $projects_list or return;
3773         PROJECT:
3774                 while (my $line = <$fd>) {
3775                         chomp $line;
3776                         my ($path, $owner) = split ' ', $line;
3777                         $path = unescape($path);
3778                         $owner = unescape($owner);
3779                         if (!defined $path) {
3780                                 next;
3781                         }
3782                         # if $filter is rpovided, check if $path begins with $filter
3783                         if ($filter && $path !~ m!^\Q$filter\E/!) {
3784                                 next;
3785                         }
3786                         if (check_export_ok("$projectroot/$path")) {
3787                                 my $pr = {
3788                                         path => $path
3789                                 };
3790                                 if ($owner) {
3791                                         $pr->{'owner'} = to_utf8($owner);
3792                                 }
3793                                 push @list, $pr;
3794                         }
3795                 }
3796                 close $fd;
3797         }
3798         return @list;
3799 }
3800
3801 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3802 # as side effects it sets 'forks' field to list of forks for forked projects
3803 sub filter_forks_from_projects_list {
3804         my $projects = shift;
3805
3806         my %trie; # prefix tree of directories (path components)
3807         # generate trie out of those directories that might contain forks
3808         foreach my $pr (@$projects) {
3809                 my $path = $pr->{'path'};
3810                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3811                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3812                 next unless ($path);      # skip '.git' repository: tests, git-instaweb
3813                 next unless (-d "$projectroot/$path"); # containing directory exists
3814                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3815
3816                 # add to trie
3817                 my @dirs = split('/', $path);
3818                 # walk the trie, until either runs out of components or out of trie
3819                 my $ref = \%trie;
3820                 while (scalar @dirs &&
3821                        exists($ref->{$dirs[0]})) {
3822                         $ref = $ref->{shift @dirs};
3823                 }
3824                 # create rest of trie structure from rest of components
3825                 foreach my $dir (@dirs) {
3826                         $ref = $ref->{$dir} = {};
3827                 }
3828                 # create end marker, store $pr as a data
3829                 $ref->{''} = $pr if (!exists $ref->{''});
3830         }
3831
3832         # filter out forks, by finding shortest prefix match for paths
3833         my @filtered;
3834  PROJECT:
3835         foreach my $pr (@$projects) {
3836                 # trie lookup
3837                 my $ref = \%trie;
3838         DIR:
3839                 foreach my $dir (split('/', $pr->{'path'})) {
3840                         if (exists $ref->{''}) {
3841                                 # found [shortest] prefix, is a fork - skip it
3842                                 push @{$ref->{''}{'forks'}}, $pr;
3843                                 next PROJECT;
3844                         }
3845                         if (!exists $ref->{$dir}) {
3846                                 # not in trie, cannot have prefix, not a fork
3847                                 push @filtered, $pr;
3848                                 next PROJECT;
3849                         }
3850                         # If the dir is there, we just walk one step down the trie.
3851                         $ref = $ref->{$dir};
3852                 }
3853                 # we ran out of trie
3854                 # (shouldn't happen: it's either no match, or end marker)
3855                 push @filtered, $pr;
3856         }
3857
3858         return @filtered;
3859 }
3860
3861 # note: fill_project_list_info must be run first,
3862 # for 'descr_long' and 'ctags' to be filled
3863 sub search_projects_list {
3864         my ($projlist, %opts) = @_;
3865         my $tagfilter  = $opts{'tagfilter'};
3866         my $search_re = $opts{'search_regexp'};
3867
3868         return @$projlist
3869                 unless ($tagfilter || $search_re);
3870
3871         # searching projects require filling to be run before it;
3872         fill_project_list_info($projlist,
3873                                $tagfilter  ? 'ctags' : (),
3874                                $search_re ? ('path', 'descr') : ());
3875         my @projects;
3876  PROJECT:
3877         foreach my $pr (@$projlist) {
3878
3879                 if ($tagfilter) {
3880                         next unless ref($pr->{'ctags'}) eq 'HASH';
3881                         next unless
3882                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3883                 }
3884
3885                 if ($search_re) {
3886                         my $path = $pr->{'path'};
3887                         $path =~ s/\.git$//; # should not be included in search
3888                         next unless
3889                                 $path =~ /$search_re/ ||
3890                                 $pr->{'descr_long'} =~ /$search_re/;
3891                 }
3892
3893                 push @projects, $pr;
3894         }
3895
3896         return @projects;
3897 }
3898
3899 our $gitweb_project_owner = undef;
3900 sub git_get_project_list_from_file {
3901
3902         return if (defined $gitweb_project_owner);
3903
3904         $gitweb_project_owner = {};
3905         # read from file (url-encoded):
3906         # 'git%2Fgit.git Linus+Torvalds'
3907         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3908         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3909         if (-f $projects_list) {
3910                 open(my $fd, '<', $projects_list);
3911                 while (my $line = <$fd>) {
3912                         chomp $line;
3913                         my ($pr, $ow) = split ' ', $line;
3914                         $pr = unescape($pr);
3915                         $ow = unescape($ow);
3916                         $gitweb_project_owner->{$pr} = to_utf8($ow);
3917                 }
3918                 close $fd;
3919         }
3920 }
3921
3922 sub git_get_project_owner {
3923         my $proj = shift;
3924         my $owner;
3925
3926         return undef unless $proj;
3927         $git_dir = "$projectroot/$proj";
3928
3929         if (defined $project && $proj eq $project) {
3930                 $owner = git_get_project_config('owner');
3931         }
3932         if (!defined $owner && !defined $gitweb_project_owner) {
3933                 git_get_project_list_from_file();
3934         }
3935         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
3936                 $owner = $gitweb_project_owner->{$proj};
3937         }
3938         if (!defined $owner && (!defined $project || $proj ne $project)) {
3939                 $owner = git_get_project_config('owner');
3940         }
3941         if (!defined $owner) {
3942                 $owner = get_file_owner("$git_dir");
3943         }
3944
3945         return $owner;
3946 }
3947
3948 sub parse_activity_date {
3949         my $dstr = shift;
3950
3951         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
3952                 # Unix timestamp
3953                 return 0 + $1;
3954         }
3955         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
3956                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
3957                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
3958                 defined($z) && $z ne '' or $z = 'Z';
3959                 $z =~ s/://;
3960                 substr($z,1,0) = '0' if length($z) == 4;
3961                 my $off = 0;
3962                 if (uc($z) ne 'Z') {
3963                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
3964                         $off = -$off if substr($z,0,1) eq '-';
3965                 }
3966                 return $seconds - $off;
3967         }
3968         return undef;
3969 }
3970
3971 # If $quick is true only look at $lastactivity_file
3972 sub git_get_last_activity {
3973         my ($path, $quick) = @_;
3974         my $fd;
3975
3976         $git_dir = "$projectroot/$path";
3977         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
3978                 my $activity = <$fd>;
3979                 close $fd;
3980                 return (undef) unless defined $activity;
3981                 chomp $activity;
3982                 return (undef) if $activity eq '';
3983                 if (my $timestamp = parse_activity_date($activity)) {
3984                         return ($timestamp);
3985                 }
3986         }
3987         return (undef) if $quick;
3988         defined($fd = git_cmd_pipe 'for-each-ref',
3989              '--format=%(committer)',
3990              '--sort=-committerdate',
3991              '--count=1',
3992              map { "refs/$_" } get_branch_refs ()) or return;
3993         my $most_recent = <$fd>;
3994         close $fd or return (undef);
3995         if (defined $most_recent &&
3996             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
3997                 my $timestamp = $1;
3998                 return ($timestamp);
3999         }
4000         return (undef);
4001 }
4002
4003 # Implementation note: when a single remote is wanted, we cannot use 'git
4004 # remote show -n' because that command always work (assuming it's a remote URL
4005 # if it's not defined), and we cannot use 'git remote show' because that would
4006 # try to make a network roundtrip. So the only way to find if that particular
4007 # remote is defined is to walk the list provided by 'git remote -v' and stop if
4008 # and when we find what we want.
4009 sub git_get_remotes_list {
4010         my $wanted = shift;
4011         my %remotes = ();
4012
4013         my $fd = git_cmd_pipe 'remote', '-v';
4014         return unless $fd;
4015         while (my $remote = to_utf8(scalar <$fd>)) {
4016                 chomp $remote;
4017                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4018                 next if $wanted and not $remote eq $wanted;
4019                 my ($url, $key) = ($1, $2);
4020
4021                 $remotes{$remote} ||= { 'heads' => [] };
4022                 $remotes{$remote}{$key} = $url;
4023         }
4024         close $fd or return;
4025         return wantarray ? %remotes : \%remotes;
4026 }
4027
4028 # Takes a hash of remotes as first parameter and fills it by adding the
4029 # available remote heads for each of the indicated remotes.
4030 sub fill_remote_heads {
4031         my $remotes = shift;
4032         my @heads = map { "remotes/$_" } keys %$remotes;
4033         my @remoteheads = git_get_heads_list(undef, @heads);
4034         foreach my $remote (keys %$remotes) {
4035                 $remotes->{$remote}{'heads'} = [ grep {
4036                         $_->{'name'} =~ s!^$remote/!!
4037                         } @remoteheads ];
4038         }
4039 }
4040
4041 sub git_get_references {
4042         my $type = shift || "";
4043         my %refs;
4044         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4045         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4046         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4047                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4048                 or return;
4049
4050         while (my $line = to_utf8(scalar <$fd>)) {
4051                 chomp $line;
4052                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4053                         if (defined $refs{$1}) {
4054                                 push @{$refs{$1}}, $2;
4055                         } else {
4056                                 $refs{$1} = [ $2 ];
4057                         }
4058                 }
4059         }
4060         close $fd or return;
4061         return \%refs;
4062 }
4063
4064 sub git_get_rev_name_tags {
4065         my $hash = shift || return undef;
4066
4067         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4068                 or return;
4069         my $name_rev = to_utf8(scalar <$fd>);
4070         close $fd;
4071
4072         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4073                 return $1;
4074         } else {
4075                 # catches also '$hash undefined' output
4076                 return undef;
4077         }
4078 }
4079
4080 ## ----------------------------------------------------------------------
4081 ## parse to hash functions
4082
4083 sub parse_date {
4084         my $epoch = shift;
4085         my $tz = shift || "-0000";
4086
4087         my %date;
4088         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4089         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4090         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4091         $date{'hour'} = $hour;
4092         $date{'minute'} = $min;
4093         $date{'mday'} = $mday;
4094         $date{'day'} = $days[$wday];
4095         $date{'month'} = $months[$mon];
4096         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4097                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4098         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4099                              $mday, $months[$mon], $hour ,$min;
4100         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4101                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4102
4103         my ($tz_sign, $tz_hour, $tz_min) =
4104                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4105         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4106         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4107         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4108         $date{'hour_local'} = $hour;
4109         $date{'minute_local'} = $min;
4110         $date{'mday_local'} = $mday;
4111         $date{'tz_local'} = $tz;
4112         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4113                                   1900+$year, $mon+1, $mday,
4114                                   $hour, $min, $sec, $tz);
4115         return %date;
4116 }
4117
4118 sub parse_file_date {
4119         my $file = shift;
4120         my $mtime = (stat("$projectroot/$project/$file"))[9];
4121         return () unless defined $mtime;
4122         my $tzoffset = timegm((localtime($mtime))[0..5]) - $mtime;
4123         my $tzstring = '+';
4124         if ($tzoffset <= 0) {
4125                 $tzstring = '-';
4126                 $tzoffset *= -1;
4127         }
4128         $tzoffset = int($tzoffset/60);
4129         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
4130         return parse_date($mtime, $tzstring);
4131 }
4132
4133 sub parse_tag {
4134         my $tag_id = shift;
4135         my %tag;
4136         my @comment;
4137
4138         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4139         $tag{'id'} = $tag_id;
4140         while (my $line = to_utf8(scalar <$fd>)) {
4141                 chomp $line;
4142                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4143                         $tag{'object'} = $1;
4144                 } elsif ($line =~ m/^type (.+)$/) {
4145                         $tag{'type'} = $1;
4146                 } elsif ($line =~ m/^tag (.+)$/) {
4147                         $tag{'name'} = $1;
4148                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4149                         $tag{'author'} = $1;
4150                         $tag{'author_epoch'} = $2;
4151                         $tag{'author_tz'} = $3;
4152                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4153                                 $tag{'author_name'}  = $1;
4154                                 $tag{'author_email'} = $2;
4155                         } else {
4156                                 $tag{'author_name'} = $tag{'author'};
4157                         }
4158                 } elsif ($line =~ m/--BEGIN/) {
4159                         push @comment, $line;
4160                         last;
4161                 } elsif ($line eq "") {
4162                         last;
4163                 }
4164         }
4165         push @comment, map(to_utf8($_), <$fd>);
4166         $tag{'comment'} = \@comment;
4167         close $fd or return;
4168         if (!defined $tag{'name'}) {
4169                 return
4170         };
4171         return %tag
4172 }
4173
4174 sub parse_commit_text {
4175         my ($commit_text, $withparents) = @_;
4176         my @commit_lines = split '\n', $commit_text;
4177         my %co;
4178
4179         pop @commit_lines; # Remove '\0'
4180
4181         if (! @commit_lines) {
4182                 return;
4183         }
4184
4185         my $header = shift @commit_lines;
4186         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4187                 return;
4188         }
4189         ($co{'id'}, my @parents) = split ' ', $header;
4190         while (my $line = shift @commit_lines) {
4191                 last if $line eq "\n";
4192                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4193                         $co{'tree'} = $1;
4194                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4195                         push @parents, $1;
4196                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4197                         $co{'author'} = to_utf8($1);
4198                         $co{'author_epoch'} = $2;
4199                         $co{'author_tz'} = $3;
4200                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4201                                 $co{'author_name'}  = $1;
4202                                 $co{'author_email'} = $2;
4203                         } else {
4204                                 $co{'author_name'} = $co{'author'};
4205                         }
4206                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4207                         $co{'committer'} = to_utf8($1);
4208                         $co{'committer_epoch'} = $2;
4209                         $co{'committer_tz'} = $3;
4210                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4211                                 $co{'committer_name'}  = $1;
4212                                 $co{'committer_email'} = $2;
4213                         } else {
4214                                 $co{'committer_name'} = $co{'committer'};
4215                         }
4216                 }
4217         }
4218         if (!defined $co{'tree'}) {
4219                 return;
4220         };
4221         $co{'parents'} = \@parents;
4222         $co{'parent'} = $parents[0];
4223
4224         @commit_lines = map to_utf8($_), @commit_lines;
4225         foreach my $title (@commit_lines) {
4226                 $title =~ s/^    //;
4227                 if ($title ne "") {
4228                         $co{'title'} = chop_str($title, 80, 5);
4229                         # remove leading stuff of merges to make the interesting part visible
4230                         if (length($title) > 50) {
4231                                 $title =~ s/^Automatic //;
4232                                 $title =~ s/^merge (of|with) /Merge ... /i;
4233                                 if (length($title) > 50) {
4234                                         $title =~ s/(http|rsync):\/\///;
4235                                 }
4236                                 if (length($title) > 50) {
4237                                         $title =~ s/(master|www|rsync)\.//;
4238                                 }
4239                                 if (length($title) > 50) {
4240                                         $title =~ s/kernel.org:?//;
4241                                 }
4242                                 if (length($title) > 50) {
4243                                         $title =~ s/\/pub\/scm//;
4244                                 }
4245                         }
4246                         $co{'title_short'} = chop_str($title, 50, 5);
4247                         last;
4248                 }
4249         }
4250         if (! defined $co{'title'} || $co{'title'} eq "") {
4251                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4252         }
4253         # remove added spaces
4254         foreach my $line (@commit_lines) {
4255                 $line =~ s/^    //;
4256         }
4257         $co{'comment'} = \@commit_lines;
4258
4259         my $age_epoch = $co{'committer_epoch'};
4260         $co{'age_epoch'} = $age_epoch;
4261         my $time_now = time;
4262         $co{'age_string'} = age_string($age_epoch, $time_now);
4263         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4264         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4265         return %co;
4266 }
4267
4268 sub parse_commit {
4269         my ($commit_id) = @_;
4270         my %co;
4271
4272         local $/ = "\0";
4273
4274         defined(my $fd = git_cmd_pipe "rev-list",
4275                 "--parents",
4276                 "--header",
4277                 "--max-count=1",
4278                 $commit_id,
4279                 "--")
4280                 or die_error(500, "Open git-rev-list failed");
4281         %co = parse_commit_text(<$fd>, 1);
4282         close $fd;
4283
4284         return %co;
4285 }
4286
4287 sub parse_commits {
4288         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4289         my @cos;
4290
4291         $maxcount ||= 1;
4292         $skip ||= 0;
4293
4294         local $/ = "\0";
4295
4296         defined(my $fd = git_cmd_pipe "rev-list",
4297                 "--header",
4298                 @args,
4299                 ("--max-count=" . $maxcount),
4300                 ("--skip=" . $skip),
4301                 @extra_options,
4302                 $commit_id,
4303                 "--",
4304                 ($filename ? ($filename) : ()))
4305                 or die_error(500, "Open git-rev-list failed");
4306         while (my $line = <$fd>) {
4307                 my %co = parse_commit_text($line);
4308                 push @cos, \%co;
4309         }
4310         close $fd;
4311
4312         return wantarray ? @cos : \@cos;
4313 }
4314
4315 # parse line of git-diff-tree "raw" output
4316 sub parse_difftree_raw_line {
4317         my $line = shift;
4318         my %res;
4319
4320         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4321         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4322         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4323                 $res{'from_mode'} = $1;
4324                 $res{'to_mode'} = $2;
4325                 $res{'from_id'} = $3;
4326                 $res{'to_id'} = $4;
4327                 $res{'status'} = $5;
4328                 $res{'similarity'} = $6;
4329                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4330                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4331                 } else {
4332                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4333                 }
4334         }
4335         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4336         # combined diff (for merge commit)
4337         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4338                 $res{'nparents'}  = length($1);
4339                 $res{'from_mode'} = [ split(' ', $2) ];
4340                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4341                 $res{'from_id'} = [ split(' ', $3) ];
4342                 $res{'to_id'} = pop @{$res{'from_id'}};
4343                 $res{'status'} = [ split('', $4) ];
4344                 $res{'to_file'} = unquote($5);
4345         }
4346         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4347         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4348                 $res{'commit'} = $1;
4349         }
4350
4351         return wantarray ? %res : \%res;
4352 }
4353
4354 # wrapper: return parsed line of git-diff-tree "raw" output
4355 # (the argument might be raw line, or parsed info)
4356 sub parsed_difftree_line {
4357         my $line_or_ref = shift;
4358
4359         if (ref($line_or_ref) eq "HASH") {
4360                 # pre-parsed (or generated by hand)
4361                 return $line_or_ref;
4362         } else {
4363                 return parse_difftree_raw_line($line_or_ref);
4364         }
4365 }
4366
4367 # parse line of git-ls-tree output
4368 sub parse_ls_tree_line {
4369         my $line = shift;
4370         my %opts = @_;
4371         my %res;
4372
4373         if ($opts{'-l'}) {
4374                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4375                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4376
4377                 $res{'mode'} = $1;
4378                 $res{'type'} = $2;
4379                 $res{'hash'} = $3;
4380                 $res{'size'} = $4;
4381                 if ($opts{'-z'}) {
4382                         $res{'name'} = $5;
4383                 } else {
4384                         $res{'name'} = unquote($5);
4385                 }
4386         } else {
4387                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4388                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4389
4390                 $res{'mode'} = $1;
4391                 $res{'type'} = $2;
4392                 $res{'hash'} = $3;
4393                 if ($opts{'-z'}) {
4394                         $res{'name'} = $4;
4395                 } else {
4396                         $res{'name'} = unquote($4);
4397                 }
4398         }
4399
4400         return wantarray ? %res : \%res;
4401 }
4402
4403 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4404 sub parse_from_to_diffinfo {
4405         my ($diffinfo, $from, $to, @parents) = @_;
4406
4407         if ($diffinfo->{'nparents'}) {
4408                 # combined diff
4409                 $from->{'file'} = [];
4410                 $from->{'href'} = [];
4411                 fill_from_file_info($diffinfo, @parents)
4412                         unless exists $diffinfo->{'from_file'};
4413                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4414                         $from->{'file'}[$i] =
4415                                 defined $diffinfo->{'from_file'}[$i] ?
4416                                         $diffinfo->{'from_file'}[$i] :
4417                                         $diffinfo->{'to_file'};
4418                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4419                                 $from->{'href'}[$i] = href(action=>"blob",
4420                                                            hash_base=>$parents[$i],
4421                                                            hash=>$diffinfo->{'from_id'}[$i],
4422                                                            file_name=>$from->{'file'}[$i]);
4423                         } else {
4424                                 $from->{'href'}[$i] = undef;
4425                         }
4426                 }
4427         } else {
4428                 # ordinary (not combined) diff
4429                 $from->{'file'} = $diffinfo->{'from_file'};
4430                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4431                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4432                                                hash=>$diffinfo->{'from_id'},
4433                                                file_name=>$from->{'file'});
4434                 } else {
4435                         delete $from->{'href'};
4436                 }
4437         }
4438
4439         $to->{'file'} = $diffinfo->{'to_file'};
4440         if (!is_deleted($diffinfo)) { # file exists in result
4441                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4442                                      hash=>$diffinfo->{'to_id'},
4443                                      file_name=>$to->{'file'});
4444         } else {
4445                 delete $to->{'href'};
4446         }
4447 }
4448
4449 ## ......................................................................
4450 ## parse to array of hashes functions
4451
4452 sub git_get_heads_list {
4453         my ($limit, @classes) = @_;
4454         @classes = get_branch_refs() unless @classes;
4455         my @patterns = map { "refs/$_" } @classes;
4456         my @headslist;
4457
4458         defined(my $fd = git_cmd_pipe 'for-each-ref',
4459                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4460                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4461                 @patterns)
4462                 or return;
4463         while (my $line = to_utf8(scalar <$fd>)) {
4464                 my %ref_item;
4465
4466                 chomp $line;
4467                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4468                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4469                 my ($committer, $epoch, $tz) =
4470                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4471                 $ref_item{'fullname'}  = $name;
4472                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4473                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4474                 $ref_item{'name'} = $name;
4475                 # for refs neither in 'heads' nor 'remotes' we want to
4476                 # show their ref dir
4477                 my $ref_dir = (defined $1) ? $1 : '';
4478                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4479                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4480                 }
4481
4482                 $ref_item{'id'}    = $hash;
4483                 $ref_item{'title'} = $title || '(no commit message)';
4484                 $ref_item{'epoch'} = $epoch;
4485                 if ($epoch) {
4486                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4487                 } else {
4488                         $ref_item{'age'} = "unknown";
4489                 }
4490
4491                 push @headslist, \%ref_item;
4492         }
4493         close $fd;
4494
4495         return wantarray ? @headslist : \@headslist;
4496 }
4497
4498 sub git_get_tags_list {
4499         my $limit = shift;
4500         my @tagslist;
4501         my $all = shift || 0;
4502         my $order = shift || $default_refs_order;
4503         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4504
4505         defined(my $fd = git_cmd_pipe 'for-each-ref',
4506                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4507                 '--format=%(objectname) %(objecttype) %(refname) '.
4508                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4509                 ($all ? 'refs' : 'refs/tags'))
4510                 or return;
4511         while (my $line = to_utf8(scalar <$fd>)) {
4512                 my %ref_item;
4513
4514                 chomp $line;
4515                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4516                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4517                 my ($creator, $epoch, $tz) =
4518                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4519                 $ref_item{'fullname'} = $name;
4520                 $name =~ s!^refs/!! if $all;
4521                 $name =~ s!^refs/tags/!! unless $all;
4522
4523                 $ref_item{'type'} = $type;
4524                 $ref_item{'id'} = $id;
4525                 $ref_item{'name'} = $name;
4526                 if ($type eq "tag") {
4527                         $ref_item{'subject'} = $title;
4528                         $ref_item{'reftype'} = $reftype;
4529                         $ref_item{'refid'}   = $refid;
4530                 } else {
4531                         $ref_item{'reftype'} = $type;
4532                         $ref_item{'refid'}   = $id;
4533                 }
4534
4535                 if ($type eq "tag" || $type eq "commit") {
4536                         $ref_item{'epoch'} = $epoch;
4537                         if ($epoch) {
4538                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4539                         } else {
4540                                 $ref_item{'age'} = "unknown";
4541                         }
4542                 }
4543
4544                 push @tagslist, \%ref_item;
4545         }
4546         close $fd;
4547
4548         return wantarray ? @tagslist : \@tagslist;
4549 }
4550
4551 ## ----------------------------------------------------------------------
4552 ## filesystem-related functions
4553
4554 sub get_file_owner {
4555         my $path = shift;
4556
4557         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4558         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4559         if (!defined $gcos) {
4560                 return undef;
4561         }
4562         my $owner = $gcos;
4563         $owner =~ s/[,;].*$//;
4564         return to_utf8($owner);
4565 }
4566
4567 # assume that file exists
4568 sub insert_file {
4569         my $filename = shift;
4570
4571         open my $fd, '<', $filename;
4572         while (<$fd>) {
4573                 print to_utf8($_);
4574         }
4575         close $fd;
4576 }
4577
4578 # return undef on failure
4579 sub collect_output {
4580         defined(my $fd = cmd_pipe @_) or return undef;
4581         if (eof $fd) {
4582                 close $fd;
4583                 return undef;
4584         }
4585         my $result = join('', map({ to_utf8($_) } <$fd>));
4586         close $fd or return undef;
4587         return $result;
4588 }
4589
4590 # return undef on failure
4591 # return '' if only comments
4592 sub collect_html_file {
4593         my $filename = shift;
4594
4595         open my $fd, '<', $filename or return undef;
4596         my $result = join('', map({ to_utf8($_) } <$fd>));
4597         close $fd or return undef;
4598         return undef unless defined($result);
4599         my $test = $result;
4600         $test =~ s/<!--(?:[^-]|(?:-(?!-)))*-->//gs;
4601         $test =~ s/\s+//s;
4602         return $test eq '' ? '' : $result;
4603 }
4604
4605 ## ......................................................................
4606 ## mimetype related functions
4607
4608 sub mimetype_guess_file {
4609         my $filename = shift;
4610         my $mimemap = shift;
4611         my $rawmode = shift;
4612         -r $mimemap or return undef;
4613
4614         my %mimemap;
4615         open(my $mh, '<', $mimemap) or return undef;
4616         while (<$mh>) {
4617                 next if m/^#/; # skip comments
4618                 my ($mimetype, @exts) = split(/\s+/);
4619                 foreach my $ext (@exts) {
4620                         $mimemap{$ext} = $mimetype;
4621                 }
4622         }
4623         close($mh);
4624
4625         my ($ext, $ans);
4626         $ext = $1 if $filename =~ /\.([^.]*)$/;
4627         $ans = $mimemap{$ext} if $ext;
4628         if (defined $ans) {
4629                 my $l = lc($ans);
4630                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4631                 if (!$rawmode) {
4632                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4633                                              $l eq 'image/svg+xml' ||
4634                                              $l eq 'application/xml-dtd' ||
4635                                              $l eq 'application/xml-external-parsed-entity';
4636                 }
4637         }
4638         return $ans;
4639 }
4640
4641 sub mimetype_guess {
4642         my $filename = shift;
4643         my $rawmode = shift;
4644         my $mime;
4645         $filename =~ /\./ or return undef;
4646
4647         if ($mimetypes_file) {
4648                 my $file = $mimetypes_file;
4649                 if ($file !~ m!^/!) { # if it is relative path
4650                         # it is relative to project
4651                         $file = "$projectroot/$project/$file";
4652                 }
4653                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4654         }
4655         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4656         return $mime;
4657 }
4658
4659 sub blob_mimetype {
4660         my $fd = shift;
4661         my $filename = shift;
4662         my $rawmode = shift;
4663         my $mime;
4664
4665         # The -T/-B file operators produce the wrong result unless a perlio
4666         # layer is present when the file handle is a pipe that delivers less
4667         # than 512 bytes of data before reaching EOF.
4668         #
4669         # If we are running in a Perl that uses the stdio layer rather than the
4670         # unix+perlio layers we will end up adding a perlio layer on top of the
4671         # stdio layer and get a second level of buffering.  This is harmless
4672         # and it makes the -T/-B file operators work properly in all cases.
4673
4674         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4675                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4676
4677         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4678
4679         if (!$mime && $filename) {
4680                 if ($filename =~ m/\.html?$/i) {
4681                         $mime = 'text/html';
4682                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4683                         $mime = 'text/html';
4684                 } elsif ($filename =~ m/\.te?xt?$/i) {
4685                         $mime = 'text/plain';
4686                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4687                         $mime = 'text/plain';
4688                 } elsif ($filename =~ m/\.png$/i) {
4689                         $mime = 'image/png';
4690                 } elsif ($filename =~ m/\.gif$/i) {
4691                         $mime = 'image/gif';
4692                 } elsif ($filename =~ m/\.jpe?g$/i) {
4693                         $mime = 'image/jpeg';
4694                 } elsif ($filename =~ m/\.svgz?$/i) {
4695                         $mime = 'image/svg+xml';
4696                 }
4697         }
4698
4699         # just in case
4700         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4701
4702         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4703
4704         return $mime;
4705 }
4706
4707 sub is_ascii {
4708         use bytes;
4709         my $data = shift;
4710         return scalar($data =~ /^[\x00-\x7f]*$/);
4711 }
4712
4713 sub is_valid_utf8 {
4714         my $data = shift;
4715         return utf8::decode($data);
4716 }
4717
4718 sub extract_html_charset {
4719         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4720         my $head = $1;
4721         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4722         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) {
4723                 my %kv = (lc($1) => $3, lc($4) => $6);
4724                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4725                 return $1 if $he && $c && $he eq 'content-type' &&
4726                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4727         }
4728         return undef;
4729 }
4730
4731 sub blob_contenttype {
4732         my ($fd, $file_name, $type) = @_;
4733
4734         $type ||= blob_mimetype($fd, $file_name, 1);
4735         return $type unless $type =~ m!^text/.+!i;
4736         my ($leader, $charset, $htmlcharset);
4737         if ($fd && read($fd, $leader, 32768)) {{
4738                 $charset='US-ASCII' if is_ascii($leader);
4739                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4740                 $charset='ISO-8859-1' unless $charset;
4741                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4742                 if ($htmlcharset && $charset ne 'US-ASCII') {
4743                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4744                 }
4745         }}
4746         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4747         my $defcharset = $default_text_plain_charset || '';
4748         $defcharset =~ s/^\s+//;
4749         $defcharset =~ s/\s+$//;
4750         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4751         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4752 }
4753
4754 # peek the first upto 128 bytes off a file handle
4755 sub peek128bytes {
4756         my $fd = shift;
4757
4758         use IO::Handle;
4759         use bytes;
4760
4761         my $prefix128;
4762         return '' unless $fd && read($fd, $prefix128, 128);
4763
4764         # In the general case, we're guaranteed only to be able to ungetc one
4765         # character (provided, of course, we actually got a character first).
4766         #
4767         # However, we know:
4768         #
4769         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4770         #    already been called at least once on the file handle before us
4771         #
4772         # 2) we have an $fd positioned at the start of the input stream and
4773         #    therefore know we were positioned at a buffer boundary before
4774         #    reading the initial upto 128 bytes
4775         #
4776         # 3) the buffer size is at least 512 bytes
4777         #
4778         # 4) we are careful to only unget raw bytes
4779         #
4780         # 5) we are attempting to unget exactly the same number of bytes we got
4781         #
4782         # Given the above conditions we will ALWAYS be able to safely unget
4783         # the $prefix128 value we just got.
4784         #
4785         # In fact, we could read up to 511 bytes and still be sure.
4786         # (Reading 512 might pop us into the next internal buffer, but probably
4787         # not since that could break the always able to unget at least the one
4788         # you just got guarantee.)
4789
4790         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4791
4792         return $prefix128;
4793 }
4794
4795 # guess file syntax for syntax highlighting; return undef if no highlighting
4796 # the name of syntax can (in the future) depend on syntax highlighter used
4797 sub guess_file_syntax {
4798         my ($fd, $mimetype, $file_name) = @_;
4799         return undef unless $fd && defined $file_name &&
4800                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4801         my $basename = basename($file_name, '.in');
4802         return $highlight_basename{$basename}
4803                 if exists $highlight_basename{$basename};
4804
4805         # Peek to see if there's a shebang or xml line.
4806         # We always operate on bytes when testing this.
4807         {
4808                 use bytes;
4809                 my $shebang = peek128bytes($fd);
4810                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4811                         foreach my $key (keys %highlight_shebang) {
4812                                 my $ar = ref($highlight_shebang{$key}) ?
4813                                         $highlight_shebang{$key} :
4814                                         [$highlight_shebang{key}];
4815                                 map {return $key if $shebang =~ /$_/} @$ar;
4816                         }
4817                 }
4818                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4819         }
4820
4821         $basename =~ /\.([^.]*)$/;
4822         my $ext = $1 or return undef;
4823         return $highlight_ext{$ext}
4824                 if exists $highlight_ext{$ext};
4825
4826         return undef;
4827 }
4828
4829 # run highlighter and return FD of its output,
4830 # or return original FD if no highlighting
4831 sub run_highlighter {
4832         my ($fd, $syntax) = @_;
4833         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4834
4835         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4836                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4837                 quote_command($highlight_bin).
4838                 " --replace-tabs=8 --fragment --syntax $syntax")
4839                 or die_error(500, "Couldn't open file or run syntax highlighter");
4840         if (eof $hifd) {
4841                 # just in case, should not happen as we tested !eof($fd) above
4842                 return $fd if close($hifd);
4843
4844                 # should not happen
4845                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4846
4847                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4848                 # instead of dying horribly on this, just skip the highlighting
4849                 # but do output a message about it to STDERR that will end up in the log
4850                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4851                         sprintf("child exit status 0x%x\n", $?);
4852                 return $fd
4853         }
4854         close $fd;
4855         return ($hifd, 1);
4856 }
4857
4858 ## ======================================================================
4859 ## functions printing HTML: header, footer, error page
4860
4861 sub get_page_title {
4862         my $title = to_utf8($site_name);
4863
4864         unless (defined $project) {
4865                 if (defined $project_filter) {
4866                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4867                 }
4868                 return $title;
4869         }
4870         $title .= " - " . to_utf8($project);
4871
4872         return $title unless (defined $action);
4873         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4874         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4875
4876         return $title unless (defined $file_name);
4877         $title .= " - " . esc_path($file_name);
4878         if ($action eq "tree" && $file_name !~ m|/$|) {
4879                 $title .= "/";
4880         }
4881
4882         return $title;
4883 }
4884
4885 sub get_content_type_html {
4886         # We do not ever emit application/xhtml+xml since that gives us
4887         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4888         # strict, which is troublesome for example when showing user-supplied
4889         # README.html files.
4890         return 'text/html';
4891 }
4892
4893 sub print_feed_meta {
4894         if (defined $project) {
4895                 my %href_params = get_feed_info();
4896                 if (!exists $href_params{'-title'}) {
4897                         $href_params{'-title'} = 'log';
4898                 }
4899
4900                 foreach my $format (qw(RSS Atom)) {
4901                         my $type = lc($format);
4902                         my %link_attr = (
4903                                 '-rel' => 'alternate',
4904                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4905                                 '-type' => "application/$type+xml"
4906                         );
4907
4908                         $href_params{'extra_options'} = undef;
4909                         $href_params{'action'} = $type;
4910                         $link_attr{'-href'} = href(%href_params);
4911                         print "<link ".
4912                               "rel=\"$link_attr{'-rel'}\" ".
4913                               "title=\"$link_attr{'-title'}\" ".
4914                               "href=\"$link_attr{'-href'}\" ".
4915                               "type=\"$link_attr{'-type'}\" ".
4916                               "/>\n";
4917
4918                         $href_params{'extra_options'} = '--no-merges';
4919                         $link_attr{'-href'} = href(%href_params);
4920                         $link_attr{'-title'} .= ' (no merges)';
4921                         print "<link ".
4922                               "rel=\"$link_attr{'-rel'}\" ".
4923                               "title=\"$link_attr{'-title'}\" ".
4924                               "href=\"$link_attr{'-href'}\" ".
4925                               "type=\"$link_attr{'-type'}\" ".
4926                               "/>\n";
4927                 }
4928
4929         } else {
4930                 printf('<link rel="alternate" title="%s projects list" '.
4931                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4932                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4933                 printf('<link rel="alternate" title="%s projects feeds" '.
4934                        'href="%s" type="text/x-opml" />'."\n",
4935                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4936         }
4937 }
4938
4939 sub print_header_links {
4940         my $status = shift;
4941
4942         # print out each stylesheet that exist, providing backwards capability
4943         # for those people who defined $stylesheet in a config file
4944         if (defined $stylesheet) {
4945                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4946         } else {
4947                 foreach my $stylesheet (@stylesheets) {
4948                         next unless $stylesheet;
4949                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4950                 }
4951         }
4952         print_feed_meta()
4953                 if ($status eq '200 OK');
4954         if (defined $favicon) {
4955                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4956         }
4957 }
4958
4959 sub print_nav_breadcrumbs_path {
4960         my $dirprefix = undef;
4961         while (my $part = shift) {
4962                 $dirprefix .= "/" if defined $dirprefix;
4963                 $dirprefix .= $part;
4964                 print $cgi->a({-href => href(project => undef,
4965                                              project_filter => $dirprefix,
4966                                              action => "project_list")},
4967                               esc_html($part)) . " / ";
4968         }
4969 }
4970
4971 sub print_nav_breadcrumbs {
4972         my %opts = @_;
4973
4974         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4975                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4976         }
4977         if (defined $project) {
4978                 my @dirname = split '/', $project;
4979                 my $projectbasename = pop @dirname;
4980                 print_nav_breadcrumbs_path(@dirname);
4981                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4982                 if (defined $action) {
4983                         my $action_print = $action ;
4984                         $action_print = 'blame' if $action_print eq 'blame_incremental';
4985                         if (defined $opts{-action_extra}) {
4986                                 $action_print = $cgi->a({-href => href(action=>$action)},
4987                                         $action);
4988                         }
4989                         print " / $action_print";
4990                 }
4991                 if (defined $opts{-action_extra}) {
4992                         print " / $opts{-action_extra}";
4993                 }
4994                 print "\n";
4995         } elsif (defined $project_filter) {
4996                 print_nav_breadcrumbs_path(split '/', $project_filter);
4997         }
4998 }
4999
5000 sub print_search_form {
5001         if (!defined $searchtext) {
5002                 $searchtext = "";
5003         }
5004         my $search_hash;
5005         if (defined $hash_base) {
5006                 $search_hash = $hash_base;
5007         } elsif (defined $hash) {
5008                 $search_hash = $hash;
5009         } else {
5010                 $search_hash = "HEAD";
5011         }
5012         # We can't use href() here because we need to encode the
5013         # URL parameters into the form, not into the action link.
5014         my $action = $my_uri;
5015         my $use_pathinfo = gitweb_check_feature('pathinfo');
5016         if ($use_pathinfo) {
5017                 # See notes about doubled / in href()
5018                 $action =~ s,/$,,;
5019                 $action .= "/".esc_path_info($project);
5020         }
5021         print $cgi->start_form(-method => "get", -action => $action) .
5022               "<div class=\"search\">\n" .
5023               (!$use_pathinfo &&
5024               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
5025               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
5026               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
5027               $cgi->popup_menu(-name => 'st', -default => 'commit',
5028                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
5029               " " . $cgi->a({-href => href(action=>"search_help"),
5030                              -title => "search help" }, "?") . " search:\n",
5031               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
5032               "<span title=\"Extended regular expression\">" .
5033               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5034                              -checked => $search_use_regexp) .
5035               "</span>" .
5036               "</div>" .
5037               $cgi->end_form() . "\n";
5038 }
5039
5040 sub git_header_html {
5041         my $status = shift || "200 OK";
5042         my $expires = shift;
5043         my %opts = @_;
5044
5045         my $title = get_page_title();
5046         my $content_type = get_content_type_html();
5047         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5048                            -status=> $status, -expires => $expires)
5049                 unless ($opts{'-no_http_header'});
5050         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5051         print <<EOF;
5052 <?xml version="1.0" encoding="utf-8"?>
5053 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5054 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5055 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5056 <!-- git core binaries version $git_version -->
5057 <head>
5058 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5059 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5060 <meta name="robots" content="index, nofollow"/>
5061 <title>$title</title>
5062 <script type="text/javascript">/* <![CDATA[ */
5063 function fixBlameLinks() {
5064         var allLinks = document.getElementsByTagName("a");
5065         for (var i = 0; i < allLinks.length; i++) {
5066                 var link = allLinks.item(i);
5067                 if (link.className == 'blamelink')
5068                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5069         }
5070 }
5071 /* ]]> */</script>
5072 EOF
5073         # the stylesheet, favicon etc urls won't work correctly with path_info
5074         # unless we set the appropriate base URL
5075         if ($ENV{'PATH_INFO'}) {
5076                 print "<base href=\"".esc_url($base_url)."\" />\n";
5077         }
5078         print_header_links($status);
5079
5080         if (defined $site_html_head_string) {
5081                 print to_utf8($site_html_head_string);
5082         }
5083
5084         print "</head>\n" .
5085               "<body>\n";
5086
5087         if (defined $site_header && -f $site_header) {
5088                 insert_file($site_header);
5089         }
5090
5091         print "<div class=\"page_header\">\n";
5092         if (defined $logo) {
5093                 print $cgi->a({-href => esc_url($logo_url),
5094                                -title => $logo_label},
5095                               $cgi->img({-src => esc_url($logo),
5096                                          -width => 72, -height => 27,
5097                                          -alt => "git",
5098                                          -class => "logo"}));
5099         }
5100         print_nav_breadcrumbs(%opts);
5101         print "</div>\n";
5102
5103         my $have_search = gitweb_check_feature('search');
5104         if (defined $project && $have_search) {
5105                 print_search_form();
5106         }
5107 }
5108
5109 sub compute_timed_interval {
5110         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5111         return tv_interval($t0, [ gettimeofday() ]);
5112 }
5113
5114 sub compute_commands_count {
5115         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5116         my $s = $number_of_git_cmds == 1 ? '' : 's';
5117         return '<span id="generating_cmd">'.
5118                 $number_of_git_cmds.
5119                 "</span> git command$s";
5120 }
5121
5122 sub git_footer_html {
5123         my $feed_class = 'rss_logo';
5124
5125         print "<div class=\"page_footer\">\n";
5126         if (defined $project) {
5127                 my $descr = git_get_project_description($project);
5128                 if (defined $descr) {
5129                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5130                 }
5131
5132                 my %href_params = get_feed_info();
5133                 if (!%href_params) {
5134                         $feed_class .= ' generic';
5135                 }
5136                 $href_params{'-title'} ||= 'log';
5137
5138                 foreach my $format (qw(RSS Atom)) {
5139                         $href_params{'action'} = lc($format);
5140                         print $cgi->a({-href => href(%href_params),
5141                                       -title => "$href_params{'-title'} $format feed",
5142                                       -class => $feed_class}, $format)."\n";
5143                 }
5144
5145         } else {
5146                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5147                                              project_filter => $project_filter),
5148                               -class => $feed_class}, "OPML") . " ";
5149                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5150                                              project_filter => $project_filter),
5151                               -class => $feed_class}, "TXT") . "\n";
5152         }
5153         print "</div>\n"; # class="page_footer"
5154
5155         if (defined $t0 && gitweb_check_feature('timed')) {
5156                 print "<div id=\"generating_info\">\n";
5157                 print 'This page took '.
5158                       '<span id="generating_time" class="time_span">'.
5159                       compute_timed_interval().
5160                       ' seconds </span>'.
5161                       ' and '.
5162                       compute_commands_count().
5163                       " to generate.\n";
5164                 print "</div>\n"; # class="page_footer"
5165         }
5166
5167         if (defined $site_footer && -f $site_footer) {
5168                 insert_file($site_footer);
5169         }
5170
5171         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5172         if (defined $action &&
5173             $action eq 'blame_incremental') {
5174                 print qq!<script type="text/javascript">\n!.
5175                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5176                       qq!           "!. href() .qq!");\n!.
5177                       qq!</script>\n!;
5178         } else {
5179                 my ($jstimezone, $tz_cookie, $datetime_class) =
5180                         gitweb_get_feature('javascript-timezone');
5181
5182                 print qq!<script type="text/javascript">\n!.
5183                       qq!window.onload = function () {\n!;
5184                 if (gitweb_check_feature('blame_incremental')) {
5185                         print qq!       fixBlameLinks();\n!;
5186                 }
5187                 if (gitweb_check_feature('javascript-actions')) {
5188                         print qq!       fixLinks();\n!;
5189                 }
5190                 if ($jstimezone && $tz_cookie && $datetime_class) {
5191                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5192                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5193                 }
5194                 print qq!};\n!.
5195                       qq!</script>\n!;
5196         }
5197
5198         print "</body>\n" .
5199               "</html>";
5200 }
5201
5202 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5203 # Example: die_error(404, 'Hash not found')
5204 # By convention, use the following status codes (as defined in RFC 2616):
5205 # 400: Invalid or missing CGI parameters, or
5206 #      requested object exists but has wrong type.
5207 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5208 #      this server or project.
5209 # 404: Requested object/revision/project doesn't exist.
5210 # 500: The server isn't configured properly, or
5211 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5212 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5213 # 503: The server is currently unavailable (because it is overloaded,
5214 #      or down for maintenance).  Generally, this is a temporary state.
5215 sub die_error {
5216         my $status = shift || 500;
5217         my $error = esc_html(shift) || "Internal Server Error";
5218         my $extra = shift;
5219         my %opts = @_;
5220
5221         my %http_responses = (
5222                 400 => '400 Bad Request',
5223                 403 => '403 Forbidden',
5224                 404 => '404 Not Found',
5225                 500 => '500 Internal Server Error',
5226                 503 => '503 Service Unavailable',
5227         );
5228         git_header_html($http_responses{$status}, undef, %opts);
5229         print <<EOF;
5230 <div class="page_body">
5231 <br /><br />
5232 $status - $error
5233 <br />
5234 EOF
5235         if (defined $extra) {
5236                 print "<hr />\n" .
5237                       "$extra\n";
5238         }
5239         print "</div>\n";
5240
5241         git_footer_html();
5242         goto DONE_GITWEB
5243                 unless ($opts{'-error_handler'});
5244 }
5245
5246 ## ----------------------------------------------------------------------
5247 ## functions printing or outputting HTML: navigation
5248
5249 sub git_print_page_nav {
5250         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5251         $extra = '' if !defined $extra; # pager or formats
5252
5253         my @navs = qw(summary log commit commitdiff tree refs);
5254         if ($suppress) {
5255                 @navs = grep { $_ ne $suppress } @navs;
5256         }
5257
5258         my %arg = map { $_ => {action=>$_} } @navs;
5259         if (defined $head) {
5260                 for (qw(commit commitdiff)) {
5261                         $arg{$_}{'hash'} = $head;
5262                 }
5263                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5264                         $arg{'log'}{'hash'} = $head;
5265                 }
5266         }
5267
5268         $arg{'log'}{'action'} = 'shortlog';
5269         if ($current eq 'log') {
5270                 $current = 'shortlog';
5271         } elsif ($current eq 'shortlog') {
5272                 $current = 'log';
5273         }
5274         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5275         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5276
5277         my @actions = gitweb_get_feature('actions');
5278         my $escname = $project;
5279         $escname =~ s/[+]/%2B/g;
5280         my %repl = (
5281                 '%' => '%',
5282                 'n' => $project,         # project name
5283                 'f' => $git_dir,         # project path within filesystem
5284                 'h' => $treehead || '',  # current hash ('h' parameter)
5285                 'b' => $treebase || '',  # hash base ('hb' parameter)
5286                 'e' => $escname,         # project name with '+' escaped
5287         );
5288         while (@actions) {
5289                 my ($label, $link, $pos) = splice(@actions,0,3);
5290                 # insert
5291                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5292                 # munch munch
5293                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5294                 $arg{$label}{'_href'} = $link;
5295         }
5296
5297         print "<div class=\"page_nav\">\n" .
5298                 (join " | ",
5299                  map { $_ eq $current ?
5300                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
5301                  } @navs);
5302         print "<br/>\n$extra<br/>\n" .
5303               "</div>\n";
5304 }
5305
5306 # returns a submenu for the nagivation of the refs views (tags, heads,
5307 # remotes) with the current view disabled and the remotes view only
5308 # available if the feature is enabled
5309 sub format_ref_views {
5310         my ($current) = @_;
5311         my @ref_views = qw{tags heads};
5312         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5313         return join " | ", map {
5314                 $_ eq $current ? $_ :
5315                 $cgi->a({-href => href(action=>$_)}, $_)
5316         } @ref_views
5317 }
5318
5319 sub format_paging_nav {
5320         my ($action, $page, $has_next_link) = @_;
5321         my $paging_nav;
5322
5323
5324         if ($page > 0) {
5325                 $paging_nav .=
5326                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
5327                         " &#183; " .
5328                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5329                                  -accesskey => "p", -title => "Alt-p"}, "prev");
5330         } else {
5331                 $paging_nav .= "first &#183; prev";
5332         }
5333
5334         if ($has_next_link) {
5335                 $paging_nav .= " &#183; " .
5336                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5337                                  -accesskey => "n", -title => "Alt-n"}, "next");
5338         } else {
5339                 $paging_nav .= " &#183; next";
5340         }
5341
5342         return $paging_nav;
5343 }
5344
5345 sub format_log_nav {
5346         my ($action, $page, $has_next_link) = @_;
5347         my $paging_nav;
5348
5349         if ($action eq 'shortlog') {
5350                 $paging_nav .= 'shortlog';
5351         } else {
5352                 $paging_nav .= $cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog');
5353         }
5354         $paging_nav .= ' | ';
5355         if ($action eq 'log') {
5356                 $paging_nav .= 'fulllog';
5357         } else {
5358                 $paging_nav .= $cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog');
5359         }
5360
5361         $paging_nav .= " | " . format_paging_nav($action, $page, $has_next_link);
5362         return $paging_nav;
5363 }
5364
5365 ## ......................................................................
5366 ## functions printing or outputting HTML: div
5367
5368 sub git_print_header_div {
5369         my ($action, $title, $hash, $hash_base, $extra) = @_;
5370         my %args = ();
5371         defined $extra or $extra = '';
5372
5373         $args{'action'} = $action;
5374         $args{'hash'} = $hash if $hash;
5375         $args{'hash_base'} = $hash_base if $hash_base;
5376
5377         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5378                             $title ? $title : $action);
5379         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5380         print "<div class=\"header\">\n" . '<span class="title">' .
5381               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5382 }
5383
5384 sub format_repo_url {
5385         my ($name, $url) = @_;
5386         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5387 }
5388
5389 # Group output by placing it in a DIV element and adding a header.
5390 # Options for start_div() can be provided by passing a hash reference as the
5391 # first parameter to the function.
5392 # Options to git_print_header_div() can be provided by passing an array
5393 # reference. This must follow the options to start_div if they are present.
5394 # The content can be a scalar, which is output as-is, a scalar reference, which
5395 # is output after html escaping, an IO handle passed either as *handle or
5396 # *handle{IO}, or a function reference. In the latter case all following
5397 # parameters will be taken as argument to the content function call.
5398 sub git_print_section {
5399         my ($div_args, $header_args, $content);
5400         my $arg = shift;
5401         if (ref($arg) eq 'HASH') {
5402                 $div_args = $arg;
5403                 $arg = shift;
5404         }
5405         if (ref($arg) eq 'ARRAY') {
5406                 $header_args = $arg;
5407                 $arg = shift;
5408         }
5409         $content = $arg;
5410
5411         print $cgi->start_div($div_args);
5412         git_print_header_div(@$header_args);
5413
5414         if (ref($content) eq 'CODE') {
5415                 $content->(@_);
5416         } elsif (ref($content) eq 'SCALAR') {
5417                 print esc_html($$content);
5418         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5419                 while (<$content>) {
5420                         print to_utf8($_);
5421                 }
5422         } elsif (!ref($content) && defined($content)) {
5423                 print $content;
5424         }
5425
5426         print $cgi->end_div;
5427 }
5428
5429 sub format_timestamp_html {
5430         my $date = shift;
5431         my $useatnight = shift;
5432         defined($useatnight) or $useatnight = 1;
5433         my $strtime = $date->{'rfc2822'};
5434
5435         my (undef, undef, $datetime_class) =
5436                 gitweb_get_feature('javascript-timezone');
5437         if ($datetime_class) {
5438                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5439         }
5440
5441         my $localtime_format = '(%d %02d:%02d %s)';
5442         if ($useatnight && $date->{'hour_local'} < 6) {
5443                 $localtime_format = '(%d <span class="atnight">%02d:%02d</span> %s)';
5444         }
5445         $strtime .= ' ' .
5446                     sprintf($localtime_format, $date->{'mday_local'},
5447                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5448
5449         return $strtime;
5450 }
5451
5452 sub format_lastrefresh_row {
5453         return "<?gitweb format_lastrefresh_row?>" if $cache_mode_active;
5454         my %rd = parse_file_date('.last_refresh');
5455         if (defined $rd{'rfc2822'}) {
5456                 return "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
5457                        "<td>".format_timestamp_html(\%rd,0)."</td></tr>";
5458         }
5459         return "";
5460 }
5461
5462 # Outputs the author name and date in long form
5463 sub git_print_authorship {
5464         my $co = shift;
5465         my %opts = @_;
5466         my $tag = $opts{-tag} || 'div';
5467         my $author = $co->{'author_name'};
5468
5469         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5470         print "<$tag class=\"author_date\">" .
5471               format_search_author($author, "author", esc_html($author)) .
5472               " [".format_timestamp_html(\%ad)."]".
5473               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5474               "</$tag>\n";
5475 }
5476
5477 # Outputs table rows containing the full author or committer information,
5478 # in the format expected for 'commit' view (& similar).
5479 # Parameters are a commit hash reference, followed by the list of people
5480 # to output information for. If the list is empty it defaults to both
5481 # author and committer.
5482 sub git_print_authorship_rows {
5483         my $co = shift;
5484         # too bad we can't use @people = @_ || ('author', 'committer')
5485         my @people = @_;
5486         @people = ('author', 'committer') unless @people;
5487         foreach my $who (@people) {
5488                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5489                 print "<tr><td>$who</td><td>" .
5490                       format_search_author($co->{"${who}_name"}, $who,
5491                                            esc_html($co->{"${who}_name"})) . " " .
5492                       format_search_author($co->{"${who}_email"}, $who,
5493                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5494                       "</td><td rowspan=\"2\">" .
5495                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5496                       "</td></tr>\n" .
5497                       "<tr>" .
5498                       "<td></td><td>" .
5499                       format_timestamp_html(\%wd) .
5500                       "</td>" .
5501                       "</tr>\n";
5502         }
5503 }
5504
5505 sub git_print_page_path {
5506         my $name = shift;
5507         my $type = shift;
5508         my $hb = shift;
5509
5510
5511         print "<div class=\"page_path\">";
5512         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5513                       -title => 'tree root'}, to_utf8("[$project]"));
5514         print " / ";
5515         if (defined $name) {
5516                 my @dirname = split '/', $name;
5517                 my $basename = pop @dirname;
5518                 my $fullname = '';
5519
5520                 foreach my $dir (@dirname) {
5521                         $fullname .= ($fullname ? '/' : '') . $dir;
5522                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5523                                                      hash_base=>$hb),
5524                                       -title => $fullname}, esc_path($dir));
5525                         print " / ";
5526                 }
5527                 if (defined $type && $type eq 'blob') {
5528                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5529                                                      hash_base=>$hb),
5530                                       -title => $name}, esc_path($basename));
5531                 } elsif (defined $type && $type eq 'tree') {
5532                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5533                                                      hash_base=>$hb),
5534                                       -title => $name}, esc_path($basename));
5535                         print " / ";
5536                 } else {
5537                         print esc_path($basename);
5538                 }
5539         }
5540         print "<br/></div>\n";
5541 }
5542
5543 sub git_print_log {
5544         my $log = shift;
5545         my %opts = @_;
5546
5547         if ($opts{'-remove_title'}) {
5548                 # remove title, i.e. first line of log
5549                 shift @$log;
5550         }
5551         # remove leading empty lines
5552         while (defined $log->[0] && $log->[0] eq "") {
5553                 shift @$log;
5554         }
5555
5556         # print log
5557         my $skip_blank_line = 0;
5558         foreach my $line (@$log) {
5559                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5560                         if (! $opts{'-remove_signoff'}) {
5561                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5562                                 $skip_blank_line = 1;
5563                         }
5564                         next;
5565                 }
5566
5567                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5568                         if (! $opts{'-remove_signoff'}) {
5569                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5570                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5571                                         "</span><br/>\n";
5572                                 $skip_blank_line = 1;
5573                         }
5574                         next;
5575                 }
5576
5577                 # print only one empty line
5578                 # do not print empty line after signoff
5579                 if ($line eq "") {
5580                         next if ($skip_blank_line);
5581                         $skip_blank_line = 1;
5582                 } else {
5583                         $skip_blank_line = 0;
5584                 }
5585
5586                 print format_log_line_html($line) . "<br/>\n";
5587         }
5588
5589         if ($opts{'-final_empty_line'}) {
5590                 # end with single empty line
5591                 print "<br/>\n" unless $skip_blank_line;
5592         }
5593 }
5594
5595 # return link target (what link points to)
5596 sub git_get_link_target {
5597         my $hash = shift;
5598         my $link_target;
5599
5600         # read link
5601         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5602                 or return;
5603         {
5604                 local $/ = undef;
5605                 $link_target = to_utf8(scalar <$fd>);
5606         }
5607         close $fd
5608                 or return;
5609
5610         return $link_target;
5611 }
5612
5613 # given link target, and the directory (basedir) the link is in,
5614 # return target of link relative to top directory (top tree);
5615 # return undef if it is not possible (including absolute links).
5616 sub normalize_link_target {
5617         my ($link_target, $basedir) = @_;
5618
5619         # absolute symlinks (beginning with '/') cannot be normalized
5620         return if (substr($link_target, 0, 1) eq '/');
5621
5622         # normalize link target to path from top (root) tree (dir)
5623         my $path;
5624         if ($basedir) {
5625                 $path = $basedir . '/' . $link_target;
5626         } else {
5627                 # we are in top (root) tree (dir)
5628                 $path = $link_target;
5629         }
5630
5631         # remove //, /./, and /../
5632         my @path_parts;
5633         foreach my $part (split('/', $path)) {
5634                 # discard '.' and ''
5635                 next if (!$part || $part eq '.');
5636                 # handle '..'
5637                 if ($part eq '..') {
5638                         if (@path_parts) {
5639                                 pop @path_parts;
5640                         } else {
5641                                 # link leads outside repository (outside top dir)
5642                                 return;
5643                         }
5644                 } else {
5645                         push @path_parts, $part;
5646                 }
5647         }
5648         $path = join('/', @path_parts);
5649
5650         return $path;
5651 }
5652
5653 # print tree entry (row of git_tree), but without encompassing <tr> element
5654 sub git_print_tree_entry {
5655         my ($t, $basedir, $hash_base, $have_blame) = @_;
5656
5657         my %base_key = ();
5658         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5659
5660         # The format of a table row is: mode list link.  Where mode is
5661         # the mode of the entry, list is the name of the entry, an href,
5662         # and link is the action links of the entry.
5663
5664         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5665         if (exists $t->{'size'}) {
5666                 print "<td class=\"size\">$t->{'size'}</td>\n";
5667         }
5668         if ($t->{'type'} eq "blob") {
5669                 print "<td class=\"list\">" .
5670                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5671                                                file_name=>"$basedir$t->{'name'}", %base_key),
5672                                 -class => "list"}, esc_path($t->{'name'}));
5673                 if (S_ISLNK(oct $t->{'mode'})) {
5674                         my $link_target = git_get_link_target($t->{'hash'});
5675                         if ($link_target) {
5676                                 my $norm_target = normalize_link_target($link_target, $basedir);
5677                                 if (defined $norm_target) {
5678                                         print " -> " .
5679                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5680                                                                      file_name=>$norm_target),
5681                                                        -title => $norm_target}, esc_path($link_target));
5682                                 } else {
5683                                         print " -> " . esc_path($link_target);
5684                                 }
5685                         }
5686                 }
5687                 print "</td>\n";
5688                 print "<td class=\"link\">";
5689                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5690                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5691                               "blob");
5692                 if ($have_blame) {
5693                         print " | " .
5694                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5695                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5696                                       -class => "blamelink"},
5697                                       "blame");
5698                 }
5699                 if (defined $hash_base) {
5700                         print " | " .
5701                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5702                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5703                                       "history");
5704                 }
5705                 print " | " .
5706                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5707                                                file_name=>"$basedir$t->{'name'}")},
5708                                 "raw");
5709                 print "</td>\n";
5710
5711         } elsif ($t->{'type'} eq "tree") {
5712                 print "<td class=\"list\">";
5713                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5714                                              file_name=>"$basedir$t->{'name'}",
5715                                              %base_key)},
5716                               esc_path($t->{'name'}));
5717                 print "</td>\n";
5718                 print "<td class=\"link\">";
5719                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5720                                              file_name=>"$basedir$t->{'name'}",
5721                                              %base_key)},
5722                               "tree");
5723                 if (defined $hash_base) {
5724                         print " | " .
5725                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5726                                                      file_name=>"$basedir$t->{'name'}")},
5727                                       "history");
5728                 }
5729                 print "</td>\n";
5730         } else {
5731                 # unknown object: we can only present history for it
5732                 # (this includes 'commit' object, i.e. submodule support)
5733                 print "<td class=\"list\">" .
5734                       esc_path($t->{'name'}) .
5735                       "</td>\n";
5736                 print "<td class=\"link\">";
5737                 if (defined $hash_base) {
5738                         print $cgi->a({-href => href(action=>"history",
5739                                                      hash_base=>$hash_base,
5740                                                      file_name=>"$basedir$t->{'name'}")},
5741                                       "history");
5742                 }
5743                 print "</td>\n";
5744         }
5745 }
5746
5747 ## ......................................................................
5748 ## functions printing large fragments of HTML
5749
5750 # get pre-image filenames for merge (combined) diff
5751 sub fill_from_file_info {
5752         my ($diff, @parents) = @_;
5753
5754         $diff->{'from_file'} = [ ];
5755         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5756         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5757                 if ($diff->{'status'}[$i] eq 'R' ||
5758                     $diff->{'status'}[$i] eq 'C') {
5759                         $diff->{'from_file'}[$i] =
5760                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5761                 }
5762         }
5763
5764         return $diff;
5765 }
5766
5767 # is current raw difftree line of file deletion
5768 sub is_deleted {
5769         my $diffinfo = shift;
5770
5771         return $diffinfo->{'to_id'} eq ('0' x 40);
5772 }
5773
5774 # does patch correspond to [previous] difftree raw line
5775 # $diffinfo  - hashref of parsed raw diff format
5776 # $patchinfo - hashref of parsed patch diff format
5777 #              (the same keys as in $diffinfo)
5778 sub is_patch_split {
5779         my ($diffinfo, $patchinfo) = @_;
5780
5781         return defined $diffinfo && defined $patchinfo
5782                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5783 }
5784
5785
5786 sub git_difftree_body {
5787         my ($difftree, $hash, @parents) = @_;
5788         my ($parent) = $parents[0];
5789         my $have_blame = gitweb_check_feature('blame');
5790         print "<div class=\"list_head\">\n";
5791         if ($#{$difftree} > 10) {
5792                 print(($#{$difftree} + 1) . " files changed:\n");
5793         }
5794         print "</div>\n";
5795
5796         print "<table class=\"" .
5797               (@parents > 1 ? "combined " : "") .
5798               "diff_tree\">\n";
5799
5800         # header only for combined diff in 'commitdiff' view
5801         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5802         if ($has_header) {
5803                 # table header
5804                 print "<thead><tr>\n" .
5805                        "<th></th><th></th>\n"; # filename, patchN link
5806                 for (my $i = 0; $i < @parents; $i++) {
5807                         my $par = $parents[$i];
5808                         print "<th>" .
5809                               $cgi->a({-href => href(action=>"commitdiff",
5810                                                      hash=>$hash, hash_parent=>$par),
5811                                        -title => 'commitdiff to parent number ' .
5812                                                   ($i+1) . ': ' . substr($par,0,7)},
5813                                       $i+1) .
5814                               "&#160;</th>\n";
5815                 }
5816                 print "</tr></thead>\n<tbody>\n";
5817         }
5818
5819         my $alternate = 1;
5820         my $patchno = 0;
5821         foreach my $line (@{$difftree}) {
5822                 my $diff = parsed_difftree_line($line);
5823
5824                 if ($alternate) {
5825                         print "<tr class=\"dark\">\n";
5826                 } else {
5827                         print "<tr class=\"light\">\n";
5828                 }
5829                 $alternate ^= 1;
5830
5831                 if (exists $diff->{'nparents'}) { # combined diff
5832
5833                         fill_from_file_info($diff, @parents)
5834                                 unless exists $diff->{'from_file'};
5835
5836                         if (!is_deleted($diff)) {
5837                                 # file exists in the result (child) commit
5838                                 print "<td>" .
5839                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5840                                                              file_name=>$diff->{'to_file'},
5841                                                              hash_base=>$hash),
5842                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5843                                       "</td>\n";
5844                         } else {
5845                                 print "<td>" .
5846                                       esc_path($diff->{'to_file'}) .
5847                                       "</td>\n";
5848                         }
5849
5850                         if ($action eq 'commitdiff') {
5851                                 # link to patch
5852                                 $patchno++;
5853                                 print "<td class=\"link\">" .
5854                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5855                                               "patch") .
5856                                       " | " .
5857                                       "</td>\n";
5858                         }
5859
5860                         my $has_history = 0;
5861                         my $not_deleted = 0;
5862                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5863                                 my $hash_parent = $parents[$i];
5864                                 my $from_hash = $diff->{'from_id'}[$i];
5865                                 my $from_path = $diff->{'from_file'}[$i];
5866                                 my $status = $diff->{'status'}[$i];
5867
5868                                 $has_history ||= ($status ne 'A');
5869                                 $not_deleted ||= ($status ne 'D');
5870
5871                                 if ($status eq 'A') {
5872                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
5873                                 } elsif ($status eq 'D') {
5874                                         print "<td class=\"link\">" .
5875                                               $cgi->a({-href => href(action=>"blob",
5876                                                                      hash_base=>$hash,
5877                                                                      hash=>$from_hash,
5878                                                                      file_name=>$from_path)},
5879                                                       "blob" . ($i+1)) .
5880                                               " | </td>\n";
5881                                 } else {
5882                                         if ($diff->{'to_id'} eq $from_hash) {
5883                                                 print "<td class=\"link nochange\">";
5884                                         } else {
5885                                                 print "<td class=\"link\">";
5886                                         }
5887                                         print $cgi->a({-href => href(action=>"blobdiff",
5888                                                                      hash=>$diff->{'to_id'},
5889                                                                      hash_parent=>$from_hash,
5890                                                                      hash_base=>$hash,
5891                                                                      hash_parent_base=>$hash_parent,
5892                                                                      file_name=>$diff->{'to_file'},
5893                                                                      file_parent=>$from_path)},
5894                                                       "diff" . ($i+1)) .
5895                                               " | </td>\n";
5896                                 }
5897                         }
5898
5899                         print "<td class=\"link\">";
5900                         if ($not_deleted) {
5901                                 print $cgi->a({-href => href(action=>"blob",
5902                                                              hash=>$diff->{'to_id'},
5903                                                              file_name=>$diff->{'to_file'},
5904                                                              hash_base=>$hash)},
5905                                               "blob");
5906                                 print " | " if ($has_history);
5907                         }
5908                         if ($has_history) {
5909                                 print $cgi->a({-href => href(action=>"history",
5910                                                              file_name=>$diff->{'to_file'},
5911                                                              hash_base=>$hash)},
5912                                               "history");
5913                         }
5914                         print "</td>\n";
5915
5916                         print "</tr>\n";
5917                         next; # instead of 'else' clause, to avoid extra indent
5918                 }
5919                 # else ordinary diff
5920
5921                 my ($to_mode_oct, $to_mode_str, $to_file_type);
5922                 my ($from_mode_oct, $from_mode_str, $from_file_type);
5923                 if ($diff->{'to_mode'} ne ('0' x 6)) {
5924                         $to_mode_oct = oct $diff->{'to_mode'};
5925                         if (S_ISREG($to_mode_oct)) { # only for regular file
5926                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
5927                         }
5928                         $to_file_type = file_type($diff->{'to_mode'});
5929                 }
5930                 if ($diff->{'from_mode'} ne ('0' x 6)) {
5931                         $from_mode_oct = oct $diff->{'from_mode'};
5932                         if (S_ISREG($from_mode_oct)) { # only for regular file
5933                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
5934                         }
5935                         $from_file_type = file_type($diff->{'from_mode'});
5936                 }
5937
5938                 if ($diff->{'status'} eq "A") { # created
5939                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
5940                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
5941                         $mode_chng   .= "]</span>";
5942                         print "<td>";
5943                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5944                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5945                                       -class => "list"}, esc_path($diff->{'file'}));
5946                         print "</td>\n";
5947                         print "<td>$mode_chng</td>\n";
5948                         print "<td class=\"link\">";
5949                         if ($action eq 'commitdiff') {
5950                                 # link to patch
5951                                 $patchno++;
5952                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5953                                               "patch") .
5954                                       " | ";
5955                         }
5956                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5957                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5958                                       "blob");
5959                         print "</td>\n";
5960
5961                 } elsif ($diff->{'status'} eq "D") { # deleted
5962                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5963                         print "<td>";
5964                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5965                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
5966                                        -class => "list"}, esc_path($diff->{'file'}));
5967                         print "</td>\n";
5968                         print "<td>$mode_chng</td>\n";
5969                         print "<td class=\"link\">";
5970                         if ($action eq 'commitdiff') {
5971                                 # link to patch
5972                                 $patchno++;
5973                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5974                                               "patch") .
5975                                       " | ";
5976                         }
5977                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5978                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
5979                                       "blob") . " | ";
5980                         if ($have_blame) {
5981                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5982                                                              file_name=>$diff->{'file'}),
5983                                               -class => "blamelink"},
5984                                               "blame") . " | ";
5985                         }
5986                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5987                                                      file_name=>$diff->{'file'})},
5988                                       "history");
5989                         print "</td>\n";
5990
5991                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5992                         my $mode_chnge = "";
5993                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5994                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5995                                 if ($from_file_type ne $to_file_type) {
5996                                         $mode_chnge .= " from $from_file_type to $to_file_type";
5997                                 }
5998                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
5999                                         if ($from_mode_str && $to_mode_str) {
6000                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
6001                                         } elsif ($to_mode_str) {
6002                                                 $mode_chnge .= " mode: $to_mode_str";
6003                                         }
6004                                 }
6005                                 $mode_chnge .= "]</span>\n";
6006                         }
6007                         print "<td>";
6008                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6009                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6010                                       -class => "list"}, esc_path($diff->{'file'}));
6011                         print "</td>\n";
6012                         print "<td>$mode_chnge</td>\n";
6013                         print "<td class=\"link\">";
6014                         if ($action eq 'commitdiff') {
6015                                 # link to patch
6016                                 $patchno++;
6017                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6018                                               "patch") .
6019                                       " | ";
6020                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6021                                 # "commit" view and modified file (not onlu mode changed)
6022                                 print $cgi->a({-href => href(action=>"blobdiff",
6023                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6024                                                              hash_base=>$hash, hash_parent_base=>$parent,
6025                                                              file_name=>$diff->{'file'})},
6026                                               "diff") .
6027                                       " | ";
6028                         }
6029                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6030                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6031                                        "blob") . " | ";
6032                         if ($have_blame) {
6033                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6034                                                              file_name=>$diff->{'file'}),
6035                                               -class => "blamelink"},
6036                                               "blame") . " | ";
6037                         }
6038                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6039                                                      file_name=>$diff->{'file'})},
6040                                       "history");
6041                         print "</td>\n";
6042
6043                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6044                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6045                         my $nstatus = $status_name{$diff->{'status'}};
6046                         my $mode_chng = "";
6047                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6048                                 # mode also for directories, so we cannot use $to_mode_str
6049                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6050                         }
6051                         print "<td>" .
6052                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6053                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6054                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6055                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6056                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6057                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6058                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6059                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6060                               "<td class=\"link\">";
6061                         if ($action eq 'commitdiff') {
6062                                 # link to patch
6063                                 $patchno++;
6064                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6065                                               "patch") .
6066                                       " | ";
6067                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6068                                 # "commit" view and modified file (not only pure rename or copy)
6069                                 print $cgi->a({-href => href(action=>"blobdiff",
6070                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6071                                                              hash_base=>$hash, hash_parent_base=>$parent,
6072                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6073                                               "diff") .
6074                                       " | ";
6075                         }
6076                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6077                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6078                                       "blob") . " | ";
6079                         if ($have_blame) {
6080                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6081                                                              file_name=>$diff->{'to_file'}),
6082                                               -class => "blamelink"},
6083                                               "blame") . " | ";
6084                         }
6085                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6086                                                     file_name=>$diff->{'to_file'})},
6087                                       "history");
6088                         print "</td>\n";
6089
6090                 } # we should not encounter Unmerged (U) or Unknown (X) status
6091                 print "</tr>\n";
6092         }
6093         print "</tbody>" if $has_header;
6094         print "</table>\n";
6095 }
6096
6097 # Print context lines and then rem/add lines in a side-by-side manner.
6098 sub print_sidebyside_diff_lines {
6099         my ($ctx, $rem, $add) = @_;
6100
6101         # print context block before add/rem block
6102         if (@$ctx) {
6103                 print join '',
6104                         '<div class="chunk_block ctx">',
6105                                 '<div class="old">',
6106                                 @$ctx,
6107                                 '</div>',
6108                                 '<div class="new">',
6109                                 @$ctx,
6110                                 '</div>',
6111                         '</div>';
6112         }
6113
6114         if (!@$add) {
6115                 # pure removal
6116                 print join '',
6117                         '<div class="chunk_block rem">',
6118                                 '<div class="old">',
6119                                 @$rem,
6120                                 '</div>',
6121                         '</div>';
6122         } elsif (!@$rem) {
6123                 # pure addition
6124                 print join '',
6125                         '<div class="chunk_block add">',
6126                                 '<div class="new">',
6127                                 @$add,
6128                                 '</div>',
6129                         '</div>';
6130         } else {
6131                 print join '',
6132                         '<div class="chunk_block chg">',
6133                                 '<div class="old">',
6134                                 @$rem,
6135                                 '</div>',
6136                                 '<div class="new">',
6137                                 @$add,
6138                                 '</div>',
6139                         '</div>';
6140         }
6141 }
6142
6143 # Print context lines and then rem/add lines in inline manner.
6144 sub print_inline_diff_lines {
6145         my ($ctx, $rem, $add) = @_;
6146
6147         print @$ctx, @$rem, @$add;
6148 }
6149
6150 # Format removed and added line, mark changed part and HTML-format them.
6151 # Implementation is based on contrib/diff-highlight
6152 sub format_rem_add_lines_pair {
6153         my ($rem, $add, $num_parents) = @_;
6154
6155         # We need to untabify lines before split()'ing them;
6156         # otherwise offsets would be invalid.
6157         chomp $rem;
6158         chomp $add;
6159         $rem = untabify($rem);
6160         $add = untabify($add);
6161
6162         my @rem = split(//, $rem);
6163         my @add = split(//, $add);
6164         my ($esc_rem, $esc_add);
6165         # Ignore leading +/- characters for each parent.
6166         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6167         my ($prefix_has_nonspace, $suffix_has_nonspace);
6168
6169         my $shorter = (@rem < @add) ? @rem : @add;
6170         while ($prefix_len < $shorter) {
6171                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6172
6173                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6174                 $prefix_len++;
6175         }
6176
6177         while ($prefix_len + $suffix_len < $shorter) {
6178                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6179
6180                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6181                 $suffix_len++;
6182         }
6183
6184         # Mark lines that are different from each other, but have some common
6185         # part that isn't whitespace.  If lines are completely different, don't
6186         # mark them because that would make output unreadable, especially if
6187         # diff consists of multiple lines.
6188         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6189                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6190                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6191                 $esc_add = esc_html_hl_regions($add, 'marked',
6192                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6193         } else {
6194                 $esc_rem = esc_html($rem, -nbsp=>1);
6195                 $esc_add = esc_html($add, -nbsp=>1);
6196         }
6197
6198         return format_diff_line(\$esc_rem, 'rem'),
6199                format_diff_line(\$esc_add, 'add');
6200 }
6201
6202 # HTML-format diff context, removed and added lines.
6203 sub format_ctx_rem_add_lines {
6204         my ($ctx, $rem, $add, $num_parents) = @_;
6205         my (@new_ctx, @new_rem, @new_add);
6206         my $can_highlight = 0;
6207         my $is_combined = ($num_parents > 1);
6208
6209         # Highlight if every removed line has a corresponding added line.
6210         if (@$add > 0 && @$add == @$rem) {
6211                 $can_highlight = 1;
6212
6213                 # Highlight lines in combined diff only if the chunk contains
6214                 # diff between the same version, e.g.
6215                 #
6216                 #    - a
6217                 #   -  b
6218                 #    + c
6219                 #   +  d
6220                 #
6221                 # Otherwise the highlightling would be confusing.
6222                 if ($is_combined) {
6223                         for (my $i = 0; $i < @$add; $i++) {
6224                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6225                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6226
6227                                 $prefix_rem =~ s/-/+/g;
6228
6229                                 if ($prefix_rem ne $prefix_add) {
6230                                         $can_highlight = 0;
6231                                         last;
6232                                 }
6233                         }
6234                 }
6235         }
6236
6237         if ($can_highlight) {
6238                 for (my $i = 0; $i < @$add; $i++) {
6239                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6240                                 $rem->[$i], $add->[$i], $num_parents);
6241                         push @new_rem, $line_rem;
6242                         push @new_add, $line_add;
6243                 }
6244         } else {
6245                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6246                 @new_add = map { format_diff_line($_, 'add') } @$add;
6247         }
6248
6249         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6250
6251         return (\@new_ctx, \@new_rem, \@new_add);
6252 }
6253
6254 # Print context lines and then rem/add lines.
6255 sub print_diff_lines {
6256         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6257         my $is_combined = $num_parents > 1;
6258
6259         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6260                 $num_parents);
6261
6262         if ($diff_style eq 'sidebyside' && !$is_combined) {
6263                 print_sidebyside_diff_lines($ctx, $rem, $add);
6264         } else {
6265                 # default 'inline' style and unknown styles
6266                 print_inline_diff_lines($ctx, $rem, $add);
6267         }
6268 }
6269
6270 sub print_diff_chunk {
6271         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6272         my (@ctx, @rem, @add);
6273
6274         # The class of the previous line.
6275         my $prev_class = '';
6276
6277         return unless @chunk;
6278
6279         # incomplete last line might be among removed or added lines,
6280         # or both, or among context lines: find which
6281         for (my $i = 1; $i < @chunk; $i++) {
6282                 if ($chunk[$i][0] eq 'incomplete') {
6283                         $chunk[$i][0] = $chunk[$i-1][0];
6284                 }
6285         }
6286
6287         # guardian
6288         push @chunk, ["", ""];
6289
6290         foreach my $line_info (@chunk) {
6291                 my ($class, $line) = @$line_info;
6292
6293                 # print chunk headers
6294                 if ($class && $class eq 'chunk_header') {
6295                         print format_diff_line($line, $class, $from, $to);
6296                         next;
6297                 }
6298
6299                 ## print from accumulator when have some add/rem lines or end
6300                 # of chunk (flush context lines), or when have add and rem
6301                 # lines and new block is reached (otherwise add/rem lines could
6302                 # be reordered)
6303                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6304                     (@rem && @add && $class ne $prev_class)) {
6305                         print_diff_lines(\@ctx, \@rem, \@add,
6306                                          $diff_style, $num_parents);
6307                         @ctx = @rem = @add = ();
6308                 }
6309
6310                 ## adding lines to accumulator
6311                 # guardian value
6312                 last unless $line;
6313                 # rem, add or change
6314                 if ($class eq 'rem') {
6315                         push @rem, $line;
6316                 } elsif ($class eq 'add') {
6317                         push @add, $line;
6318                 }
6319                 # context line
6320                 if ($class eq 'ctx') {
6321                         push @ctx, $line;
6322                 }
6323
6324                 $prev_class = $class;
6325         }
6326 }
6327
6328 sub git_patchset_body {
6329         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6330         my ($hash_parent) = $hash_parents[0];
6331
6332         my $is_combined = (@hash_parents > 1);
6333         my $patch_idx = 0;
6334         my $patch_number = 0;
6335         my $patch_line;
6336         my $diffinfo;
6337         my $to_name;
6338         my (%from, %to);
6339         my @chunk; # for side-by-side diff
6340
6341         print "<div class=\"patchset\">\n";
6342
6343         # skip to first patch
6344         while ($patch_line = to_utf8(scalar <$fd>)) {
6345                 chomp $patch_line;
6346
6347                 last if ($patch_line =~ m/^diff /);
6348         }
6349
6350  PATCH:
6351         while ($patch_line) {
6352
6353                 # parse "git diff" header line
6354                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6355                         # $1 is from_name, which we do not use
6356                         $to_name = unquote($2);
6357                         $to_name =~ s!^b/!!;
6358                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6359                         # $1 is 'cc' or 'combined', which we do not use
6360                         $to_name = unquote($2);
6361                 } else {
6362                         $to_name = undef;
6363                 }
6364
6365                 # check if current patch belong to current raw line
6366                 # and parse raw git-diff line if needed
6367                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6368                         # this is continuation of a split patch
6369                         print "<div class=\"patch cont\">\n";
6370                 } else {
6371                         # advance raw git-diff output if needed
6372                         $patch_idx++ if defined $diffinfo;
6373
6374                         # read and prepare patch information
6375                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6376
6377                         # compact combined diff output can have some patches skipped
6378                         # find which patch (using pathname of result) we are at now;
6379                         if ($is_combined) {
6380                                 while ($to_name ne $diffinfo->{'to_file'}) {
6381                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6382                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6383                                               "</div>\n";  # class="patch"
6384
6385                                         $patch_idx++;
6386                                         $patch_number++;
6387
6388                                         last if $patch_idx > $#$difftree;
6389                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6390                                 }
6391                         }
6392
6393                         # modifies %from, %to hashes
6394                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6395
6396                         # this is first patch for raw difftree line with $patch_idx index
6397                         # we index @$difftree array from 0, but number patches from 1
6398                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6399                 }
6400
6401                 # git diff header
6402                 #assert($patch_line =~ m/^diff /) if DEBUG;
6403                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6404                 $patch_number++;
6405                 # print "git diff" header
6406                 print format_git_diff_header_line($patch_line, $diffinfo,
6407                                                   \%from, \%to);
6408
6409                 # print extended diff header
6410                 print "<div class=\"diff extended_header\">\n";
6411         EXTENDED_HEADER:
6412                 while ($patch_line = to_utf8(scalar<$fd>)) {
6413                         chomp $patch_line;
6414
6415                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6416
6417                         print format_extended_diff_header_line($patch_line, $diffinfo,
6418                                                                \%from, \%to);
6419                 }
6420                 print "</div>\n"; # class="diff extended_header"
6421
6422                 # from-file/to-file diff header
6423                 if (! $patch_line) {
6424                         print "</div>\n"; # class="patch"
6425                         last PATCH;
6426                 }
6427                 next PATCH if ($patch_line =~ m/^diff /);
6428                 #assert($patch_line =~ m/^---/) if DEBUG;
6429
6430                 my $last_patch_line = $patch_line;
6431                 $patch_line = to_utf8(scalar <$fd>);
6432                 chomp $patch_line;
6433                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6434
6435                 print format_diff_from_to_header($last_patch_line, $patch_line,
6436                                                  $diffinfo, \%from, \%to,
6437                                                  @hash_parents);
6438
6439                 # the patch itself
6440         LINE:
6441                 while ($patch_line = to_utf8(scalar <$fd>)) {
6442                         chomp $patch_line;
6443
6444                         next PATCH if ($patch_line =~ m/^diff /);
6445
6446                         my $class = diff_line_class($patch_line, \%from, \%to);
6447
6448                         if ($class eq 'chunk_header') {
6449                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6450                                 @chunk = ();
6451                         }
6452
6453                         push @chunk, [ $class, $patch_line ];
6454                 }
6455
6456         } continue {
6457                 if (@chunk) {
6458                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6459                         @chunk = ();
6460                 }
6461                 print "</div>\n"; # class="patch"
6462         }
6463
6464         # for compact combined (--cc) format, with chunk and patch simplification
6465         # the patchset might be empty, but there might be unprocessed raw lines
6466         for (++$patch_idx if $patch_number > 0;
6467              $patch_idx < @$difftree;
6468              ++$patch_idx) {
6469                 # read and prepare patch information
6470                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6471
6472                 # generate anchor for "patch" links in difftree / whatchanged part
6473                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6474                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6475                       "</div>\n";  # class="patch"
6476
6477                 $patch_number++;
6478         }
6479
6480         if ($patch_number == 0) {
6481                 if (@hash_parents > 1) {
6482                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6483                 } else {
6484                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6485                 }
6486         }
6487
6488         print "</div>\n"; # class="patchset"
6489 }
6490
6491 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6492
6493 sub git_project_search_form {
6494         my ($searchtext, $search_use_regexp) = @_;
6495
6496         my $limit = '';
6497         if ($project_filter) {
6498                 $limit = " in '$project_filter'";
6499         }
6500
6501         print "<div class=\"projsearch\">\n";
6502         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6503               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6504         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6505                 if (defined $project_filter);
6506         print $cgi->textfield(-name => 's', -value => $searchtext,
6507                               -title => "Search project by name and description$limit",
6508                               -size => 60) . "\n" .
6509               "<span title=\"Extended regular expression\">" .
6510               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6511                              -checked => $search_use_regexp) .
6512               "</span>\n" .
6513               $cgi->submit(-name => 'btnS', -value => 'Search') .
6514               $cgi->end_form() . "\n" .
6515               "<span class=\"projectlist_link\">" .
6516               $cgi->a({-href => href(project => undef, searchtext => undef,
6517                                      action => 'project_list',
6518                                      project_filter => $project_filter)},
6519                       esc_html("List all projects$limit")) . "</span><br />\n";
6520         print "<span class=\"projectlist_link\">" .
6521               $cgi->a({-href => href(project => undef, searchtext => undef,
6522                                      action => 'project_list',
6523                                      project_filter => undef)},
6524                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6525         print "</div>\n";
6526 }
6527
6528 # entry for given @keys needs filling if at least one of keys in list
6529 # is not present in %$project_info
6530 sub project_info_needs_filling {
6531         my ($project_info, @keys) = @_;
6532
6533         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6534         foreach my $key (@keys) {
6535                 if (!exists $project_info->{$key}) {
6536                         return 1;
6537                 }
6538         }
6539         return;
6540 }
6541
6542 sub git_cache_file_format {
6543         return GITWEB_CACHE_FORMAT .
6544                 (gitweb_check_feature('forks') ? " (forks)" : "");
6545 }
6546
6547 sub git_retrieve_cache_file {
6548         my $cache_file = shift;
6549
6550         use Storable qw(retrieve);
6551
6552         if ((my $dump = eval { retrieve($cache_file) })) {
6553                 return $$dump[1] if
6554                         ref($dump) eq 'ARRAY' &&
6555                         @$dump == 2 &&
6556                         ref($$dump[1]) eq 'ARRAY' &&
6557                         @{$$dump[1]} == 2 &&
6558                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6559                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6560                         $$dump[0] eq git_cache_file_format();
6561         }
6562
6563         return undef;
6564 }
6565
6566 sub git_store_cache_file {
6567         my ($cache_file, $cachedata) = @_;
6568
6569         use File::Basename qw(dirname);
6570         use File::stat;
6571         use POSIX qw(:fcntl_h);
6572         use Storable qw(store_fd);
6573
6574         my $result = undef;
6575         my $cache_d = dirname($cache_file);
6576         my $mask = umask();
6577         umask($mask & ~0070) if $cache_grpshared;
6578         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6579             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6580                 store_fd([git_cache_file_format(), $cachedata], $fd);
6581                 close $fd;
6582                 rename "$cache_file.lock", $cache_file;
6583                 $result = stat($cache_file)->mtime;
6584         }
6585         umask($mask) if $cache_grpshared;
6586         return $result;
6587 }
6588
6589 sub verify_cached_project {
6590         my ($hashref, $path) = @_;
6591         return undef unless $path;
6592         delete $$hashref{$path}, return undef unless is_valid_project($path);
6593         return $$hashref{$path} if exists $$hashref{$path};
6594
6595         # A valid project was requested but it's not yet in the cache
6596         # Manufacture a minimal project entry (path, name, description)
6597         # Also provide age, but only if it's available via $lastactivity_file
6598
6599         my %proj = ('path' => $path);
6600         my $val = git_get_project_description($path);
6601         defined $val or $val = '';
6602         $proj{'descr_long'} = $val;
6603         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6604         unless ($omit_owner) {
6605                 $val = git_get_project_owner($path);
6606                 defined $val or $val = '';
6607                 $proj{'owner'} = $val;
6608         }
6609         unless ($omit_age_column) {
6610                 ($val) = git_get_last_activity($path, 1);
6611                 $proj{'age_epoch'} = $val if defined $val;
6612         }
6613         $$hashref{$path} = \%proj;
6614         return \%proj;
6615 }
6616
6617 sub git_filter_cached_projects {
6618         my ($cache, $projlist, $verify) = @_;
6619         my $hashref = $$cache[1];
6620         my $sub = $verify ?
6621                 sub {verify_cached_project($hashref, $_[0])} :
6622                 sub {$$hashref{$_[0]}};
6623         return map {
6624                 my $c = &$sub($_->{'path'});
6625                 defined $c ? ($_ = $c) : ()
6626         } @$projlist;
6627 }
6628
6629 # fills project list info (age, description, owner, category, forks, etc.)
6630 # for each project in the list, removing invalid projects from
6631 # returned list, or fill only specified info.
6632 #
6633 # Invalid projects are removed from the returned list if and only if you
6634 # ask 'age_epoch' to be filled, because they are the only fields
6635 # that run unconditionally git command that requires repository, and
6636 # therefore do always check if project repository is invalid.
6637 #
6638 # USAGE:
6639 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6640 #   ensures that 'descr_long' and 'ctags' fields are filled
6641 # * @project_list = fill_project_list_info(\@project_list)
6642 #   ensures that all fields are filled (and invalid projects removed)
6643 #
6644 # NOTE: modifies $projlist, but does not remove entries from it
6645 sub fill_project_list_info {
6646         my ($projlist, @wanted_keys) = @_;
6647
6648         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6649         return fill_project_list_info_uncached($projlist, @wanted_keys)
6650                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6651
6652         use File::stat;
6653
6654         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6655         my $cache_file = "$cache_dir/$projlist_cache_name";
6656
6657         my @projects;
6658         my $stale = 0;
6659         my $now = time();
6660         my $cache_mtime;
6661         if ($cache_lifetime && -f $cache_file) {
6662                 $cache_mtime = stat($cache_file)->mtime;
6663                 $cache_dump = undef if $cache_mtime &&
6664                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6665         }
6666         if (defined $cache_mtime && # caching is on and $cache_file exists
6667             $cache_mtime + $cache_lifetime*60 > $now &&
6668             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6669                 # Cache hit.
6670                 $cache_dump_mtime = $cache_mtime;
6671                 $stale = $now - $cache_mtime;
6672                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6673                         gitweb_check_feature('forks');
6674                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6675
6676         } else { # Cache miss.
6677                 if (defined $cache_mtime) {
6678                         # Postpone timeout by two minutes so that we get
6679                         # enough time to do our job, or to be more exact
6680                         # make cache expire after two minutes from now.
6681                         my $time = $now - $cache_lifetime*60 + 120;
6682                         utime $time, $time, $cache_file;
6683                 }
6684                 my @all_projects = git_get_projects_list();
6685                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6686                         fill_project_list_info_uncached(\@all_projects);
6687                 map { $all_projects_filled{$_->{'path'}} = $_ }
6688                         filter_forks_from_projects_list([values(%all_projects_filled)])
6689                         if gitweb_check_feature('forks');
6690                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6691                                \%all_projects_filled];
6692                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6693                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6694         }
6695
6696         if ($cache_lifetime && $stale > 0) {
6697                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6698                         unless $shown_stale_message;
6699                 $shown_stale_message = 1;
6700         }
6701
6702         return @projects;
6703 }
6704
6705 sub fill_project_list_info_uncached {
6706         my ($projlist, @wanted_keys) = @_;
6707         my @projects;
6708         my $filter_set = sub { return @_; };
6709         if (@wanted_keys) {
6710                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6711                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6712         }
6713
6714         my $show_ctags = gitweb_check_feature('ctags');
6715  PROJECT:
6716         foreach my $pr (@$projlist) {
6717                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6718                         my (@activity) = git_get_last_activity($pr->{'path'});
6719                         unless (@activity) {
6720                                 next PROJECT;
6721                         }
6722                         ($pr->{'age_epoch'}) = @activity;
6723                 }
6724                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6725                         my $descr = git_get_project_description($pr->{'path'}) || "";
6726                         $descr = to_utf8($descr);
6727                         $pr->{'descr_long'} = $descr;
6728                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6729                 }
6730                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6731                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6732                 }
6733                 if ($show_ctags &&
6734                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6735                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6736                 }
6737                 if ($projects_list_group_categories &&
6738                     project_info_needs_filling($pr, $filter_set->('category'))) {
6739                         my $cat = git_get_project_category($pr->{'path'}) ||
6740                                                            $project_list_default_category;
6741                         $pr->{'category'} = to_utf8($cat);
6742                 }
6743
6744                 push @projects, $pr;
6745         }
6746
6747         return @projects;
6748 }
6749
6750 sub sort_projects_list {
6751         my ($projlist, $order) = @_;
6752
6753         sub order_str {
6754                 my $key = shift;
6755                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6756         }
6757
6758         sub order_reverse_num_then_undef {
6759                 my $key = shift;
6760                 return sub {
6761                         defined $a->{$key} ?
6762                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6763                                 (defined $b->{$key} ? 1 : 0)
6764                 };
6765         }
6766
6767         my %orderings = (
6768                 project => order_str('path'),
6769                 descr => order_str('descr_long'),
6770                 owner => order_str('owner'),
6771                 age => order_reverse_num_then_undef('age_epoch'),
6772         );
6773
6774         my $ordering = $orderings{$order};
6775         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6776 }
6777
6778 # returns a hash of categories, containing the list of project
6779 # belonging to each category
6780 sub build_projlist_by_category {
6781         my ($projlist, $from, $to) = @_;
6782         my %categories;
6783
6784         $from = 0 unless defined $from;
6785         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6786
6787         for (my $i = $from; $i <= $to; $i++) {
6788                 my $pr = $projlist->[$i];
6789                 push @{$categories{ $pr->{'category'} }}, $pr;
6790         }
6791
6792         return wantarray ? %categories : \%categories;
6793 }
6794
6795 # print 'sort by' <th> element, generating 'sort by $name' replay link
6796 # if that order is not selected
6797 sub print_sort_th {
6798         print format_sort_th(@_);
6799 }
6800
6801 sub format_sort_th {
6802         my ($name, $order, $header) = @_;
6803         my $sort_th = "";
6804         $header ||= ucfirst($name);
6805
6806         if ($order eq $name) {
6807                 $sort_th .= "<th>$header</th>\n";
6808         } else {
6809                 $sort_th .= "<th>" .
6810                             $cgi->a({-href => href(-replay=>1, order=>$name),
6811                                      -class => "header"}, $header) .
6812                             "</th>\n";
6813         }
6814
6815         return $sort_th;
6816 }
6817
6818 sub git_project_list_rows {
6819         my ($projlist, $from, $to, $check_forks) = @_;
6820
6821         $from = 0 unless defined $from;
6822         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6823
6824         my $now = time;
6825         my $alternate = 1;
6826         for (my $i = $from; $i <= $to; $i++) {
6827                 my $pr = $projlist->[$i];
6828
6829                 if ($alternate) {
6830                         print "<tr class=\"dark\">\n";
6831                 } else {
6832                         print "<tr class=\"light\">\n";
6833                 }
6834                 $alternate ^= 1;
6835
6836                 if ($check_forks) {
6837                         print "<td>";
6838                         if ($pr->{'forks'}) {
6839                                 my $nforks = scalar @{$pr->{'forks'}};
6840                                 my $s = $nforks == 1 ? '' : 's';
6841                                 if ($nforks > 0) {
6842                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6843                                                        -title => "$nforks fork$s"}, "+");
6844                                 } else {
6845                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6846                                 }
6847                         }
6848                         print "</td>\n";
6849                 }
6850                 my $path = $pr->{'path'};
6851                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6852                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6853                                         -class => "list"},
6854                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6855                       "</td>\n" .
6856                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6857                                         -class => "list",
6858                                         -title => $pr->{'descr_long'}},
6859                                         $search_regexp
6860                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6861                                                                     $pr->{'descr'}, $search_regexp)
6862                                         : esc_html($pr->{'descr'})) .
6863                       "</td>\n";
6864                 unless ($omit_owner) {
6865                         print "<td><i>" . ($owner_link_hook
6866                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6867                                                     chop_and_escape_str($pr->{'owner'}, 15))
6868                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6869                 }
6870                 unless ($omit_age_column) {
6871                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6872                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6873                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6874                 }
6875                 print"<td class=\"link\">" .
6876                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
6877                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . " | " .
6878                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6879                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6880                       "</td>\n" .
6881                       "</tr>\n";
6882         }
6883 }
6884
6885 sub git_project_list_body {
6886         # actually uses global variable $project
6887         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
6888         my @projects = @$projlist;
6889
6890         my $check_forks = gitweb_check_feature('forks');
6891         my $show_ctags  = gitweb_check_feature('ctags');
6892         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6893         $check_forks = undef
6894                 if ($tagfilter || $search_regexp);
6895
6896         # filtering out forks before filling info allows us to do less work
6897         if ($check_forks) {
6898                 @projects = filter_forks_from_projects_list(\@projects);
6899                 push @projects, { 'path' => "$project_filter.git" }
6900                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
6901         }
6902         # search_projects_list pre-fills required info
6903         @projects = search_projects_list(\@projects,
6904                                          'search_regexp' => $search_regexp,
6905                                          'tagfilter'  => $tagfilter)
6906                 if ($tagfilter || $search_regexp);
6907         # fill the rest
6908         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6909         push @all_fields, 'age_epoch' unless($omit_age_column);
6910         push @all_fields, 'owner' unless($omit_owner);
6911         @projects = fill_project_list_info(\@projects, @all_fields);
6912
6913         $order ||= $default_projects_order;
6914         $from = 0 unless defined $from;
6915         $to = $#projects if (!defined $to || $#projects < $to);
6916
6917         # short circuit
6918         if ($from > $to) {
6919                 print "<center>\n".
6920                       "<b>No such projects found</b><br />\n".
6921                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
6922                       "</center>\n<br />\n";
6923                 return;
6924         }
6925
6926         @projects = sort_projects_list(\@projects, $order);
6927
6928         if ($show_ctags) {
6929                 my $ctags = git_gather_all_ctags(\@projects);
6930                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
6931                 print git_show_project_tagcloud($cloud, 64);
6932         }
6933
6934         print "<table class=\"project_list\">\n";
6935         unless ($no_header) {
6936                 print "<tr>\n";
6937                 if ($check_forks) {
6938                         print "<th></th>\n";
6939                 }
6940                 print_sort_th('project', $order, 'Project');
6941                 print_sort_th('descr', $order, 'Description');
6942                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
6943                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
6944                 print "<th></th>\n" . # for links
6945                       "</tr>\n";
6946         }
6947
6948         if ($projects_list_group_categories) {
6949                 # only display categories with projects in the $from-$to window
6950                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
6951                 my %categories = build_projlist_by_category(\@projects, $from, $to);
6952                 foreach my $cat (sort keys %categories) {
6953                         unless ($cat eq "") {
6954                                 print "<tr>\n";
6955                                 if ($check_forks) {
6956                                         print "<td></td>\n";
6957                                 }
6958                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
6959                                 print "</tr>\n";
6960                         }
6961
6962                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
6963                 }
6964         } else {
6965                 git_project_list_rows(\@projects, $from, $to, $check_forks);
6966         }
6967
6968         if (defined $extra) {
6969                 print "<tr>\n";
6970                 if ($check_forks) {
6971                         print "<td></td>\n";
6972                 }
6973                 print "<td colspan=\"5\">$extra</td>\n" .
6974                       "</tr>\n";
6975         }
6976         print "</table>\n";
6977 }
6978
6979 sub git_log_body {
6980         # uses global variable $project
6981         my ($commitlist, $from, $to, $refs, $extra) = @_;
6982
6983         $from = 0 unless defined $from;
6984         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6985
6986         for (my $i = 0; $i <= $to; $i++) {
6987                 my %co = %{$commitlist->[$i]};
6988                 next if !%co;
6989                 my $commit = $co{'id'};
6990                 my $ref = format_ref_marker($refs, $commit);
6991                 git_print_header_div('commit',
6992                                "<span class=\"age\">$co{'age_string'}</span>" .
6993                                esc_html($co{'title'}),
6994                                $commit, undef, $ref);
6995                 print "<div class=\"title_text\">\n" .
6996                       "<div class=\"log_link\">\n" .
6997                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
6998                       " | " .
6999                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
7000                       " | " .
7001                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
7002                       "<br/>\n" .
7003                       "</div>\n";
7004                       git_print_authorship(\%co, -tag => 'span');
7005                       print "<br/>\n</div>\n";
7006
7007                 print "<div class=\"log_body\">\n";
7008                 git_print_log($co{'comment'}, -final_empty_line=> 1);
7009                 print "</div>\n";
7010         }
7011         if ($extra) {
7012                 print "<div class=\"page_nav\">\n";
7013                 print "$extra\n";
7014                 print "</div>\n";
7015         }
7016 }
7017
7018 sub git_shortlog_body {
7019         # uses global variable $project
7020         my ($commitlist, $from, $to, $refs, $extra) = @_;
7021
7022         $from = 0 unless defined $from;
7023         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7024
7025         print "<table class=\"shortlog\">\n";
7026         my $alternate = 1;
7027         for (my $i = $from; $i <= $to; $i++) {
7028                 my %co = %{$commitlist->[$i]};
7029                 my $commit = $co{'id'};
7030                 my $ref = format_ref_marker($refs, $commit);
7031                 if ($alternate) {
7032                         print "<tr class=\"dark\">\n";
7033                 } else {
7034                         print "<tr class=\"light\">\n";
7035                 }
7036                 $alternate ^= 1;
7037                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
7038                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7039                       format_author_html('td', \%co, 10) . "<td>";
7040                 print format_subject_html($co{'title'}, $co{'title_short'},
7041                                           href(action=>"commit", hash=>$commit), $ref);
7042                 print "</td>\n" .
7043                       "<td class=\"link\">" .
7044                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
7045                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
7046                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7047                 my $snapshot_links = format_snapshot_links($commit);
7048                 if (defined $snapshot_links) {
7049                         print " | " . $snapshot_links;
7050                 }
7051                 print "</td>\n" .
7052                       "</tr>\n";
7053         }
7054         if (defined $extra) {
7055                 print "<tr>\n" .
7056                       "<td colspan=\"4\">$extra</td>\n" .
7057                       "</tr>\n";
7058         }
7059         print "</table>\n";
7060 }
7061
7062 sub git_history_body {
7063         # Warning: assumes constant type (blob or tree) during history
7064         my ($commitlist, $from, $to, $refs, $extra,
7065             $file_name, $file_hash, $ftype) = @_;
7066
7067         $from = 0 unless defined $from;
7068         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7069
7070         print "<table class=\"history\">\n";
7071         my $alternate = 1;
7072         for (my $i = $from; $i <= $to; $i++) {
7073                 my %co = %{$commitlist->[$i]};
7074                 if (!%co) {
7075                         next;
7076                 }
7077                 my $commit = $co{'id'};
7078
7079                 my $ref = format_ref_marker($refs, $commit);
7080
7081                 if ($alternate) {
7082                         print "<tr class=\"dark\">\n";
7083                 } else {
7084                         print "<tr class=\"light\">\n";
7085                 }
7086                 $alternate ^= 1;
7087                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7088         # shortlog:   format_author_html('td', \%co, 10)
7089                       format_author_html('td', \%co, 15, 3) . "<td>";
7090                 # originally git_history used chop_str($co{'title'}, 50)
7091                 print format_subject_html($co{'title'}, $co{'title_short'},
7092                                           href(action=>"commit", hash=>$commit), $ref);
7093                 print "</td>\n" .
7094                       "<td class=\"link\">" .
7095                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
7096                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7097
7098                 if ($ftype eq 'blob') {
7099                         my $blob_current = $file_hash;
7100                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7101                         if (defined $blob_current && defined $blob_parent &&
7102                                         $blob_current ne $blob_parent) {
7103                                 print " | " .
7104                                         $cgi->a({-href => href(action=>"blobdiff",
7105                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7106                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7107                                                                file_name=>$file_name)},
7108                                                 "diff to current");
7109                         }
7110                 }
7111                 print "</td>\n" .
7112                       "</tr>\n";
7113         }
7114         if (defined $extra) {
7115                 print "<tr>\n" .
7116                       "<td colspan=\"4\">$extra</td>\n" .
7117                       "</tr>\n";
7118         }
7119         print "</table>\n";
7120 }
7121
7122 sub git_tags_body {
7123         # uses global variable $project
7124         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7125         $from = 0 unless defined $from;
7126         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7127         $order ||= $default_refs_order;
7128
7129         print "<table class=\"tags\">\n";
7130         if ($full) {
7131                 print "<tr class=\"tags_header\">\n";
7132                 print_sort_th('age', $order, 'Last Change');
7133                 print_sort_th('name', $order, 'Name');
7134                 print "<th></th>\n" . # for comment
7135                       "<th></th>\n" . # for tag
7136                       "<th></th>\n" . # for links
7137                       "</tr>\n";
7138         }
7139         my $alternate = 1;
7140         for (my $i = $from; $i <= $to; $i++) {
7141                 my $entry = $taglist->[$i];
7142                 my %tag = %$entry;
7143                 my $comment = $tag{'subject'};
7144                 my $comment_short;
7145                 if (defined $comment) {
7146                         $comment_short = chop_str($comment, 30, 5);
7147                 }
7148                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7149                 if ($alternate) {
7150                         print "<tr class=\"dark\">\n";
7151                 } else {
7152                         print "<tr class=\"light\">\n";
7153                 }
7154                 $alternate ^= 1;
7155                 if (defined $tag{'age'}) {
7156                         print "<td><i>$tag{'age'}</i></td>\n";
7157                 } else {
7158                         print "<td></td>\n";
7159                 }
7160                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7161                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7162                                -class => "list name"}, esc_html($tag{'name'})) .
7163                       "</td>\n" .
7164                       "<td>");
7165                 if (defined $comment) {
7166                         print format_subject_html($comment, $comment_short,
7167                                                   href(action=>"tag", hash=>$tag{'id'}));
7168                 }
7169                 print "</td>\n" .
7170                       "<td class=\"selflink\">";
7171                 if ($tag{'type'} eq "tag") {
7172                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7173                 } else {
7174                         print "&#160;";
7175                 }
7176                 print "</td>\n" .
7177                       "<td class=\"link\">" . " | " .
7178                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7179                 if ($tag{'reftype'} eq "commit") {
7180                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7181                         print " | " . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7182                 } elsif ($tag{'reftype'} eq "blob") {
7183                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7184                 }
7185                 print "</td>\n" .
7186                       "</tr>";
7187         }
7188         if (defined $extra) {
7189                 print "<tr>\n" .
7190                       "<td colspan=\"5\">$extra</td>\n" .
7191                       "</tr>\n";
7192         }
7193         print "</table>\n";
7194 }
7195
7196 sub git_heads_body {
7197         # uses global variable $project
7198         my ($headlist, $head_at, $from, $to, $extra) = @_;
7199         $from = 0 unless defined $from;
7200         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7201
7202         print "<table class=\"heads\">\n";
7203         my $alternate = 1;
7204         for (my $i = $from; $i <= $to; $i++) {
7205                 my $entry = $headlist->[$i];
7206                 my %ref = %$entry;
7207                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7208                 if ($alternate) {
7209                         print "<tr class=\"dark\">\n";
7210                 } else {
7211                         print "<tr class=\"light\">\n";
7212                 }
7213                 $alternate ^= 1;
7214                 print "<td><i>$ref{'age'}</i></td>\n" .
7215                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7216                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7217                                -class => "list name"},esc_html($ref{'name'})) .
7218                       "</td>\n" .
7219                       "<td class=\"link\">" .
7220                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . " | " .
7221                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7222                       "</td>\n" .
7223                       "</tr>";
7224         }
7225         if (defined $extra) {
7226                 print "<tr>\n" .
7227                       "<td colspan=\"3\">$extra</td>\n" .
7228                       "</tr>\n";
7229         }
7230         print "</table>\n";
7231 }
7232
7233 # Display a single remote block
7234 sub git_remote_block {
7235         my ($remote, $rdata, $limit, $head) = @_;
7236
7237         my $heads = $rdata->{'heads'};
7238         my $fetch = $rdata->{'fetch'};
7239         my $push = $rdata->{'push'};
7240
7241         my $urls_table = "<table class=\"projects_list\">\n" ;
7242
7243         if (defined $fetch) {
7244                 if ($fetch eq $push) {
7245                         $urls_table .= format_repo_url("URL", $fetch);
7246                 } else {
7247                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7248                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7249                 }
7250         } elsif (defined $push) {
7251                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7252         } else {
7253                 $urls_table .= format_repo_url("", "No remote URL");
7254         }
7255
7256         $urls_table .= "</table>\n";
7257
7258         my $dots;
7259         if (defined $limit && $limit < @$heads) {
7260                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7261         }
7262
7263         print $urls_table;
7264         git_heads_body($heads, $head, 0, $limit, $dots);
7265 }
7266
7267 # Display a list of remote names with the respective fetch and push URLs
7268 sub git_remotes_list {
7269         my ($remotedata, $limit) = @_;
7270         print "<table class=\"heads\">\n";
7271         my $alternate = 1;
7272         my @remotes = sort keys %$remotedata;
7273
7274         my $limited = $limit && $limit < @remotes;
7275
7276         $#remotes = $limit - 1 if $limited;
7277
7278         while (my $remote = shift @remotes) {
7279                 my $rdata = $remotedata->{$remote};
7280                 my $fetch = $rdata->{'fetch'};
7281                 my $push = $rdata->{'push'};
7282                 if ($alternate) {
7283                         print "<tr class=\"dark\">\n";
7284                 } else {
7285                         print "<tr class=\"light\">\n";
7286                 }
7287                 $alternate ^= 1;
7288                 print "<td>" .
7289                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7290                                -class=> "list name"},esc_html($remote)) .
7291                       "</td>";
7292                 print "<td class=\"link\">" .
7293                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7294                       " | " .
7295                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7296                       "</td>";
7297
7298                 print "</tr>\n";
7299         }
7300
7301         if ($limited) {
7302                 print "<tr>\n" .
7303                       "<td colspan=\"3\">" .
7304                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7305                       "</td>\n" . "</tr>\n";
7306         }
7307
7308         print "</table>";
7309 }
7310
7311 # Display remote heads grouped by remote, unless there are too many
7312 # remotes, in which case we only display the remote names
7313 sub git_remotes_body {
7314         my ($remotedata, $limit, $head) = @_;
7315         if ($limit and $limit < keys %$remotedata) {
7316                 git_remotes_list($remotedata, $limit);
7317         } else {
7318                 fill_remote_heads($remotedata);
7319                 while (my ($remote, $rdata) = each %$remotedata) {
7320                         git_print_section({-class=>"remote", -id=>$remote},
7321                                 ["remotes", $remote, $remote], sub {
7322                                         git_remote_block($remote, $rdata, $limit, $head);
7323                                 });
7324                 }
7325         }
7326 }
7327
7328 sub git_search_message {
7329         my %co = @_;
7330
7331         my $greptype;
7332         if ($searchtype eq 'commit') {
7333                 $greptype = "--grep=";
7334         } elsif ($searchtype eq 'author') {
7335                 $greptype = "--author=";
7336         } elsif ($searchtype eq 'committer') {
7337                 $greptype = "--committer=";
7338         }
7339         $greptype .= $searchtext;
7340         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7341                                        $greptype, '--regexp-ignore-case',
7342                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7343
7344         my $paging_nav = '';
7345         if ($page > 0) {
7346                 $paging_nav .=
7347                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7348                                 "first") .
7349                         " &#183; " .
7350                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7351                                  -accesskey => "p", -title => "Alt-p"}, "prev");
7352         } else {
7353                 $paging_nav .= "first &#183; prev";
7354         }
7355         my $next_link = '';
7356         if ($#commitlist >= 100) {
7357                 $next_link =
7358                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7359                                  -accesskey => "n", -title => "Alt-n"}, "next");
7360                 $paging_nav .= " &#183; $next_link";
7361         } else {
7362                 $paging_nav .= " &#183; next";
7363         }
7364
7365         git_header_html();
7366
7367         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
7368         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7369         if ($page == 0 && !@commitlist) {
7370                 print "<p>No match.</p>\n";
7371         } else {
7372                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7373         }
7374
7375         git_footer_html();
7376 }
7377
7378 sub git_search_changes {
7379         my %co = @_;
7380
7381         local $/ = "\n";
7382         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7383                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7384                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7385                         or die_error(500, "Open git-log failed");
7386
7387         git_header_html();
7388
7389         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7390         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7391
7392         print "<table class=\"pickaxe search\">\n";
7393         my $alternate = 1;
7394         undef %co;
7395         my @files;
7396         while (my $line = to_utf8(scalar <$fd>)) {
7397                 chomp $line;
7398                 next unless $line;
7399
7400                 my %set = parse_difftree_raw_line($line);
7401                 if (defined $set{'commit'}) {
7402                         # finish previous commit
7403                         if (%co) {
7404                                 print "</td>\n" .
7405                                       "<td class=\"link\">" .
7406                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7407                                               "commit") .
7408                                       " | " .
7409                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7410                                                              hash_base=>$co{'id'})},
7411                                               "tree") .
7412                                       "</td>\n" .
7413                                       "</tr>\n";
7414                         }
7415
7416                         if ($alternate) {
7417                                 print "<tr class=\"dark\">\n";
7418                         } else {
7419                                 print "<tr class=\"light\">\n";
7420                         }
7421                         $alternate ^= 1;
7422                         %co = parse_commit($set{'commit'});
7423                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7424                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7425                               "<td><i>$author</i></td>\n" .
7426                               "<td>" .
7427                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7428                                       -class => "list subject"},
7429                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7430                 } elsif (defined $set{'to_id'}) {
7431                         next if ($set{'to_id'} =~ m/^0{40}$/);
7432
7433                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7434                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7435                                       -class => "list"},
7436                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7437                               "<br/>\n";
7438                 }
7439         }
7440         close $fd;
7441
7442         # finish last commit (warning: repetition!)
7443         if (%co) {
7444                 print "</td>\n" .
7445                       "<td class=\"link\">" .
7446                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7447                               "commit") .
7448                       " | " .
7449                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7450                                              hash_base=>$co{'id'})},
7451                               "tree") .
7452                       "</td>\n" .
7453                       "</tr>\n";
7454         }
7455
7456         print "</table>\n";
7457
7458         git_footer_html();
7459 }
7460
7461 sub git_search_files {
7462         my %co = @_;
7463
7464         local $/ = "\n";
7465         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7466                 $search_use_regexp ? ('-E', '-i') : '-F',
7467                 $searchtext, $co{'tree'})
7468                         or die_error(500, "Open git-grep failed");
7469
7470         git_header_html();
7471
7472         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7473         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7474
7475         print "<table class=\"grep_search\">\n";
7476         my $alternate = 1;
7477         my $matches = 0;
7478         my $lastfile = '';
7479         my $file_href;
7480         while (my $line = to_utf8(scalar <$fd>)) {
7481                 chomp $line;
7482                 my ($file, $lno, $ltext, $binary);
7483                 last if ($matches++ > 1000);
7484                 if ($line =~ /^Binary file (.+) matches$/) {
7485                         $file = $1;
7486                         $binary = 1;
7487                 } else {
7488                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7489                         $file =~ s/^$co{'tree'}://;
7490                 }
7491                 if ($file ne $lastfile) {
7492                         $lastfile and print "</td></tr>\n";
7493                         if ($alternate++) {
7494                                 print "<tr class=\"dark\">\n";
7495                         } else {
7496                                 print "<tr class=\"light\">\n";
7497                         }
7498                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7499                                           file_name=>$file);
7500                         print "<td class=\"list\">".
7501                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7502                         print "</td><td>\n";
7503                         $lastfile = $file;
7504                 }
7505                 if ($binary) {
7506                         print "<div class=\"binary\">Binary file</div>\n";
7507                 } else {
7508                         $ltext = untabify($ltext);
7509                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7510                                 $ltext = esc_html($1, -nbsp=>1);
7511                                 $ltext .= '<span class="match">';
7512                                 $ltext .= esc_html($2, -nbsp=>1);
7513                                 $ltext .= '</span>';
7514                                 $ltext .= esc_html($3, -nbsp=>1);
7515                         } else {
7516                                 $ltext = esc_html($ltext, -nbsp=>1);
7517                         }
7518                         print "<div class=\"pre\">" .
7519                                 $cgi->a({-href => $file_href.'#l'.$lno,
7520                                         -class => "linenr"}, sprintf('%4i', $lno)) .
7521                                 ' ' .  $ltext . "</div>\n";
7522                 }
7523         }
7524         if ($lastfile) {
7525                 print "</td></tr>\n";
7526                 if ($matches > 1000) {
7527                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7528                 }
7529         } else {
7530                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7531         }
7532         close $fd;
7533
7534         print "</table>\n";
7535
7536         git_footer_html();
7537 }
7538
7539 sub git_search_grep_body {
7540         my ($commitlist, $from, $to, $extra) = @_;
7541         $from = 0 unless defined $from;
7542         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7543
7544         print "<table class=\"commit_search\">\n";
7545         my $alternate = 1;
7546         for (my $i = $from; $i <= $to; $i++) {
7547                 my %co = %{$commitlist->[$i]};
7548                 if (!%co) {
7549                         next;
7550                 }
7551                 my $commit = $co{'id'};
7552                 if ($alternate) {
7553                         print "<tr class=\"dark\">\n";
7554                 } else {
7555                         print "<tr class=\"light\">\n";
7556                 }
7557                 $alternate ^= 1;
7558                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7559                       format_author_html('td', \%co, 15, 5) .
7560                       "<td>" .
7561                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7562                                -class => "list subject"},
7563                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7564                 my $comment = $co{'comment'};
7565                 foreach my $line (@$comment) {
7566                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7567                                 my ($lead, $match, $trail) = ($1, $2, $3);
7568                                 $match = chop_str($match, 70, 5, 'center');
7569                                 my $contextlen = int((80 - length($match))/2);
7570                                 $contextlen = 30 if ($contextlen > 30);
7571                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7572                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7573
7574                                 $lead  = esc_html($lead);
7575                                 $match = esc_html($match);
7576                                 $trail = esc_html($trail);
7577
7578                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7579                         }
7580                 }
7581                 print "</td>\n" .
7582                       "<td class=\"link\">" .
7583                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7584                       " | " .
7585                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7586                       " | " .
7587                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7588                 print "</td>\n" .
7589                       "</tr>\n";
7590         }
7591         if (defined $extra) {
7592                 print "<tr>\n" .
7593                       "<td colspan=\"3\">$extra</td>\n" .
7594                       "</tr>\n";
7595         }
7596         print "</table>\n";
7597 }
7598
7599 ## ======================================================================
7600 ## ======================================================================
7601 ## actions
7602
7603 sub git_project_list_load {
7604         my $empty_list_ok = shift;
7605         my $order = $input_params{'order'};
7606         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7607                 die_error(400, "Unknown order parameter");
7608         }
7609
7610         my @list = git_get_projects_list($project_filter, $strict_export);
7611         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7612                 push @list, { 'path' => "$project_filter.git" }
7613                         if is_valid_project("$project_filter.git");
7614         }
7615         if (!@list) {
7616                 die_error(404, "No projects found") unless $empty_list_ok;
7617         }
7618
7619         return (\@list, $order);
7620 }
7621
7622 sub git_frontpage {
7623         my ($projlist, $order);
7624
7625         if ($frontpage_no_project_list) {
7626                 $project = undef;
7627                 $project_filter = undef;
7628         } else {
7629                 ($projlist, $order) = git_project_list_load(1);
7630         }
7631         git_header_html();
7632         if (defined $home_text && -f $home_text) {
7633                 print "<div class=\"index_include\">\n";
7634                 insert_file($home_text);
7635                 print "</div>\n";
7636         }
7637         git_project_search_form($searchtext, $search_use_regexp);
7638         if ($frontpage_no_project_list) {
7639                 my $show_ctags = gitweb_check_feature('ctags');
7640                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7641                         my @projects = git_get_projects_list($project_filter, $strict_export);
7642                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7643                         @projects = fill_project_list_info(\@projects, 'ctags');
7644                         my $ctags = git_gather_all_ctags(\@projects);
7645                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7646                         print git_show_project_tagcloud($cloud, 64);
7647                 }
7648         } else {
7649                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7650         }
7651         git_footer_html();
7652 }
7653
7654 sub git_project_list {
7655         my ($projlist, $order) = git_project_list_load();
7656         git_header_html();
7657         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7658                 print "<div class=\"index_include\">\n";
7659                 insert_file($home_text);
7660                 print "</div>\n";
7661         }
7662         git_project_search_form();
7663         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7664         git_footer_html();
7665 }
7666
7667 sub git_forks {
7668         my $order = $input_params{'order'};
7669         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7670                 die_error(400, "Unknown order parameter");
7671         }
7672
7673         my $filter = $project;
7674         $filter =~ s/\.git$//;
7675         my @list = git_get_projects_list($filter);
7676         if (!@list) {
7677                 die_error(404, "No forks found");
7678         }
7679
7680         git_header_html();
7681         git_print_page_nav('','');
7682         git_print_header_div('summary', "$project forks");
7683         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7684         git_footer_html();
7685 }
7686
7687 sub git_project_index {
7688         my @projects = git_get_projects_list($project_filter, $strict_export);
7689         if (!@projects) {
7690                 die_error(404, "No projects found");
7691         }
7692
7693         print $cgi->header(
7694                 -type => 'text/plain',
7695                 -charset => 'utf-8',
7696                 -content_disposition => 'inline; filename="index.aux"');
7697
7698         foreach my $pr (@projects) {
7699                 if (!exists $pr->{'owner'}) {
7700                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7701                 }
7702
7703                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7704                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7705                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7706                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7707                 $path  =~ s/ /\+/g;
7708                 $owner =~ s/ /\+/g;
7709
7710                 print "$path $owner\n";
7711         }
7712 }
7713
7714 sub git_summary {
7715         my $descr = git_get_project_description($project) || "none";
7716         my %co = parse_commit("HEAD");
7717         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7718         my $head = $co{'id'};
7719         my $remote_heads = gitweb_check_feature('remote_heads');
7720
7721         my $owner = git_get_project_owner($project);
7722         my $homepage = git_get_project_config('homepage');
7723         my $base_url = git_get_project_config('baseurl');
7724
7725         my $refs = git_get_references();
7726         # These get_*_list functions return one more to allow us to see if
7727         # there are more ...
7728         my @taglist  = git_get_tags_list(16);
7729         my @headlist = git_get_heads_list(16);
7730         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7731         my @forklist;
7732         my $check_forks = gitweb_check_feature('forks');
7733
7734         if ($check_forks) {
7735                 # find forks of a project
7736                 my $filter = $project;
7737                 $filter =~ s/\.git$//;
7738                 @forklist = git_get_projects_list($filter);
7739                 # filter out forks of forks
7740                 @forklist = filter_forks_from_projects_list(\@forklist)
7741                         if (@forklist);
7742         }
7743
7744         git_header_html();
7745         git_print_page_nav('summary','', $head);
7746
7747         if ($check_forks and $project =~ m#/#) {
7748                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7749                 my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7750                 print <<EOT;
7751 <div class="forkinfo">
7752 This project is a fork of the $r project. If you have that one
7753 already cloned locally, you can use
7754 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7755 to save bandwidth during cloning.
7756 </div>
7757 EOT
7758         }
7759
7760         print "<div class=\"title\">&#160;</div>\n";
7761         print "<table class=\"projects_list\">\n" .
7762               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7763         if ($homepage) {
7764                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7765         }
7766         if ($base_url) {
7767                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7768         }
7769         if ($owner and not $omit_owner) {
7770                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7771                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7772                         : email_obfuscate($owner)) . "</td></tr>\n";
7773         }
7774         if (defined $cd{'rfc2822'}) {
7775                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7776                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7777         }
7778         print format_lastrefresh_row(), "\n";
7779
7780         # use per project git URL list in $projectroot/$project/cloneurl
7781         # or make project git URL from git base URL and project name
7782         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7783         my @url_list = git_get_project_url_list($project);
7784         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7785         foreach my $git_url (@url_list) {
7786                 next unless $git_url;
7787                 print format_repo_url($url_tag, $git_url);
7788                 $url_tag = "";
7789         }
7790         @url_list = map { "$_/$project" } @git_base_push_urls;
7791         if ((git_get_project_config("showpush", '--bool')||'false') eq "true" ||
7792             -f "$projectroot/$project/.nofetch") {
7793                 $url_tag = "push&#160;URL";
7794                 foreach my $git_push_url (@url_list) {
7795                         next unless $git_push_url;
7796                         my $hint = $https_hint_html && $git_push_url =~ /^https:/i ?
7797                                 "&#160;$https_hint_html" : '';
7798                         print "<tr class=\"metadata_pushurl\"><td>$url_tag</td><td>$git_push_url$hint</td></tr>\n";
7799                         $url_tag = "";
7800                 }
7801         }
7802
7803         if (defined($git_base_bundles_url) && -d "$projectroot/$project/bundles") {
7804                 my $projname = $project;
7805                 $projname =~ s|^.*/||;
7806                 my $url = "$git_base_bundles_url/$project/bundles";
7807                 print format_repo_url(
7808                         "bundle&#160;info",
7809                         "<a rel='nofollow' href='$url'>$projname downloadable bundles</a>");
7810         }
7811
7812         # Tag cloud
7813         my $show_ctags = gitweb_check_feature('ctags');
7814         if ($show_ctags) {
7815                 my $ctags = git_get_project_ctags($project);
7816                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7817                         # without ability to add tags, don't show if there are none
7818                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7819                         print "<tr id=\"metadata_ctags\">" .
7820                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7821                         print "</td>\n<td>" unless %$ctags;
7822                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7823                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7824                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7825                               unless $show_ctags =~ /^\d+$/;
7826                         print "</td>\n<td>" if %$ctags;
7827                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7828                               "</tr>\n";
7829                 }
7830         }
7831
7832         print "</table>\n";
7833
7834         # If XSS prevention is on, we don't include README.html.
7835         # TODO: Allow a readme in some safe format.
7836         if (!$prevent_xss) {
7837                 my $readme = -s "$projectroot/$project/README.html"
7838                         ? collect_html_file("$projectroot/$project/README.html")
7839                         : collect_output($git_automatic_readme_html, "$projectroot/$project");
7840                 if (defined($readme)) {
7841                         $readme =~ s/^\s+//s;
7842                         $readme =~ s/\s+$//s;
7843                         print "<div class=\"title\">readme</div>\n",
7844                               "<div class=\"readme\">\n",
7845                               $readme,
7846                               "\n</div>\n"
7847                         if $readme ne '';
7848                 }
7849         }
7850
7851         # we need to request one more than 16 (0..15) to check if
7852         # those 16 are all
7853         my @commitlist = $head ? parse_commits($head, 17) : ();
7854         if (@commitlist) {
7855                 git_print_header_div('shortlog');
7856                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7857                                   $#commitlist <=  15 ? undef :
7858                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7859         }
7860
7861         if (@taglist) {
7862                 git_print_header_div('tags');
7863                 git_tags_body(\@taglist, 0, 15,
7864                               $#taglist <=  15 ? undef :
7865                               $cgi->a({-href => href(action=>"tags")}, "..."));
7866         }
7867
7868         if (@headlist) {
7869                 git_print_header_div('heads');
7870                 git_heads_body(\@headlist, $head, 0, 15,
7871                                $#headlist <= 15 ? undef :
7872                                $cgi->a({-href => href(action=>"heads")}, "..."));
7873         }
7874
7875         if (%remotedata) {
7876                 git_print_header_div('remotes');
7877                 git_remotes_body(\%remotedata, 15, $head);
7878         }
7879
7880         if (@forklist) {
7881                 git_print_header_div('forks');
7882                 git_project_list_body(\@forklist, 'age', 0, 15,
7883                                       $#forklist <= 15 ? undef :
7884                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7885                                       'no_header', 'forks');
7886         }
7887
7888         git_footer_html();
7889 }
7890
7891 sub git_tag {
7892         my %tag = parse_tag($hash);
7893
7894         if (! %tag) {
7895                 die_error(404, "Unknown tag object");
7896         }
7897
7898         my $fullhash;
7899         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
7900         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
7901
7902         my $head = git_get_head_hash($project);
7903         git_header_html();
7904         git_print_page_nav('','', $head,undef,$head);
7905         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
7906         print "<div class=\"title_text\">\n" .
7907               "<table class=\"object_header\">\n" .
7908               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
7909               "<tr>\n" .
7910               "<td>object</td>\n" .
7911               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7912                                $tag{'object'}) . "</td>\n" .
7913               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7914                                               $tag{'type'}) . "</td>\n" .
7915               "</tr>\n";
7916         if (defined($tag{'author'})) {
7917                 git_print_authorship_rows(\%tag, 'author');
7918         }
7919         print "</table>\n\n" .
7920               "</div>\n";
7921         print "<div class=\"page_body\">";
7922         my $comment = $tag{'comment'};
7923         foreach my $line (@$comment) {
7924                 chomp $line;
7925                 print esc_html($line, -nbsp=>1) . "<br/>\n";
7926         }
7927         print "</div>\n";
7928         git_footer_html();
7929 }
7930
7931 sub git_blame_common {
7932         my $format = shift || 'porcelain';
7933         if ($format eq 'porcelain' && $input_params{'javascript'}) {
7934                 $format = 'incremental';
7935                 $action = 'blame_incremental'; # for page title etc
7936         }
7937
7938         # permissions
7939         gitweb_check_feature('blame')
7940                 or die_error(403, "Blame view not allowed");
7941
7942         # error checking
7943         die_error(400, "No file name given") unless $file_name;
7944         $hash_base ||= git_get_head_hash($project);
7945         die_error(404, "Couldn't find base commit") unless $hash_base;
7946         my %co = parse_commit($hash_base)
7947                 or die_error(404, "Commit not found");
7948         my $ftype = "blob";
7949         if (!defined $hash) {
7950                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
7951                         or die_error(404, "Error looking up file");
7952         } else {
7953                 $ftype = git_get_type($hash);
7954                 if ($ftype !~ "blob") {
7955                         die_error(400, "Object is not a blob");
7956                 }
7957         }
7958
7959         my $fd;
7960         if ($format eq 'incremental') {
7961                 # get file contents (as base)
7962                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
7963                         or die_error(500, "Open git-cat-file failed");
7964         } elsif ($format eq 'data') {
7965                 # run git-blame --incremental
7966                 defined($fd = git_cmd_pipe "blame", "--incremental",
7967                         $hash_base, "--", $file_name)
7968                         or die_error(500, "Open git-blame --incremental failed");
7969         } else {
7970                 # run git-blame --porcelain
7971                 defined($fd = git_cmd_pipe "blame", '-p',
7972                         $hash_base, '--', $file_name)
7973                         or die_error(500, "Open git-blame --porcelain failed");
7974         }
7975
7976         # incremental blame data returns early
7977         if ($format eq 'data') {
7978                 print $cgi->header(
7979                         -type=>"text/plain", -charset => "utf-8",
7980                         -status=> "200 OK");
7981                 local $| = 1; # output autoflush
7982                 while (<$fd>) {
7983                         print to_utf8($_);
7984                 }
7985                 close $fd
7986                         or print "ERROR $!\n";
7987
7988                 print 'END';
7989                 if (defined $t0 && gitweb_check_feature('timed')) {
7990                         print ' '.
7991                               tv_interval($t0, [ gettimeofday() ]).
7992                               ' '.$number_of_git_cmds;
7993                 }
7994                 print "\n";
7995
7996                 return;
7997         }
7998
7999         # page header
8000         git_header_html();
8001         my $formats_nav =
8002                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
8003                         "blob");
8004         $formats_nav .=
8005                 " | " .
8006                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8007                         "history") .
8008                 " | " .
8009                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
8010                         "HEAD");
8011         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8012         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8013         git_print_page_path($file_name, $ftype, $hash_base);
8014
8015         # page body
8016         if ($format eq 'incremental') {
8017                 print "<noscript>\n<div class=\"error\"><center><b>\n".
8018                       "This page requires JavaScript to run.\n Use ".
8019                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
8020                               'this page').
8021                       " instead.\n".
8022                       "</b></center></div>\n</noscript>\n";
8023
8024                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
8025         }
8026
8027         print qq!<div class="page_body">\n!;
8028         print qq!<div id="progress_info">... / ...</div>\n!
8029                 if ($format eq 'incremental');
8030         print qq!<table id="blame_table" class="blame" width="100%">\n!.
8031               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
8032               qq!<thead>\n!.
8033               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
8034               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
8035               qq!title="toggles blame author information display">[+]</a></th>!.
8036               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
8037               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
8038               qq!</thead>\n!.
8039               qq!<tbody>\n!;
8040
8041         my @rev_color = qw(light dark);
8042         my $num_colors = scalar(@rev_color);
8043         my $current_color = 0;
8044
8045         if ($format eq 'incremental') {
8046                 my $color_class = $rev_color[$current_color];
8047
8048                 #contents of a file
8049                 my $linenr = 0;
8050         LINE:
8051                 while (my $line = to_utf8(scalar <$fd>)) {
8052                         chomp $line;
8053                         $linenr++;
8054
8055                         print qq!<tr id="l$linenr" class="$color_class">!.
8056                               qq!<td class="sha1"><a href=""> </a></td>!.
8057                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8058                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8059                               qq!<td class="linenr">!.
8060                               qq!<a class="linenr" href="">$linenr</a></td>!;
8061                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8062                         print qq!</tr>\n!;
8063                 }
8064
8065         } else { # porcelain, i.e. ordinary blame
8066                 my %metainfo = (); # saves information about commits
8067
8068                 # blame data
8069         LINE:
8070                 while (my $line = to_utf8(scalar <$fd>)) {
8071                         chomp $line;
8072                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8073                         # no <lines in group> for subsequent lines in group of lines
8074                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8075                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8076                         if (!exists $metainfo{$full_rev}) {
8077                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8078                         }
8079                         my $meta = $metainfo{$full_rev};
8080                         my $data;
8081                         while ($data = to_utf8(scalar <$fd>)) {
8082                                 chomp $data;
8083                                 last if ($data =~ s/^\t//); # contents of line
8084                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8085                                         $meta->{$1} = $2 unless exists $meta->{$1};
8086                                 }
8087                                 if ($data =~ /^previous /) {
8088                                         $meta->{'nprevious'}++;
8089                                 }
8090                         }
8091                         my $short_rev = substr($full_rev, 0, 8);
8092                         my $author = $meta->{'author'};
8093                         my %date =
8094                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8095                         my $date = $date{'iso-tz'};
8096                         if ($group_size) {
8097                                 $current_color = ($current_color + 1) % $num_colors;
8098                         }
8099                         my $tr_class = $rev_color[$current_color];
8100                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8101                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8102                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8103                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8104                         if ($group_size) {
8105                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8106                                 print "<td class=\"sha1\"";
8107                                 print " title=\"". esc_html($author) . ", $date\"";
8108                                 print "$rowspan>";
8109                                 print $cgi->a({-href => href(action=>"commit",
8110                                                              hash=>$full_rev,
8111                                                              file_name=>$file_name)},
8112                                               esc_html($short_rev));
8113                                 if ($group_size >= 2) {
8114                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8115                                         if (@author_initials) {
8116                                                 print "<br />" .
8117                                                       esc_html(join('', @author_initials));
8118                                                 #           or join('.', ...)
8119                                         }
8120                                 }
8121                                 print "</td>\n";
8122                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8123                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8124                         }
8125                         # 'previous' <sha1 of parent commit> <filename at commit>
8126                         if (exists $meta->{'previous'} &&
8127                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8128                                 $meta->{'parent'} = $1;
8129                                 $meta->{'file_parent'} = unquote($2);
8130                         }
8131                         my $linenr_commit =
8132                                 exists($meta->{'parent'}) ?
8133                                 $meta->{'parent'} : $full_rev;
8134                         my $linenr_filename =
8135                                 exists($meta->{'file_parent'}) ?
8136                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8137                         my $blamed = href(action => 'blame',
8138                                           file_name => $linenr_filename,
8139                                           hash_base => $linenr_commit);
8140                         print "<td class=\"linenr\">";
8141                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8142                                         -class => "linenr" },
8143                                       esc_html($lineno));
8144                         print "</td>";
8145                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8146                         print "</tr>\n";
8147                 } # end while
8148
8149         }
8150
8151         # footer
8152         print "</tbody>\n".
8153               "</table>\n"; # class="blame"
8154         print "</div>\n";   # class="blame_body"
8155         close $fd
8156                 or print "Reading blob failed\n";
8157
8158         git_footer_html();
8159 }
8160
8161 sub git_blame {
8162         git_blame_common();
8163 }
8164
8165 sub git_blame_incremental {
8166         git_blame_common('incremental');
8167 }
8168
8169 sub git_blame_data {
8170         git_blame_common('data');
8171 }
8172
8173 sub git_tags {
8174         my $head = git_get_head_hash($project);
8175         git_header_html();
8176         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8177         git_print_header_div('summary', $project);
8178
8179         my @tagslist = git_get_tags_list();
8180         if (@tagslist) {
8181                 git_tags_body(\@tagslist);
8182         }
8183         git_footer_html();
8184 }
8185
8186 sub git_refs {
8187         my $order = $input_params{'order'};
8188         if (defined $order && $order !~ m/age|name/) {
8189                 die_error(400, "Unknown order parameter");
8190         }
8191
8192         my $head = git_get_head_hash($project);
8193         git_header_html();
8194         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8195         git_print_header_div('summary', $project);
8196
8197         my @refslist = git_get_tags_list(undef, 1, $order);
8198         if (@refslist) {
8199                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8200         }
8201         git_footer_html();
8202 }
8203
8204 sub git_heads {
8205         my $head = git_get_head_hash($project);
8206         git_header_html();
8207         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8208         git_print_header_div('summary', $project);
8209
8210         my @headslist = git_get_heads_list();
8211         if (@headslist) {
8212                 git_heads_body(\@headslist, $head);
8213         }
8214         git_footer_html();
8215 }
8216
8217 # used both for single remote view and for list of all the remotes
8218 sub git_remotes {
8219         gitweb_check_feature('remote_heads')
8220                 or die_error(403, "Remote heads view is disabled");
8221
8222         my $head = git_get_head_hash($project);
8223         my $remote = $input_params{'hash'};
8224
8225         my $remotedata = git_get_remotes_list($remote);
8226         die_error(500, "Unable to get remote information") unless defined $remotedata;
8227
8228         unless (%$remotedata) {
8229                 die_error(404, defined $remote ?
8230                         "Remote $remote not found" :
8231                         "No remotes found");
8232         }
8233
8234         git_header_html(undef, undef, -action_extra => $remote);
8235         git_print_page_nav('', '',  $head, undef, $head,
8236                 format_ref_views($remote ? '' : 'remotes'));
8237
8238         fill_remote_heads($remotedata);
8239         if (defined $remote) {
8240                 git_print_header_div('remotes', "$remote remote for $project");
8241                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8242         } else {
8243                 git_print_header_div('summary', "$project remotes");
8244                 git_remotes_body($remotedata, undef, $head);
8245         }
8246
8247         git_footer_html();
8248 }
8249
8250 sub git_blob_plain {
8251         my $type = shift;
8252         my $expires;
8253
8254         if (!defined $hash) {
8255                 if (defined $file_name) {
8256                         my $base = $hash_base || git_get_head_hash($project);
8257                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8258                                 or die_error(404, "Cannot find file");
8259                 } else {
8260                         die_error(400, "No file name defined");
8261                 }
8262         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8263                 # blobs defined by non-textual hash id's can be cached
8264                 $expires = "+1d";
8265         }
8266
8267         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8268                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8269         binmode($fd);
8270
8271         # content-type (can include charset)
8272         my $leader;
8273         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8274
8275         # "save as" filename, even when no $file_name is given
8276         my $save_as = "$hash";
8277         if (defined $file_name) {
8278                 $save_as = $file_name;
8279         } elsif ($type =~ m/^text\//) {
8280                 $save_as .= '.txt';
8281         }
8282
8283         # With XSS prevention on, blobs of all types except a few known safe
8284         # ones are served with "Content-Disposition: attachment" to make sure
8285         # they don't run in our security domain.  For certain image types,
8286         # blob view writes an <img> tag referring to blob_plain view, and we
8287         # want to be sure not to break that by serving the image as an
8288         # attachment (though Firefox 3 doesn't seem to care).
8289         my $sandbox = $prevent_xss &&
8290                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8291
8292         # serve text/* as text/plain
8293         if ($prevent_xss &&
8294             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8295              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8296                 my $rest = $1;
8297                 $rest = defined $rest ? $rest : '';
8298                 $type = "text/plain$rest";
8299         }
8300
8301         print $cgi->header(
8302                 -type => $type,
8303                 -expires => $expires,
8304                 -content_disposition =>
8305                         ($sandbox ? 'attachment' : 'inline')
8306                         . '; filename="' . $save_as . '"');
8307         binmode STDOUT, ':raw';
8308         $fcgi_raw_mode = 1;
8309         print $leader if defined $leader;
8310         my $buf;
8311         while (read($fd, $buf, 32768)) {
8312                 print $buf;
8313         }
8314         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8315         $fcgi_raw_mode = 0;
8316         close $fd;
8317 }
8318
8319 sub git_blob {
8320         my $expires;
8321
8322         my $fullhash;
8323         if (!defined $hash) {
8324                 if (defined $file_name) {
8325                         my $base = $hash_base || git_get_head_hash($project);
8326                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8327                                 or die_error(404, "Cannot find file");
8328                         $fullhash = $hash;
8329                 } else {
8330                         die_error(400, "No file name defined");
8331                 }
8332         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8333                 # blobs defined by non-textual hash id's can be cached
8334                 $expires = "+1d";
8335                 $fullhash = $hash;
8336         }
8337         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8338
8339         my $have_blame = gitweb_check_feature('blame');
8340         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8341                 or die_error(500, "Couldn't cat $file_name, $hash");
8342         binmode($fd);
8343         my $mimetype = blob_mimetype($fd, $file_name);
8344         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8345         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8346                 close $fd;
8347                 return git_blob_plain($mimetype);
8348         }
8349         # we can have blame only for text/* mimetype
8350         $have_blame &&= ($mimetype =~ m!^text/!);
8351
8352         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8353         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8354         my $highlight_mode_active;
8355         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8356
8357         git_header_html(undef, $expires);
8358         my $formats_nav = '';
8359         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8360                 if (defined $file_name) {
8361                         if ($have_blame) {
8362                                 $formats_nav .=
8363                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8364                                                 -class => "blamelink"},
8365                                                 "blame") .
8366                                         " | ";
8367                         }
8368                         $formats_nav .=
8369                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8370                                         "history") .
8371                                 " | " .
8372                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8373                                         "raw") .
8374                                 " | " .
8375                                 $cgi->a({-href => href(action=>"blob",
8376                                                        hash_base=>"HEAD", file_name=>$file_name)},
8377                                         "HEAD");
8378                 } else {
8379                         $formats_nav .=
8380                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8381                                         "raw");
8382                 }
8383                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8384                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8385         } else {
8386                 print "<div class=\"page_nav\">\n" .
8387                       "<br/><br/></div>\n" .
8388                       "<div class=\"title\">".esc_html($hash)."</div>\n";
8389         }
8390         git_print_page_path($file_name, "blob", $hash_base);
8391         print "<div class=\"title_text\">\n" .
8392               "<table class=\"object_header\">\n";
8393         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8394         print "</table>".
8395               "</div>\n";
8396         print "<div class=\"page_body\">\n";
8397         if ($mimetype =~ m!^image/!) {
8398                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8399                 if ($file_name) {
8400                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8401                 }
8402                 print qq! src="! .
8403                       href(action=>"blob_plain", hash=>$hash,
8404                            hash_base=>$hash_base, file_name=>$file_name) .
8405                       qq!" />\n!;
8406         } else {
8407                 my $nr;
8408                 while (my $line = to_utf8(scalar <$fd>)) {
8409                         chomp $line;
8410                         $nr++;
8411                         $line = untabify($line);
8412                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
8413                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8414                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8415                 }
8416         }
8417         close $fd
8418                 or print "Reading blob failed.\n";
8419         print "</div>";
8420         git_footer_html();
8421 }
8422
8423 sub git_tree {
8424         my $fullhash;
8425         if (!defined $hash_base) {
8426                 $hash_base = "HEAD";
8427         }
8428         if (!defined $hash) {
8429                 if (defined $file_name) {
8430                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8431                         $fullhash = $hash;
8432                 } else {
8433                         $hash = $hash_base;
8434                 }
8435         }
8436         die_error(404, "No such tree") unless defined($hash);
8437         $fullhash = $hash if !$fullhash && $hash =~ m/^[0-9a-fA-F]{40}$/;
8438         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8439
8440         my $show_sizes = gitweb_check_feature('show-sizes');
8441         my $have_blame = gitweb_check_feature('blame');
8442
8443         my @entries = ();
8444         {
8445                 local $/ = "\0";
8446                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8447                         ($show_sizes ? '-l' : ()), @extra_options, $hash)
8448                         or die_error(500, "Open git-ls-tree failed");
8449                 @entries = map { chomp; to_utf8($_) } <$fd>;
8450                 close $fd
8451                         or die_error(404, "Reading tree failed");
8452         }
8453
8454         git_header_html();
8455         my $basedir = '';
8456         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8457                 my $refs = git_get_references();
8458                 my $ref = format_ref_marker($refs, $co{'id'});
8459                 my @views_nav = ();
8460                 if (defined $file_name) {
8461                         push @views_nav,
8462                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8463                                         "history"),
8464                                 $cgi->a({-href => href(action=>"tree",
8465                                                        hash_base=>"HEAD", file_name=>$file_name)},
8466                                         "HEAD"),
8467                 }
8468                 my $snapshot_links = format_snapshot_links($hash);
8469                 if (defined $snapshot_links) {
8470                         # FIXME: Should be available when we have no hash base as well.
8471                         push @views_nav, $snapshot_links;
8472                 }
8473                 git_print_page_nav('tree','', $hash_base, undef, undef,
8474                                    join(' | ', @views_nav));
8475                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8476         } else {
8477                 undef $hash_base;
8478                 print "<div class=\"page_nav\">\n";
8479                 print "<br/><br/></div>\n";
8480                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8481         }
8482         if (defined $file_name) {
8483                 $basedir = $file_name;
8484                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8485                         $basedir .= '/';
8486                 }
8487                 git_print_page_path($file_name, 'tree', $hash_base);
8488         }
8489         print "<div class=\"title_text\">\n" .
8490               "<table class=\"object_header\">\n";
8491         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8492         print "</table>".
8493               "</div>\n";
8494         print "<div class=\"page_body\">\n";
8495         print "<table class=\"tree\">\n";
8496         my $alternate = 1;
8497         # '..' (top directory) link if possible
8498         if (defined $hash_base &&
8499             defined $file_name && $file_name =~ m![^/]+$!) {
8500                 if ($alternate) {
8501                         print "<tr class=\"dark\">\n";
8502                 } else {
8503                         print "<tr class=\"light\">\n";
8504                 }
8505                 $alternate ^= 1;
8506
8507                 my $up = $file_name;
8508                 $up =~ s!/?[^/]+$!!;
8509                 undef $up unless $up;
8510                 # based on git_print_tree_entry
8511                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8512                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8513                 print '<td class="list">';
8514                 print $cgi->a({-href => href(action=>"tree",
8515                                              hash_base=>$hash_base,
8516                                              file_name=>$up)},
8517                               "..");
8518                 print "</td>\n";
8519                 print "<td class=\"link\"></td>\n";
8520
8521                 print "</tr>\n";
8522         }
8523         foreach my $line (@entries) {
8524                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8525
8526                 if ($alternate) {
8527                         print "<tr class=\"dark\">\n";
8528                 } else {
8529                         print "<tr class=\"light\">\n";
8530                 }
8531                 $alternate ^= 1;
8532
8533                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8534
8535                 print "</tr>\n";
8536         }
8537         print "</table>\n" .
8538               "</div>";
8539         git_footer_html();
8540 }
8541
8542 sub sanitize_for_filename {
8543     my $name = shift;
8544
8545     $name =~ s!/!-!g;
8546     $name =~ s/[^[:alnum:]_.-]//g;
8547
8548     return $name;
8549 }
8550
8551 sub snapshot_name {
8552         my ($project, $hash) = @_;
8553
8554         # path/to/project.git  -> project
8555         # path/to/project/.git -> project
8556         my $name = to_utf8($project);
8557         $name =~ s,([^/])/*\.git$,$1,;
8558         $name = sanitize_for_filename(basename($name));
8559
8560         my $ver = $hash;
8561         if ($hash =~ /^[0-9a-fA-F]+$/) {
8562                 # shorten SHA-1 hash
8563                 my $full_hash = git_get_full_hash($project, $hash);
8564                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8565                         $ver = git_get_short_hash($project, $hash);
8566                 }
8567         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8568                 # tags don't need shortened SHA-1 hash
8569                 $ver = $1;
8570         } else {
8571                 # branches and other need shortened SHA-1 hash
8572                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8573                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8574                         my $ref_dir = (defined $1) ? $1 : '';
8575                         $ver = $2;
8576
8577                         $ref_dir = sanitize_for_filename($ref_dir);
8578                         # for refs neither in heads nor remotes we want to
8579                         # add a ref dir to archive name
8580                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8581                                 $ver = $ref_dir . '-' . $ver;
8582                         }
8583                 }
8584                 $ver .= '-' . git_get_short_hash($project, $hash);
8585         }
8586         # special case of sanitization for filename - we change
8587         # slashes to dots instead of dashes
8588         # in case of hierarchical branch names
8589         $ver =~ s!/!.!g;
8590         $ver =~ s/[^[:alnum:]_.-]//g;
8591
8592         # name = project-version_string
8593         $name = "$name-$ver";
8594
8595         return wantarray ? ($name, $name) : $name;
8596 }
8597
8598 sub exit_if_unmodified_since {
8599         my ($latest_epoch) = @_;
8600         our $cgi;
8601
8602         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8603         if (defined $if_modified) {
8604                 my $since;
8605                 if (eval { require HTTP::Date; 1; }) {
8606                         $since = HTTP::Date::str2time($if_modified);
8607                 } elsif (eval { require Time::ParseDate; 1; }) {
8608                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8609                 }
8610                 if (defined $since && $latest_epoch <= $since) {
8611                         my %latest_date = parse_date($latest_epoch);
8612                         print $cgi->header(
8613                                 -last_modified => $latest_date{'rfc2822'},
8614                                 -status => '304 Not Modified');
8615                         goto DONE_GITWEB;
8616                 }
8617         }
8618 }
8619
8620 sub git_snapshot {
8621         my $format = $input_params{'snapshot_format'};
8622         if (!@snapshot_fmts) {
8623                 die_error(403, "Snapshots not allowed");
8624         }
8625         # default to first supported snapshot format
8626         $format ||= $snapshot_fmts[0];
8627         if ($format !~ m/^[a-z0-9]+$/) {
8628                 die_error(400, "Invalid snapshot format parameter");
8629         } elsif (!exists($known_snapshot_formats{$format})) {
8630                 die_error(400, "Unknown snapshot format");
8631         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8632                 die_error(403, "Snapshot format not allowed");
8633         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8634                 die_error(403, "Unsupported snapshot format");
8635         }
8636
8637         my $type = git_get_type("$hash^{}");
8638         if (!$type) {
8639                 die_error(404, 'Object does not exist');
8640         }  elsif ($type eq 'blob') {
8641                 die_error(400, 'Object is not a tree-ish');
8642         }
8643
8644         my ($name, $prefix) = snapshot_name($project, $hash);
8645         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8646
8647         my %co = parse_commit($hash);
8648         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8649
8650         my @cmd = (
8651                 git_cmd(), 'archive',
8652                 "--format=$known_snapshot_formats{$format}{'format'}",
8653                 "--prefix=$prefix/", $hash);
8654         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8655                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8656                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8657         }
8658
8659         $filename =~ s/(["\\])/\\$1/g;
8660         my %latest_date;
8661         if (%co) {
8662                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8663         }
8664
8665         print $cgi->header(
8666                 -type => $known_snapshot_formats{$format}{'type'},
8667                 -content_disposition => 'inline; filename="' . $filename . '"',
8668                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8669                 -status => '200 OK');
8670
8671         defined(my $fd = cmd_pipe @cmd)
8672                 or die_error(500, "Execute git-archive failed");
8673         binmode($fd);
8674         binmode STDOUT, ':raw';
8675         $fcgi_raw_mode = 1;
8676         my $buf;
8677         while (read($fd, $buf, 32768)) {
8678                 print $buf;
8679         }
8680         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8681         $fcgi_raw_mode = 0;
8682         close $fd;
8683 }
8684
8685 sub git_log_generic {
8686         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8687
8688         my $head = git_get_head_hash($project);
8689         if (!defined $base) {
8690                 $base = $head;
8691         }
8692         if (!defined $page) {
8693                 $page = 0;
8694         }
8695         my $refs = git_get_references();
8696
8697         my $commit_hash = $base;
8698         if (defined $parent) {
8699                 $commit_hash = "$parent..$base";
8700         }
8701         my @commitlist =
8702                 parse_commits($commit_hash, 101, (100 * $page),
8703                               defined $file_name ? ($file_name, "--full-history") : ());
8704
8705         my $ftype;
8706         if (!defined $file_hash && defined $file_name) {
8707                 # some commits could have deleted file in question,
8708                 # and not have it in tree, but one of them has to have it
8709                 for (my $i = 0; $i < @commitlist; $i++) {
8710                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8711                         last if defined $file_hash;
8712                 }
8713         }
8714         if (defined $file_hash) {
8715                 $ftype = git_get_type($file_hash);
8716         }
8717         if (defined $file_name && !defined $ftype) {
8718                 die_error(500, "Unknown type of object");
8719         }
8720         my %co;
8721         if (defined $file_name) {
8722                 %co = parse_commit($base)
8723                         or die_error(404, "Unknown commit object");
8724         }
8725
8726
8727         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100);
8728         my $next_link = '';
8729         if ($#commitlist >= 100) {
8730                 $next_link =
8731                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8732                                  -accesskey => "n", -title => "Alt-n"}, "next");
8733         }
8734         my ($patch_max) = gitweb_get_feature('patches');
8735         if ($patch_max && !defined $file_name) {
8736                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8737                         $paging_nav .= " &#183; " .
8738                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
8739                                         "patches");
8740                 }
8741         }
8742
8743         {
8744                 local $action = 'fulllog';
8745                 git_header_html();
8746         }
8747         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8748         if (defined $file_name) {
8749                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8750         } else {
8751                 git_print_header_div('summary', $project)
8752         }
8753         git_print_page_path($file_name, $ftype, $hash_base)
8754                 if (defined $file_name);
8755
8756         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8757                      $file_name, $file_hash, $ftype);
8758
8759         git_footer_html();
8760 }
8761
8762 sub git_log {
8763         git_log_generic('log', \&git_log_body,
8764                         $hash, $hash_parent);
8765 }
8766
8767 sub git_commit {
8768         $hash ||= $hash_base || "HEAD";
8769         my %co = parse_commit($hash)
8770             or die_error(404, "Unknown commit object");
8771
8772         my $parent  = $co{'parent'};
8773         my $parents = $co{'parents'}; # listref
8774
8775         # we need to prepare $formats_nav before any parameter munging
8776         my $formats_nav;
8777         if (!defined $parent) {
8778                 # --root commitdiff
8779                 $formats_nav .= '(initial)';
8780         } elsif (@$parents == 1) {
8781                 # single parent commit
8782                 $formats_nav .=
8783                         '(parent: ' .
8784                         $cgi->a({-href => href(action=>"commit",
8785                                                hash=>$parent)},
8786                                 esc_html(substr($parent, 0, 7))) .
8787                         ')';
8788         } else {
8789                 # merge commit
8790                 $formats_nav .=
8791                         '(merge: ' .
8792                         join(' ', map {
8793                                 $cgi->a({-href => href(action=>"commit",
8794                                                        hash=>$_)},
8795                                         esc_html(substr($_, 0, 7)));
8796                         } @$parents ) .
8797                         ')';
8798         }
8799         if (gitweb_check_feature('patches') && @$parents <= 1) {
8800                 $formats_nav .= " | " .
8801                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8802                                 "patch");
8803         }
8804
8805         if (!defined $parent) {
8806                 $parent = "--root";
8807         }
8808         my @difftree;
8809         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8810                 @diff_opts,
8811                 (@$parents <= 1 ? $parent : '-c'),
8812                 $hash, "--")
8813                 or die_error(500, "Open git-diff-tree failed");
8814         @difftree = map { chomp; to_utf8($_) } <$fd>;
8815         close $fd or die_error(404, "Reading git-diff-tree failed");
8816
8817         # non-textual hash id's can be cached
8818         my $expires;
8819         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8820                 $expires = "+1d";
8821         }
8822         my $refs = git_get_references();
8823         my $ref = format_ref_marker($refs, $co{'id'});
8824
8825         git_header_html(undef, $expires);
8826         git_print_page_nav('commit', '',
8827                            $hash, $co{'tree'}, $hash,
8828                            $formats_nav);
8829
8830         if (defined $co{'parent'}) {
8831                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
8832         } else {
8833                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
8834         }
8835         print "<div class=\"title_text\">\n" .
8836               "<table class=\"object_header\">\n";
8837         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8838         git_print_authorship_rows(\%co);
8839         print "<tr>" .
8840               "<td>tree</td>" .
8841               "<td class=\"sha1\">" .
8842               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8843                        class => "list"}, $co{'tree'}) .
8844               "</td>" .
8845               "<td class=\"link\">" .
8846               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8847                       "tree");
8848         my $snapshot_links = format_snapshot_links($hash);
8849         if (defined $snapshot_links) {
8850                 print " | " . $snapshot_links;
8851         }
8852         print "</td>" .
8853               "</tr>\n";
8854
8855         foreach my $par (@$parents) {
8856                 print "<tr>" .
8857                       "<td>parent</td>" .
8858                       "<td class=\"sha1\">" .
8859                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8860                                class => "list"}, $par) .
8861                       "</td>" .
8862                       "<td class=\"link\">" .
8863                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8864                       " | " .
8865                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8866                       "</td>" .
8867                       "</tr>\n";
8868         }
8869         print "</table>".
8870               "</div>\n";
8871
8872         print "<div class=\"page_body\">\n";
8873         git_print_log($co{'comment'});
8874         print "</div>\n";
8875
8876         git_difftree_body(\@difftree, $hash, @$parents);
8877
8878         git_footer_html();
8879 }
8880
8881 sub git_object {
8882         # object is defined by:
8883         # - hash or hash_base alone
8884         # - hash_base and file_name
8885         my $type;
8886
8887         # - hash or hash_base alone
8888         if ($hash || ($hash_base && !defined $file_name)) {
8889                 my $object_id = $hash || $hash_base;
8890
8891                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8892                         or die_error(404, "Object does not exist");
8893                 $type = <$fd>;
8894                 chomp $type;
8895                 close $fd
8896                         or die_error(404, "Object does not exist");
8897
8898         # - hash_base and file_name
8899         } elsif ($hash_base && defined $file_name) {
8900                 $file_name =~ s,/+$,,;
8901
8902                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
8903                         or die_error(404, "Base object does not exist");
8904
8905                 # here errors should not happen
8906                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
8907                         or die_error(500, "Open git-ls-tree failed");
8908                 my $line = to_utf8(scalar <$fd>);
8909                 close $fd;
8910
8911                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
8912                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
8913                         die_error(404, "File or directory for given base does not exist");
8914                 }
8915                 $type = $2;
8916                 $hash = $3;
8917         } else {
8918                 die_error(400, "Not enough information to find object");
8919         }
8920
8921         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
8922                                           hash=>$hash, hash_base=>$hash_base,
8923                                           file_name=>$file_name),
8924                              -status => '302 Found');
8925 }
8926
8927 sub git_blobdiff {
8928         my $format = shift || 'html';
8929         my $diff_style = $input_params{'diff_style'} || 'inline';
8930
8931         my $fd;
8932         my @difftree;
8933         my %diffinfo;
8934         my $expires;
8935
8936         # preparing $fd and %diffinfo for git_patchset_body
8937         # new style URI
8938         if (defined $hash_base && defined $hash_parent_base) {
8939                 if (defined $file_name) {
8940                         # read raw output
8941                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8942                                 $hash_parent_base, $hash_base,
8943                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
8944                                 or die_error(500, "Open git-diff-tree failed");
8945                         @difftree = map { chomp; to_utf8($_) } <$fd>;
8946                         close $fd
8947                                 or die_error(404, "Reading git-diff-tree failed");
8948                         @difftree
8949                                 or die_error(404, "Blob diff not found");
8950
8951                 } elsif (defined $hash &&
8952                          $hash =~ /[0-9a-fA-F]{40}/) {
8953                         # try to find filename from $hash
8954
8955                         # read filtered raw output
8956                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8957                                 $hash_parent_base, $hash_base, "--")
8958                                 or die_error(500, "Open git-diff-tree failed");
8959                         @difftree =
8960                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
8961                                 # $hash == to_id
8962                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
8963                                 map { chomp; to_utf8($_) } <$fd>;
8964                         close $fd
8965                                 or die_error(404, "Reading git-diff-tree failed");
8966                         @difftree
8967                                 or die_error(404, "Blob diff not found");
8968
8969                 } else {
8970                         die_error(400, "Missing one of the blob diff parameters");
8971                 }
8972
8973                 if (@difftree > 1) {
8974                         die_error(400, "Ambiguous blob diff specification");
8975                 }
8976
8977                 %diffinfo = parse_difftree_raw_line($difftree[0]);
8978                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
8979                 $file_name   ||= $diffinfo{'to_file'};
8980
8981                 $hash_parent ||= $diffinfo{'from_id'};
8982                 $hash        ||= $diffinfo{'to_id'};
8983
8984                 # non-textual hash id's can be cached
8985                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
8986                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
8987                         $expires = '+1d';
8988                 }
8989
8990                 # open patch output
8991                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8992                         '-p', ($format eq 'html' ? "--full-index" : ()),
8993                         $hash_parent_base, $hash_base,
8994                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
8995                         or die_error(500, "Open git-diff-tree failed");
8996         }
8997
8998         # old/legacy style URI -- not generated anymore since 1.4.3.
8999         if (!%diffinfo) {
9000                 die_error('404 Not Found', "Missing one of the blob diff parameters")
9001         }
9002
9003         # header
9004         if ($format eq 'html') {
9005                 my $formats_nav =
9006                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
9007                                 "raw");
9008                 $formats_nav .= diff_style_nav($diff_style);
9009                 git_header_html(undef, $expires);
9010                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
9011                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
9012                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
9013                 } else {
9014                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
9015                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
9016                 }
9017                 if (defined $file_name) {
9018                         git_print_page_path($file_name, "blob", $hash_base);
9019                 } else {
9020                         print "<div class=\"page_path\"></div>\n";
9021                 }
9022
9023         } elsif ($format eq 'plain') {
9024                 print $cgi->header(
9025                         -type => 'text/plain',
9026                         -charset => 'utf-8',
9027                         -expires => $expires,
9028                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
9029
9030                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9031
9032         } else {
9033                 die_error(400, "Unknown blobdiff format");
9034         }
9035
9036         # patch
9037         if ($format eq 'html') {
9038                 print "<div class=\"page_body\">\n";
9039
9040                 git_patchset_body($fd, $diff_style,
9041                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
9042                 close $fd;
9043
9044                 print "</div>\n"; # class="page_body"
9045                 git_footer_html();
9046
9047         } else {
9048                 while (my $line = to_utf8(scalar <$fd>)) {
9049                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
9050                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
9051
9052                         print $line;
9053
9054                         last if $line =~ m!^\+\+\+!;
9055                 }
9056                 while (<$fd>) {
9057                         print to_utf8($_);
9058                 }
9059                 close $fd;
9060         }
9061 }
9062
9063 sub git_blobdiff_plain {
9064         git_blobdiff('plain');
9065 }
9066
9067 # assumes that it is added as later part of already existing navigation,
9068 # so it returns "| foo | bar" rather than just "foo | bar"
9069 sub diff_style_nav {
9070         my ($diff_style, $is_combined) = @_;
9071         $diff_style ||= 'inline';
9072
9073         return "" if ($is_combined);
9074
9075         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
9076         my %styles = @styles;
9077         @styles =
9078                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9079
9080         return join '',
9081                 map { " | ".$_ }
9082                 map {
9083                         $_ eq $diff_style ? $styles{$_} :
9084                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
9085                 } @styles;
9086 }
9087
9088 sub git_commitdiff {
9089         my %params = @_;
9090         my $format = $params{-format} || 'html';
9091         my $diff_style = $input_params{'diff_style'} || 'inline';
9092
9093         my ($patch_max) = gitweb_get_feature('patches');
9094         if ($format eq 'patch') {
9095                 die_error(403, "Patch view not allowed") unless $patch_max;
9096         }
9097
9098         $hash ||= $hash_base || "HEAD";
9099         my %co = parse_commit($hash)
9100             or die_error(404, "Unknown commit object");
9101
9102         # choose format for commitdiff for merge
9103         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9104                 $hash_parent = '--cc';
9105         }
9106         # we need to prepare $formats_nav before almost any parameter munging
9107         my $formats_nav;
9108         if ($format eq 'html') {
9109                 $formats_nav =
9110                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9111                                 "raw");
9112                 if ($patch_max && @{$co{'parents'}} <= 1) {
9113                         $formats_nav .= " | " .
9114                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9115                                         "patch");
9116                 }
9117                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9118
9119                 if (defined $hash_parent &&
9120                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9121                         # commitdiff with two commits given
9122                         my $hash_parent_short = $hash_parent;
9123                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9124                                 $hash_parent_short = substr($hash_parent, 0, 7);
9125                         }
9126                         $formats_nav .=
9127                                 ' (from';
9128                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9129                                 if ($co{'parents'}[$i] eq $hash_parent) {
9130                                         $formats_nav .= ' parent ' . ($i+1);
9131                                         last;
9132                                 }
9133                         }
9134                         $formats_nav .= ': ' .
9135                                 $cgi->a({-href => href(-replay=>1,
9136                                                        hash=>$hash_parent, hash_base=>undef)},
9137                                         esc_html($hash_parent_short)) .
9138                                 ')';
9139                 } elsif (!$co{'parent'}) {
9140                         # --root commitdiff
9141                         $formats_nav .= ' (initial)';
9142                 } elsif (scalar @{$co{'parents'}} == 1) {
9143                         # single parent commit
9144                         $formats_nav .=
9145                                 ' (parent: ' .
9146                                 $cgi->a({-href => href(-replay=>1,
9147                                                        hash=>$co{'parent'}, hash_base=>undef)},
9148                                         esc_html(substr($co{'parent'}, 0, 7))) .
9149                                 ')';
9150                 } else {
9151                         # merge commit
9152                         if ($hash_parent eq '--cc') {
9153                                 $formats_nav .= ' | ' .
9154                                         $cgi->a({-href => href(-replay=>1,
9155                                                                hash=>$hash, hash_parent=>'-c')},
9156                                                 'combined');
9157                         } else { # $hash_parent eq '-c'
9158                                 $formats_nav .= ' | ' .
9159                                         $cgi->a({-href => href(-replay=>1,
9160                                                                hash=>$hash, hash_parent=>'--cc')},
9161                                                 'compact');
9162                         }
9163                         $formats_nav .=
9164                                 ' (merge: ' .
9165                                 join(' ', map {
9166                                         $cgi->a({-href => href(-replay=>1,
9167                                                                hash=>$_, hash_base=>undef)},
9168                                                 esc_html(substr($_, 0, 7)));
9169                                 } @{$co{'parents'}} ) .
9170                                 ')';
9171                 }
9172         }
9173
9174         my $hash_parent_param = $hash_parent;
9175         if (!defined $hash_parent_param) {
9176                 # --cc for multiple parents, --root for parentless
9177                 $hash_parent_param =
9178                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9179         }
9180
9181         # read commitdiff
9182         my $fd;
9183         my @difftree;
9184         if ($format eq 'html') {
9185                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9186                         "--no-commit-id", "--patch-with-raw", "--full-index",
9187                         $hash_parent_param, $hash, "--")
9188                         or die_error(500, "Open git-diff-tree failed");
9189
9190                 while (my $line = to_utf8(scalar <$fd>)) {
9191                         chomp $line;
9192                         # empty line ends raw part of diff-tree output
9193                         last unless $line;
9194                         push @difftree, scalar parse_difftree_raw_line($line);
9195                 }
9196
9197         } elsif ($format eq 'plain') {
9198                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9199                         '-p', $hash_parent_param, $hash, "--")
9200                         or die_error(500, "Open git-diff-tree failed");
9201         } elsif ($format eq 'patch') {
9202                 # For commit ranges, we limit the output to the number of
9203                 # patches specified in the 'patches' feature.
9204                 # For single commits, we limit the output to a single patch,
9205                 # diverging from the git-format-patch default.
9206                 my @commit_spec = ();
9207                 if ($hash_parent) {
9208                         if ($patch_max > 0) {
9209                                 push @commit_spec, "-$patch_max";
9210                         }
9211                         push @commit_spec, '-n', "$hash_parent..$hash";
9212                 } else {
9213                         if ($params{-single}) {
9214                                 push @commit_spec, '-1';
9215                         } else {
9216                                 if ($patch_max > 0) {
9217                                         push @commit_spec, "-$patch_max";
9218                                 }
9219                                 push @commit_spec, "-n";
9220                         }
9221                         push @commit_spec, '--root', $hash;
9222                 }
9223                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9224                         '--encoding=utf8', '--stdout', @commit_spec)
9225                         or die_error(500, "Open git-format-patch failed");
9226         } else {
9227                 die_error(400, "Unknown commitdiff format");
9228         }
9229
9230         # non-textual hash id's can be cached
9231         my $expires;
9232         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9233                 $expires = "+1d";
9234         }
9235
9236         # write commit message
9237         if ($format eq 'html') {
9238                 my $refs = git_get_references();
9239                 my $ref = format_ref_marker($refs, $co{'id'});
9240
9241                 git_header_html(undef, $expires);
9242                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9243                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9244                 print "<div class=\"title_text\">\n" .
9245                       "<table class=\"object_header\">\n";
9246                 git_print_authorship_rows(\%co);
9247                 print "</table>".
9248                       "</div>\n";
9249                 print "<div class=\"page_body\">\n";
9250                 if (@{$co{'comment'}} > 1) {
9251                         print "<div class=\"log\">\n";
9252                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9253                         print "</div>\n"; # class="log"
9254                 }
9255
9256         } elsif ($format eq 'plain') {
9257                 my $refs = git_get_references("tags");
9258                 my $tagname = git_get_rev_name_tags($hash);
9259                 my $filename = basename($project) . "-$hash.patch";
9260
9261                 print $cgi->header(
9262                         -type => 'text/plain',
9263                         -charset => 'utf-8',
9264                         -expires => $expires,
9265                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9266                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9267                 print "From: " . to_utf8($co{'author'}) . "\n";
9268                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9269                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9270
9271                 print "X-Git-Tag: $tagname\n" if $tagname;
9272                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9273
9274                 foreach my $line (@{$co{'comment'}}) {
9275                         print to_utf8($line) . "\n";
9276                 }
9277                 print "---\n\n";
9278         } elsif ($format eq 'patch') {
9279                 my $filename = basename($project) . "-$hash.patch";
9280
9281                 print $cgi->header(
9282                         -type => 'text/plain',
9283                         -charset => 'utf-8',
9284                         -expires => $expires,
9285                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9286         }
9287
9288         # write patch
9289         if ($format eq 'html') {
9290                 my $use_parents = !defined $hash_parent ||
9291                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9292                 git_difftree_body(\@difftree, $hash,
9293                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9294                 print "<br/>\n";
9295
9296                 git_patchset_body($fd, $diff_style,
9297                                   \@difftree, $hash,
9298                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9299                 close $fd;
9300                 print "</div>\n"; # class="page_body"
9301                 git_footer_html();
9302
9303         } elsif ($format eq 'plain') {
9304                 while (<$fd>) {
9305                         print to_utf8($_);
9306                 }
9307                 close $fd
9308                         or print "Reading git-diff-tree failed\n";
9309         } elsif ($format eq 'patch') {
9310                 while (<$fd>) {
9311                         print to_utf8($_);
9312                 }
9313                 close $fd
9314                         or print "Reading git-format-patch failed\n";
9315         }
9316 }
9317
9318 sub git_commitdiff_plain {
9319         git_commitdiff(-format => 'plain');
9320 }
9321
9322 # format-patch-style patches
9323 sub git_patch {
9324         git_commitdiff(-format => 'patch', -single => 1);
9325 }
9326
9327 sub git_patches {
9328         git_commitdiff(-format => 'patch');
9329 }
9330
9331 sub git_history {
9332         git_log_generic('history', \&git_history_body,
9333                         $hash_base, $hash_parent_base,
9334                         $file_name, $hash);
9335 }
9336
9337 sub git_search {
9338         $searchtype ||= 'commit';
9339
9340         # check if appropriate features are enabled
9341         gitweb_check_feature('search')
9342                 or die_error(403, "Search is disabled");
9343         if ($searchtype eq 'pickaxe') {
9344                 # pickaxe may take all resources of your box and run for several minutes
9345                 # with every query - so decide by yourself how public you make this feature
9346                 gitweb_check_feature('pickaxe')
9347                         or die_error(403, "Pickaxe search is disabled");
9348         }
9349         if ($searchtype eq 'grep') {
9350                 # grep search might be potentially CPU-intensive, too
9351                 gitweb_check_feature('grep')
9352                         or die_error(403, "Grep search is disabled");
9353         }
9354
9355         if (!defined $searchtext) {
9356                 die_error(400, "Text field is empty");
9357         }
9358         if (!defined $hash) {
9359                 $hash = git_get_head_hash($project);
9360         }
9361         my %co = parse_commit($hash);
9362         if (!%co) {
9363                 die_error(404, "Unknown commit object");
9364         }
9365         if (!defined $page) {
9366                 $page = 0;
9367         }
9368
9369         if ($searchtype eq 'commit' ||
9370             $searchtype eq 'author' ||
9371             $searchtype eq 'committer') {
9372                 git_search_message(%co);
9373         } elsif ($searchtype eq 'pickaxe') {
9374                 git_search_changes(%co);
9375         } elsif ($searchtype eq 'grep') {
9376                 git_search_files(%co);
9377         } else {
9378                 die_error(400, "Unknown search type");
9379         }
9380 }
9381
9382 sub git_search_help {
9383         git_header_html();
9384         git_print_page_nav('','', $hash,$hash,$hash);
9385         print <<EOT;
9386 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9387 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9388 the pattern entered is recognized as the POSIX extended
9389 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9390 insensitive).</p>
9391 <dl>
9392 <dt><b>commit</b></dt>
9393 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9394 EOT
9395         my $have_grep = gitweb_check_feature('grep');
9396         if ($have_grep) {
9397                 print <<EOT;
9398 <dt><b>grep</b></dt>
9399 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9400     a different one) are searched for the given pattern. On large trees, this search can take
9401 a while and put some strain on the server, so please use it with some consideration. Note that
9402 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9403 case-sensitive.</dd>
9404 EOT
9405         }
9406         print <<EOT;
9407 <dt><b>author</b></dt>
9408 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9409 <dt><b>committer</b></dt>
9410 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9411 EOT
9412         my $have_pickaxe = gitweb_check_feature('pickaxe');
9413         if ($have_pickaxe) {
9414                 print <<EOT;
9415 <dt><b>pickaxe</b></dt>
9416 <dd>All commits that caused the string to appear or disappear from any file (changes that
9417 added, removed or "modified" the string) will be listed. This search can take a while and
9418 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9419 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9420 EOT
9421         }
9422         print "</dl>\n";
9423         git_footer_html();
9424 }
9425
9426 sub git_shortlog {
9427         git_log_generic('shortlog', \&git_shortlog_body,
9428                         $hash, $hash_parent);
9429 }
9430
9431 ## ......................................................................
9432 ## feeds (RSS, Atom; OPML)
9433
9434 sub git_feed {
9435         my $format = shift || 'atom';
9436         my $have_blame = gitweb_check_feature('blame');
9437
9438         # Atom: http://www.atomenabled.org/developers/syndication/
9439         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9440         if ($format ne 'rss' && $format ne 'atom') {
9441                 die_error(400, "Unknown web feed format");
9442         }
9443
9444         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9445         my $head = $hash || 'HEAD';
9446         my @commitlist = parse_commits($head, 150, 0, $file_name);
9447
9448         my %latest_commit;
9449         my %latest_date;
9450         my $content_type = "application/$format+xml";
9451         if (defined $cgi->http('HTTP_ACCEPT') &&
9452                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9453                 # browser (feed reader) prefers text/xml
9454                 $content_type = 'text/xml';
9455         }
9456         if (defined($commitlist[0])) {
9457                 %latest_commit = %{$commitlist[0]};
9458                 my $latest_epoch = $latest_commit{'committer_epoch'};
9459                 exit_if_unmodified_since($latest_epoch);
9460                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9461         }
9462         print $cgi->header(
9463                 -type => $content_type,
9464                 -charset => 'utf-8',
9465                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9466                 -status => '200 OK');
9467
9468         # Optimization: skip generating the body if client asks only
9469         # for Last-Modified date.
9470         return if ($cgi->request_method() eq 'HEAD');
9471
9472         # header variables
9473         my $title = "$site_name - $project/$action";
9474         my $feed_type = 'log';
9475         if (defined $hash) {
9476                 $title .= " - '$hash'";
9477                 $feed_type = 'branch log';
9478                 if (defined $file_name) {
9479                         $title .= " :: $file_name";
9480                         $feed_type = 'history';
9481                 }
9482         } elsif (defined $file_name) {
9483                 $title .= " - $file_name";
9484                 $feed_type = 'history';
9485         }
9486         $title .= " $feed_type";
9487         $title = esc_html($title);
9488         my $descr = git_get_project_description($project);
9489         if (defined $descr) {
9490                 $descr = esc_html($descr);
9491         } else {
9492                 $descr = "$project " .
9493                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9494                          " feed";
9495         }
9496         my $owner = git_get_project_owner($project);
9497         $owner = esc_html($owner);
9498
9499         #header
9500         my $alt_url;
9501         if (defined $file_name) {
9502                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9503         } elsif (defined $hash) {
9504                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9505         } else {
9506                 $alt_url = href(-full=>1, action=>"summary");
9507         }
9508         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9509         if ($format eq 'rss') {
9510                 print <<XML;
9511 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9512 <channel>
9513 XML
9514                 print "<title>$title</title>\n" .
9515                       "<link>$alt_url</link>\n" .
9516                       "<description>$descr</description>\n" .
9517                       "<language>en</language>\n" .
9518                       # project owner is responsible for 'editorial' content
9519                       "<managingEditor>$owner</managingEditor>\n";
9520                 if (defined $logo || defined $favicon) {
9521                         # prefer the logo to the favicon, since RSS
9522                         # doesn't allow both
9523                         my $img = esc_url($logo || $favicon);
9524                         print "<image>\n" .
9525                               "<url>$img</url>\n" .
9526                               "<title>$title</title>\n" .
9527                               "<link>$alt_url</link>\n" .
9528                               "</image>\n";
9529                 }
9530                 if (%latest_date) {
9531                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9532                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9533                 }
9534                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9535         } elsif ($format eq 'atom') {
9536                 print <<XML;
9537 <feed xmlns="http://www.w3.org/2005/Atom">
9538 XML
9539                 print "<title>$title</title>\n" .
9540                       "<subtitle>$descr</subtitle>\n" .
9541                       '<link rel="alternate" type="text/html" href="' .
9542                       $alt_url . '" />' . "\n" .
9543                       '<link rel="self" type="' . $content_type . '" href="' .
9544                       $cgi->self_url() . '" />' . "\n" .
9545                       "<id>" . href(-full=>1) . "</id>\n" .
9546                       # use project owner for feed author
9547                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9548                 if (defined $favicon) {
9549                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9550                 }
9551                 if (defined $logo) {
9552                         # not twice as wide as tall: 72 x 27 pixels
9553                         print "<logo>" . esc_url($logo) . "</logo>\n";
9554                 }
9555                 if (! %latest_date) {
9556                         # dummy date to keep the feed valid until commits trickle in:
9557                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9558                 } else {
9559                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9560                 }
9561                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9562         }
9563
9564         # contents
9565         for (my $i = 0; $i <= $#commitlist; $i++) {
9566                 my %co = %{$commitlist[$i]};
9567                 my $commit = $co{'id'};
9568                 # we read 150, we always show 30 and the ones more recent than 48 hours
9569                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9570                         last;
9571                 }
9572                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9573
9574                 # get list of changed files
9575                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9576                         $co{'parent'} || "--root",
9577                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9578                         or next;
9579                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9580                 close $fd
9581                         or next;
9582
9583                 # print element (entry, item)
9584                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9585                 if ($format eq 'rss') {
9586                         print "<item>\n" .
9587                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9588                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9589                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9590                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9591                               "<link>$co_url</link>\n" .
9592                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9593                               "<content:encoded>" .
9594                               "<![CDATA[\n";
9595                 } elsif ($format eq 'atom') {
9596                         print "<entry>\n" .
9597                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9598                               "<updated>$cd{'iso-8601'}</updated>\n" .
9599                               "<author>\n" .
9600                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9601                         if ($co{'author_email'}) {
9602                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9603                         }
9604                         print "</author>\n" .
9605                               # use committer for contributor
9606                               "<contributor>\n" .
9607                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9608                         if ($co{'committer_email'}) {
9609                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9610                         }
9611                         print "</contributor>\n" .
9612                               "<published>$cd{'iso-8601'}</published>\n" .
9613                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9614                               "<id>$co_url</id>\n" .
9615                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9616                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9617                 }
9618                 my $comment = $co{'comment'};
9619                 print "<pre>\n";
9620                 foreach my $line (@$comment) {
9621                         $line = esc_html($line);
9622                         print "$line\n";
9623                 }
9624                 print "</pre><ul>\n";
9625                 foreach my $difftree_line (@difftree) {
9626                         my %difftree = parse_difftree_raw_line($difftree_line);
9627                         next if !$difftree{'from_id'};
9628
9629                         my $file = $difftree{'file'} || $difftree{'to_file'};
9630
9631                         print "<li>" .
9632                               "[" .
9633                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9634                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9635                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9636                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9637                                       -title => "diff"}, 'D');
9638                         if ($have_blame) {
9639                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9640                                                              file_name=>$file, hash_base=>$commit),
9641                                               -class => "blamelink",
9642                                               -title => "blame"}, 'B');
9643                         }
9644                         # if this is not a feed of a file history
9645                         if (!defined $file_name || $file_name ne $file) {
9646                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9647                                                              file_name=>$file, hash=>$commit),
9648                                               -title => "history"}, 'H');
9649                         }
9650                         $file = esc_path($file);
9651                         print "] ".
9652                               "$file</li>\n";
9653                 }
9654                 if ($format eq 'rss') {
9655                         print "</ul>]]>\n" .
9656                               "</content:encoded>\n" .
9657                               "</item>\n";
9658                 } elsif ($format eq 'atom') {
9659                         print "</ul>\n</div>\n" .
9660                               "</content>\n" .
9661                               "</entry>\n";
9662                 }
9663         }
9664
9665         # end of feed
9666         if ($format eq 'rss') {
9667                 print "</channel>\n</rss>\n";
9668         } elsif ($format eq 'atom') {
9669                 print "</feed>\n";
9670         }
9671 }
9672
9673 sub git_rss {
9674         git_feed('rss');
9675 }
9676
9677 sub git_atom {
9678         git_feed('atom');
9679 }
9680
9681 sub git_opml {
9682         my @list = git_get_projects_list($project_filter, $strict_export);
9683         if (!@list) {
9684                 die_error(404, "No projects found");
9685         }
9686
9687         print $cgi->header(
9688                 -type => 'text/xml',
9689                 -charset => 'utf-8',
9690                 -content_disposition => 'inline; filename="opml.xml"');
9691
9692         my $title = esc_html($site_name);
9693         my $filter = " within subdirectory ";
9694         if (defined $project_filter) {
9695                 $filter .= esc_html($project_filter);
9696         } else {
9697                 $filter = "";
9698         }
9699         print <<XML;
9700 <?xml version="1.0" encoding="utf-8"?>
9701 <opml version="1.0">
9702 <head>
9703   <title>$title OPML Export$filter</title>
9704 </head>
9705 <body>
9706 <outline text="git RSS feeds">
9707 XML
9708
9709         foreach my $pr (@list) {
9710                 my %proj = %$pr;
9711                 my $head = git_get_head_hash($proj{'path'});
9712                 if (!defined $head) {
9713                         next;
9714                 }
9715                 $git_dir = "$projectroot/$proj{'path'}";
9716                 my %co = parse_commit($head);
9717                 if (!%co) {
9718                         next;
9719                 }
9720
9721                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9722                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9723                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9724                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9725         }
9726         print <<XML;
9727 </outline>
9728 </body>
9729 </opml>
9730 XML
9731 }