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 our ($mdotsep, $barsep, $spcsep);
  33
  34 BEGIN {
  35         *mdotsep = \'<span class="mdotsep">&#160;&#183;&#160;</span>';
  36         *barsep = \'<span class="barsep">&#160;|&#160;</span>';
  37         *spcsep = \'<span class="spcsep">&#160</span>';
  38         CGI->compile() if $ENV{'MOD_PERL'};
  39 }
  40
  41 our $version = "++GIT_VERSION++";
  42
  43 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  44 sub evaluate_uri {
  45         our $cgi;
  46
  47         our $my_url = $cgi->url();
  48         our $my_uri = $cgi->url(-absolute => 1);
  49
  50         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  51         # needed and used only for URLs with nonempty PATH_INFO
  52         # This must be an absolute URL (i.e. no scheme, host or port), NOT a full one
  53         our $base_url = $my_uri || '/';
  54
  55         # When the script is used as DirectoryIndex, the URL does not contain the name
  56         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  57         # have to do it ourselves. We make $path_info global because it's also used
  58         # later on.
  59         #
  60         # Another issue with the script being the DirectoryIndex is that the resulting
  61         # $my_url data is not the full script URL: this is good, because we want
  62         # generated links to keep implying the script name if it wasn't explicitly
  63         # indicated in the URL we're handling, but it means that $my_url cannot be used
  64         # as base URL.
  65         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  66         # to build the base URL ourselves:
  67         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  68         if ($path_info) {
  69                 # $path_info has already been URL-decoded by the web server, but
  70                 # $my_url and $my_uri have not. URL-decode them so we can properly
  71                 # strip $path_info.
  72                 $my_url = unescape($my_url);
  73                 $my_uri = unescape($my_uri);
  74                 if ($my_url =~ s,\Q$path_info\E$,, &&
  75                     $my_uri =~ s,\Q$path_info\E$,, &&
  76                     defined $ENV{'SCRIPT_NAME'}) {
  77                         $base_url = $ENV{'SCRIPT_NAME'} || '/';
  78                 }
  79         }
  80
  81         # target of the home link on top of all pages
  82         our $home_link = $my_uri || "/";
  83 }
  84
  85 # core git executable to use
  86 # this can just be "git" if your webserver has a sensible PATH
  87 our $GIT = "++GIT_BINDIR++/git";
  88
  89 # absolute fs-path which will be prepended to the project path
  90 #our $projectroot = "/pub/scm";
  91 our $projectroot = "++GITWEB_PROJECTROOT++";
  92
  93 # fs traversing limit for getting project list
  94 # the number is relative to the projectroot
  95 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  96
  97 # string of the home link on top of all pages
  98 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  99
 100 # extra breadcrumbs preceding the home link
 101 our @extra_breadcrumbs = ();
 102
 103 # name of your site or organization to appear in page titles
 104 # replace this with something more descriptive for clearer bookmarks
 105 our $site_name = "++GITWEB_SITENAME++"
 106                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 107
 108 # html snippet to include in the <head> section of each page
 109 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 110 # filename of html text to include at top of each page
 111 our $site_header = "++GITWEB_SITE_HEADER++";
 112 # html text to include at home page
 113 our $home_text = "++GITWEB_HOMETEXT++";
 114 # filename of html text to include at bottom of each page
 115 our $site_footer = "++GITWEB_SITE_FOOTER++";
 116
 117 # URI of stylesheets
 118 our @stylesheets = ("++GITWEB_CSS++");
 119 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 120 our $stylesheet = undef;
 121 # URI of GIT logo (72x27 size)
 122 our $logo = "++GITWEB_LOGO++";
 123 # URI of GIT favicon, assumed to be image/png type
 124 our $favicon = "++GITWEB_FAVICON++";
 125 # URI of gitweb.js (JavaScript code for gitweb)
 126 our $javascript = "++GITWEB_JS++";
 127
 128 # URI and label (title) of GIT logo link
 129 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 130 #our $logo_label = "git documentation";
 131 our $logo_url = "http://git-scm.com/";
 132 our $logo_label = "git homepage";
 133
 134 # source of projects list
 135 our $projects_list = "++GITWEB_LIST++";
 136
 137 # the width (in characters) of the projects list "Description" column
 138 our $projects_list_description_width = 25;
 139
 140 # group projects by category on the projects list
 141 # (enabled if this variable evaluates to true)
 142 our $projects_list_group_categories = 0;
 143
 144 # default category if none specified
 145 # (leave the empty string for no category)
 146 our $project_list_default_category = "";
 147
 148 # default order of projects list
 149 # valid values are none, project, descr, owner, and age
 150 our $default_projects_order = "project";
 151
 152 # default order of refs list
 153 # valid values are age and name
 154 our $default_refs_order = "age";
 155
 156 # show repository only if this file exists
 157 # (only effective if this variable evaluates to true)
 158 our $export_ok = "++GITWEB_EXPORT_OK++";
 159
 160 # don't generate age column on the projects list page
 161 our $omit_age_column = 0;
 162
 163 # use contents of this file (in iso, iso-strict or raw format) as
 164 # the last activity data if it exists and is a valid date
 165 our $lastactivity_file = undef;
 166
 167 # don't generate information about owners of repositories
 168 our $omit_owner=0;
 169
 170 # owner link hook given owner name (full and NOT obfuscated)
 171 # should return full URL-escaped link to attach to owner, for example:
 172 #    sub { return "/showowner.cgi?owner=".CGI::Util::escape($_[0]); }
 173 our $owner_link_hook = undef;
 174
 175 # show repository only if this subroutine returns true
 176 # when given the path to the project, for example:
 177 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 178 our $export_auth_hook = undef;
 179
 180 # only allow viewing of repositories also shown on the overview page
 181 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 182
 183 # list of git base URLs used for URL to where fetch project from,
 184 # i.e. full URL is "$git_base_url/$project"
 185 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 186
 187 # URLs designated for pushing new changes, extended by the
 188 # project name (i.e. "$git_base_push_url[0]/$project")
 189 our @git_base_push_urls = ();
 190
 191 # https hint html inserted right after any https push URL (undef for none)
 192 our $https_hint_html = undef;
 193
 194 # default blob_plain mimetype and default charset for text/plain blob
 195 our $default_blob_plain_mimetype = 'application/octet-stream';
 196 our $default_text_plain_charset  = undef;
 197
 198 # file to use for guessing MIME types before trying /etc/mime.types
 199 # (relative to the current git repository)
 200 our $mimetypes_file = undef;
 201
 202 # assume this charset if line contains non-UTF-8 characters;
 203 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 204 # for which encoding all byte sequences are valid, for example
 205 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 206 # could be even 'utf-8' for the old behavior)
 207 our $fallback_encoding = 'latin1';
 208
 209 # rename detection options for git-diff and git-diff-tree
 210 # - default is '-M', with the cost proportional to
 211 #   (number of removed files) * (number of new files).
 212 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 213 #   (number of changed files + number of removed files) * (number of new files)
 214 # - even more costly is '-C', '--find-copies-harder' with cost
 215 #   (number of files in the original tree) * (number of new files)
 216 # - one might want to include '-B' option, e.g. '-B', '-M'
 217 our @diff_opts = ('-M'); # taken from git_commit
 218
 219 # cache directory (relative to $GIT_DIR) for project-specific html page caches.
 220 # the directory must exist and be writable by the process running gitweb.
 221 # additionally some actions must be selected for caching in %html_cache_actions
 222 # - default is 'htmlcache'
 223 our $html_cache_dir = 'htmlcache';
 224
 225 # which actions to cache in $html_cache_dir
 226 # if $html_cache_dir exists (relative to $GIT_DIR) and is writable by the
 227 # process running gitweb, then any actions selected here will have their output
 228 # cached and the cache file will be returned instead of regenerating the page
 229 # if it exists.  For this to be useful, an external process must create the
 230 # 'changed' file (if it does not already exist) in the $html_cache_dir whenever
 231 # the project information has been changed.  Alternatively it may create a
 232 # "$action.changed" file (if it does not exist) instead to limit the changes
 233 # to just "$action" instead of any action.  If 'changed' or "$action.changed"
 234 # exist, then the cached version will never be used for "$action" and a new
 235 # cache page will be regenerated (and the "changed" files removed as appropriate).
 236 #
 237 # Additionally if $projlist_cache_lifetime is > 0 AND the forks feature has been
 238 # enabled ('$feature{'forks'}{'default'} = [1];') then additionally an external
 239 # process must create the 'forkchange' file or update its timestamp if it already
 240 # exists whenever a fork is added to or removed from the project (as well as
 241 # create the 'changed' or "$action.changed" file).  Otherwise the "forks"
 242 # section on the summary page may remain out-of-date indefinately.
 243 #
 244 # - default is none
 245 #   currently only caching of the summary page is supported
 246 # - to enable caching of the summary page use:
 247 #   $html_cache_actions{'summary'} = 1;
 248 our %html_cache_actions = ();
 249
 250 # Disables features that would allow repository owners to inject script into
 251 # the gitweb domain.
 252 our $prevent_xss = 0;
 253
 254 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 255 # Only used when highlight is enabled or snapshots with compressors are enabled.
 256 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 257
 258 # Path to the highlight executable to use (must be the one from
 259 # http://www.andre-simon.de due to assumptions about parameters and output).
 260 # Useful if highlight is not installed on your webserver's PATH.
 261 # [Default: highlight]
 262 our $highlight_bin = "++HIGHLIGHT_BIN++";
 263
 264 # Whether to include project list on the gitweb front page; 0 means yes,
 265 # 1 means no list but show tag cloud if enabled (all projects still need
 266 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 267 # (very fast)
 268 our $frontpage_no_project_list = 0;
 269
 270 # projects list cache for busy sites with many projects;
 271 # if you set this to non-zero, it will be used as the cached
 272 # index lifetime in minutes
 273 #
 274 # the cached list version is stored in $cache_dir/$cache_name and can
 275 # be tweaked by other scripts running with the same uid as gitweb -
 276 # use this ONLY at secure installations; only single gitweb project
 277 # root per system is supported, unless you tweak configuration!
 278 our $projlist_cache_lifetime = 0; # in minutes
 279 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 280 our $cache_dir =
 281         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 282 our $projlist_cache_name = 'gitweb.index.cache';
 283 our $cache_grpshared = 0;
 284
 285 # information about snapshot formats that gitweb is capable of serving
 286 our %known_snapshot_formats = (
 287         # name => {
 288         #       'display' => display name,
 289         #       'type' => mime type,
 290         #       'suffix' => filename suffix,
 291         #       'format' => --format for git-archive,
 292         #       'compressor' => [compressor command and arguments]
 293         #                       (array reference, optional)
 294         #       'disabled' => boolean (optional)}
 295         #
 296         'tgz' => {
 297                 'display' => 'tar.gz',
 298                 'type' => 'application/x-gzip',
 299                 'suffix' => '.tar.gz',
 300                 'format' => 'tar',
 301                 'compressor' => ['gzip', '-n']},
 302
 303         'tbz2' => {
 304                 'display' => 'tar.bz2',
 305                 'type' => 'application/x-bzip2',
 306                 'suffix' => '.tar.bz2',
 307                 'format' => 'tar',
 308                 'compressor' => ['bzip2']},
 309
 310         'txz' => {
 311                 'display' => 'tar.xz',
 312                 'type' => 'application/x-xz',
 313                 'suffix' => '.tar.xz',
 314                 'format' => 'tar',
 315                 'compressor' => ['xz'],
 316                 'disabled' => 1},
 317
 318         'zip' => {
 319                 'display' => 'zip',
 320                 'type' => 'application/x-zip',
 321                 'suffix' => '.zip',
 322                 'format' => 'zip'},
 323 );
 324
 325 # Aliases so we understand old gitweb.snapshot values in repository
 326 # configuration.
 327 our %known_snapshot_format_aliases = (
 328         'gzip'  => 'tgz',
 329         'bzip2' => 'tbz2',
 330         'xz'    => 'txz',
 331
 332         # backward compatibility: legacy gitweb config support
 333         'x-gzip' => undef, 'gz' => undef,
 334         'x-bzip2' => undef, 'bz2' => undef,
 335         'x-zip' => undef, '' => undef,
 336 );
 337
 338 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 339 # are changed, it may be appropriate to change these values too via
 340 # $GITWEB_CONFIG.
 341 our %avatar_size = (
 342         'default' => 16,
 343         'double'  => 32
 344 );
 345
 346 # Used to set the maximum load that we will still respond to gitweb queries.
 347 # If server load exceed this value then return "503 server busy" error.
 348 # If gitweb cannot determined server load, it is taken to be 0.
 349 # Leave it undefined (or set to 'undef') to turn off load checking.
 350 our $maxload = 300;
 351
 352 # configuration for 'highlight' (http://www.andre-simon.de/)
 353 # match by basename
 354 our %highlight_basename = (
 355         #'Program' => 'py',
 356         #'Library' => 'py',
 357         'SConstruct' => 'py', # SCons equivalent of Makefile
 358         'Makefile' => 'make',
 359         'makefile' => 'make',
 360         'GNUmakefile' => 'make',
 361         'BSDmakefile' => 'make',
 362 );
 363 # match by shebang regex
 364 our %highlight_shebang = (
 365         # Each entry has a key which is the syntax to use and
 366         # a value which is either a qr regex or an array of qr regexs to match
 367         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 368         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 369         # allow a limited subset of NAME=value items to appear.
 370         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 371                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 372         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 373                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 374         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 375                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 376         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 377                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 378         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 379                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 380         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 381                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 382         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 383                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 384 );
 385 # match by extension
 386 our %highlight_ext = (
 387         # main extensions, defining name of syntax;
 388         # see files in /usr/share/highlight/langDefs/ directory
 389         (map { $_ => $_ } qw(
 390                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 391                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 392                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 393                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 394                 go haskell hcl html httpd hx icl icn idl idlang ili
 395                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 396                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 397                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 398                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 399                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 400                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 401                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 402                 yaiff znn)),
 403         # alternate extensions, see /etc/highlight/filetypes.conf
 404         (map { $_ => '4gl' } qw(informix)),
 405         (map { $_ => 'a4c' } qw(ascend)),
 406         (map { $_ => 'abp' } qw(abp4)),
 407         (map { $_ => 'ada' } qw(a adb ads gnad)),
 408         (map { $_ => 'ahk' } qw(autohotkey)),
 409         (map { $_ => 'ampl' } qw(dat run)),
 410         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 411         (map { $_ => 'as' } qw(actionscript)),
 412         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 413         (map { $_ => 'asp' } qw(asa)),
 414         (map { $_ => 'aspect' } qw(was wud)),
 415         (map { $_ => 'ats' } qw(dats)),
 416         (map { $_ => 'au3' } qw(autoit)),
 417         (map { $_ => 'bat' } qw(cmd)),
 418         (map { $_ => 'bb' } qw(blitzbasic)),
 419         (map { $_ => 'bib' } qw(bibtex)),
 420         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 421         (map { $_ => 'cb' } qw(clearbasic)),
 422         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 423         (map { $_ => 'chl' } qw(chill)),
 424         (map { $_ => 'cob' } qw(cbl cobol)),
 425         (map { $_ => 'cs' } qw(csharp)),
 426         (map { $_ => 'diff' } qw(patch)),
 427         (map { $_ => 'dot' } qw(graphviz)),
 428         (map { $_ => 'e' } qw(eiffel se)),
 429         (map { $_ => 'erl' } qw(erlang hrl)),
 430         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 431         (map { $_ => 'exp' } qw(express)),
 432         (map { $_ => 'f90' } qw(f95)),
 433         (map { $_ => 'flx' } qw(felix)),
 434         (map { $_ => 'for' } qw(f f77 ftn)),
 435         (map { $_ => 'fs' } qw(fsharp fsx)),
 436         (map { $_ => 'haskell' } qw(hs)),
 437         (map { $_ => 'html' } qw(htm xhtml)),
 438         (map { $_ => 'hx' } qw(haxe)),
 439         (map { $_ => 'icl' } qw(clean)),
 440         (map { $_ => 'icn' } qw(icon)),
 441         (map { $_ => 'ili' } qw(interlis)),
 442         (map { $_ => 'inp' } qw(fame)),
 443         (map { $_ => 'iss' } qw(innosetup)),
 444         (map { $_ => 'j' } qw(jasmin)),
 445         (map { $_ => 'java' } qw(groovy grv)),
 446         (map { $_ => 'lbn' } qw(luban)),
 447         (map { $_ => 'lgt' } qw(logtalk)),
 448         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 449         (map { $_ => 'ls' } qw(lotus)),
 450         (map { $_ => 'lsl' } qw(lindenscript)),
 451         (map { $_ => 'ly' } qw(lilypond)),
 452         (map { $_ => 'make' } qw(mak mk kmk)),
 453         (map { $_ => 'mel' } qw(maya)),
 454         (map { $_ => 'mib' } qw(smi snmp)),
 455         (map { $_ => 'ml' } qw(mli ocaml)),
 456         (map { $_ => 'mo' } qw(modelica)),
 457         (map { $_ => 'mod2' } qw(def mod)),
 458         (map { $_ => 'mod3' } qw(i3 m3)),
 459         (map { $_ => 'mpl' } qw(maple)),
 460         (map { $_ => 'n' } qw(nemerle)),
 461         (map { $_ => 'nas' } qw(nasal)),
 462         (map { $_ => 'nrx' } qw(netrexx)),
 463         (map { $_ => 'nsi' } qw(nsis)),
 464         (map { $_ => 'nut' } qw(squirrel)),
 465         (map { $_ => 'oberon' } qw(ooc)),
 466         (map { $_ => 'objc' } qw(M m mm)),
 467         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 468         (map { $_ => 'pike' } qw(pmod)),
 469         (map { $_ => 'pl' } qw(perl plex plx pm)),
 470         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 471         (map { $_ => 'progress' } qw(i p w)),
 472         (map { $_ => 'py' } qw(python)),
 473         (map { $_ => 'pyx' } qw(pyrex)),
 474         (map { $_ => 'rb' } qw(pp rjs ruby)),
 475         (map { $_ => 'rexx' } qw(rex rx the)),
 476         (map { $_ => 'sc' } qw(paradox)),
 477         (map { $_ => 'scilab' } qw(sce sci)),
 478         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 479         (map { $_ => 'sma' } qw(small)),
 480         (map { $_ => 'smalltalk' } qw(gst sq st)),
 481         (map { $_ => 'sno' } qw(snobal)),
 482         (map { $_ => 'sybase' } qw(sp)),
 483         (map { $_ => 'tcl' } qw(itcl wish)),
 484         (map { $_ => 'tex' } qw(cls sty)),
 485         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 486         (map { $_ => 'verilog' } qw(v)),
 487         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 488         (map { $_ => 'y' } qw(bison)),
 489 );
 490
 491 # You define site-wide feature defaults here; override them with
 492 # $GITWEB_CONFIG as necessary.
 493 our %feature = (
 494         # feature => {
 495         #       'sub' => feature-sub (subroutine),
 496         #       'override' => allow-override (boolean),
 497         #       'default' => [ default options...] (array reference)}
 498         #
 499         # if feature is overridable (it means that allow-override has true value),
 500         # then feature-sub will be called with default options as parameters;
 501         # return value of feature-sub indicates if to enable specified feature
 502         #
 503         # if there is no 'sub' key (no feature-sub), then feature cannot be
 504         # overridden
 505         #
 506         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 507         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 508         # is enabled
 509
 510         # Enable the 'blame' blob view, showing the last commit that modified
 511         # each line in the file. This can be very CPU-intensive.
 512
 513         # To enable system wide have in $GITWEB_CONFIG
 514         # $feature{'blame'}{'default'} = [1];
 515         # To have project specific config enable override in $GITWEB_CONFIG
 516         # $feature{'blame'}{'override'} = 1;
 517         # and in project config gitweb.blame = 0|1;
 518         'blame' => {
 519                 'sub' => sub { feature_bool('blame', @_) },
 520                 'override' => 0,
 521                 'default' => [0]},
 522
 523         # Enable the 'incremental blame' blob view, which uses javascript to
 524         # incrementally show the revisions of lines as they are discovered
 525         # in the history. It is better for large histories, files and slow
 526         # servers, but requires javascript in the client and can slow down the
 527         # browser on large files.
 528
 529         # To enable system wide have in $GITWEB_CONFIG
 530         # $feature{'blame_incremental'}{'default'} = [1];
 531         # To have project specific config enable override in $GITWEB_CONFIG
 532         # $feature{'blame_incremental'}{'override'} = 1;
 533         # and in project config gitweb.blame_incremental = 0|1;
 534         'blame_incremental' => {
 535                 'sub' => sub { feature_bool('blame_incremental', @_) },
 536                 'override' => 0,
 537                 'default' => [0]},
 538
 539         # Enable the 'snapshot' link, providing a compressed archive of any
 540         # tree. This can potentially generate high traffic if you have large
 541         # project.
 542
 543         # Value is a list of formats defined in %known_snapshot_formats that
 544         # you wish to offer.
 545         # To disable system wide have in $GITWEB_CONFIG
 546         # $feature{'snapshot'}{'default'} = [];
 547         # To have project specific config enable override in $GITWEB_CONFIG
 548         # $feature{'snapshot'}{'override'} = 1;
 549         # and in project config, a comma-separated list of formats or "none"
 550         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 551         'snapshot' => {
 552                 'sub' => \&feature_snapshot,
 553                 'override' => 0,
 554                 'default' => ['tgz']},
 555
 556         # Enable text search, which will list the commits which match author,
 557         # committer or commit text to a given string.  Enabled by default.
 558         # Project specific override is not supported.
 559         #
 560         # Note that this controls all search features, which means that if
 561         # it is disabled, then 'grep' and 'pickaxe' search would also be
 562         # disabled.
 563         'search' => {
 564                 'override' => 0,
 565                 'default' => [1]},
 566
 567         # Enable grep search, which will list the files in currently selected
 568         # tree containing the given string. Enabled by default. This can be
 569         # potentially CPU-intensive, of course.
 570         # Note that you need to have 'search' feature enabled too.
 571
 572         # To enable system wide have in $GITWEB_CONFIG
 573         # $feature{'grep'}{'default'} = [1];
 574         # To have project specific config enable override in $GITWEB_CONFIG
 575         # $feature{'grep'}{'override'} = 1;
 576         # and in project config gitweb.grep = 0|1;
 577         'grep' => {
 578                 'sub' => sub { feature_bool('grep', @_) },
 579                 'override' => 0,
 580                 'default' => [1]},
 581
 582         # Enable the pickaxe search, which will list the commits that modified
 583         # a given string in a file. This can be practical and quite faster
 584         # alternative to 'blame', but still potentially CPU-intensive.
 585         # Note that you need to have 'search' feature enabled too.
 586
 587         # To enable system wide have in $GITWEB_CONFIG
 588         # $feature{'pickaxe'}{'default'} = [1];
 589         # To have project specific config enable override in $GITWEB_CONFIG
 590         # $feature{'pickaxe'}{'override'} = 1;
 591         # and in project config gitweb.pickaxe = 0|1;
 592         'pickaxe' => {
 593                 'sub' => sub { feature_bool('pickaxe', @_) },
 594                 'override' => 0,
 595                 'default' => [1]},
 596
 597         # Enable showing size of blobs in a 'tree' view, in a separate
 598         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 599
 600         # To disable system wide have in $GITWEB_CONFIG
 601         # $feature{'show-sizes'}{'default'} = [0];
 602         # To have project specific config enable override in $GITWEB_CONFIG
 603         # $feature{'show-sizes'}{'override'} = 1;
 604         # and in project config gitweb.showsizes = 0|1;
 605         'show-sizes' => {
 606                 'sub' => sub { feature_bool('showsizes', @_) },
 607                 'override' => 0,
 608                 'default' => [1]},
 609
 610         # Make gitweb use an alternative format of the URLs which can be
 611         # more readable and natural-looking: project name is embedded
 612         # directly in the path and the query string contains other
 613         # auxiliary information. All gitweb installations recognize
 614         # URL in either format; this configures in which formats gitweb
 615         # generates links.
 616
 617         # To enable system wide have in $GITWEB_CONFIG
 618         # $feature{'pathinfo'}{'default'} = [1];
 619         # Project specific override is not supported.
 620
 621         # Note that you will need to change the default location of CSS,
 622         # favicon, logo and possibly other files to an absolute URL. Also,
 623         # if gitweb.cgi serves as your indexfile, you will need to force
 624         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 625         # will also likely want to set $home_link if you're setting $my_uri).
 626         'pathinfo' => {
 627                 'override' => 0,
 628                 'default' => [0]},
 629
 630         # Make gitweb consider projects in project root subdirectories
 631         # to be forks of existing projects. Given project $projname.git,
 632         # projects matching $projname/*.git will not be shown in the main
 633         # projects list, instead a '+' mark will be added to $projname
 634         # there and a 'forks' view will be enabled for the project, listing
 635         # all the forks. If project list is taken from a file, forks have
 636         # to be listed after the main project.
 637
 638         # To enable system wide have in $GITWEB_CONFIG
 639         # $feature{'forks'}{'default'} = [1];
 640         # Project specific override is not supported.
 641         'forks' => {
 642                 'override' => 0,
 643                 'default' => [0]},
 644
 645         # Insert custom links to the action bar of all project pages.
 646         # This enables you mainly to link to third-party scripts integrating
 647         # into gitweb; e.g. git-browser for graphical history representation
 648         # or custom web-based repository administration interface.
 649
 650         # The 'default' value consists of a list of triplets in the form
 651         # (label, link, position) where position is the label after which
 652         # to insert the link and link is a format string where %n expands
 653         # to the project name, %f to the project path within the filesystem,
 654         # %h to the current hash (h gitweb parameter) and %b to the current
 655         # hash base (hb gitweb parameter); %% expands to %.  %e expands to the
 656         # project name where all '+' characters have been replaced with '%2B'.
 657
 658         # To enable system wide have in $GITWEB_CONFIG e.g.
 659         # $feature{'actions'}{'default'} = [('graphiclog',
 660         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 661         # Project specific override is not supported.
 662         'actions' => {
 663                 'override' => 0,
 664                 'default' => []},
 665
 666         # Allow gitweb scan project content tags of project repository,
 667         # and display the popular Web 2.0-ish "tag cloud" near the projects
 668         # list.  Note that this is something COMPLETELY different from the
 669         # normal Git tags.
 670
 671         # gitweb by itself can show existing tags, but it does not handle
 672         # tagging itself; you need to do it externally, outside gitweb.
 673         # The format is described in git_get_project_ctags() subroutine.
 674         # You may want to install the HTML::TagCloud Perl module to get
 675         # a pretty tag cloud instead of just a list of tags.
 676
 677         # To enable system wide have in $GITWEB_CONFIG
 678         # $feature{'ctags'}{'default'} = [1];
 679         # Project specific override is not supported.
 680
 681         # A value of 0 means no ctags display or editing.  A value of
 682         # 1 enables ctags display but never editing.  A non-empty value
 683         # that is not a string of digits enables ctags display AND the
 684         # ability to add tags using a form that uses method POST and
 685         # an action value set to the configured 'ctags' value.
 686         'ctags' => {
 687                 'override' => 0,
 688                 'default' => [0]},
 689
 690         # The maximum number of patches in a patchset generated in patch
 691         # view. Set this to 0 or undef to disable patch view, or to a
 692         # negative number to remove any limit.
 693
 694         # To disable system wide have in $GITWEB_CONFIG
 695         # $feature{'patches'}{'default'} = [0];
 696         # To have project specific config enable override in $GITWEB_CONFIG
 697         # $feature{'patches'}{'override'} = 1;
 698         # and in project config gitweb.patches = 0|n;
 699         # where n is the maximum number of patches allowed in a patchset.
 700         'patches' => {
 701                 'sub' => \&feature_patches,
 702                 'override' => 0,
 703                 'default' => [16]},
 704
 705         # Avatar support. When this feature is enabled, views such as
 706         # shortlog or commit will display an avatar associated with
 707         # the email of the committer(s) and/or author(s).
 708
 709         # Currently available providers are gravatar and picon.
 710         # If an unknown provider is specified, the feature is disabled.
 711
 712         # Gravatar depends on Digest::MD5.
 713         # Picon currently relies on the indiana.edu database.
 714
 715         # To enable system wide have in $GITWEB_CONFIG
 716         # $feature{'avatar'}{'default'} = ['<provider>'];
 717         # where <provider> is either gravatar or picon.
 718         # To have project specific config enable override in $GITWEB_CONFIG
 719         # $feature{'avatar'}{'override'} = 1;
 720         # and in project config gitweb.avatar = <provider>;
 721         'avatar' => {
 722                 'sub' => \&feature_avatar,
 723                 'override' => 0,
 724                 'default' => ['']},
 725
 726         # Enable displaying how much time and how many git commands
 727         # it took to generate and display page.  Disabled by default.
 728         # Project specific override is not supported.
 729         'timed' => {
 730                 'override' => 0,
 731                 'default' => [0]},
 732
 733         # Enable turning some links into links to actions which require
 734         # JavaScript to run (like 'blame_incremental').  Not enabled by
 735         # default.  Project specific override is currently not supported.
 736         'javascript-actions' => {
 737                 'override' => 0,
 738                 'default' => [0]},
 739
 740         # Enable and configure ability to change common timezone for dates
 741         # in gitweb output via JavaScript.  Enabled by default.
 742         # Project specific override is not supported.
 743         'javascript-timezone' => {
 744                 'override' => 0,
 745                 'default' => [
 746                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 747                                      # or undef to turn off this feature
 748                         'gitweb_tz', # name of cookie where to store selected timezone
 749                         'datetime',  # CSS class used to mark up dates for manipulation
 750                 ]},
 751
 752         # Syntax highlighting support. This is based on Daniel Svensson's
 753         # and Sham Chukoury's work in gitweb-xmms2.git.
 754         # It requires the 'highlight' program present in $PATH,
 755         # and therefore is disabled by default.
 756
 757         # To enable system wide have in $GITWEB_CONFIG
 758         # $feature{'highlight'}{'default'} = [1];
 759
 760         'highlight' => {
 761                 'sub' => sub { feature_bool('highlight', @_) },
 762                 'override' => 0,
 763                 'default' => [0]},
 764
 765         # Enable displaying of remote heads in the heads list
 766
 767         # To enable system wide have in $GITWEB_CONFIG
 768         # $feature{'remote_heads'}{'default'} = [1];
 769         # To have project specific config enable override in $GITWEB_CONFIG
 770         # $feature{'remote_heads'}{'override'} = 1;
 771         # and in project config gitweb.remoteheads = 0|1;
 772         'remote_heads' => {
 773                 'sub' => sub { feature_bool('remote_heads', @_) },
 774                 'override' => 0,
 775                 'default' => [0]},
 776
 777         # Enable showing branches under other refs in addition to heads
 778
 779         # To set system wide extra branch refs have in $GITWEB_CONFIG
 780         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 781         # To have project specific config enable override in $GITWEB_CONFIG
 782         # $feature{'extra-branch-refs'}{'override'} = 1;
 783         # and in project config gitweb.extrabranchrefs = dirs of choice
 784         # Every directory is separated with whitespace.
 785
 786         'extra-branch-refs' => {
 787                 'sub' => \&feature_extra_branch_refs,
 788                 'override' => 0,
 789                 'default' => []},
 790 );
 791
 792 sub gitweb_get_feature {
 793         my ($name) = @_;
 794         return unless exists $feature{$name};
 795         my ($sub, $override, @defaults) = (
 796                 $feature{$name}{'sub'},
 797                 $feature{$name}{'override'},
 798                 @{$feature{$name}{'default'}});
 799         # project specific override is possible only if we have project
 800         our $git_dir; # global variable, declared later
 801         if (!$override || !defined $git_dir) {
 802                 return @defaults;
 803         }
 804         if (!defined $sub) {
 805                 warn "feature $name is not overridable";
 806                 return @defaults;
 807         }
 808         return $sub->(@defaults);
 809 }
 810
 811 # A wrapper to check if a given feature is enabled.
 812 # With this, you can say
 813 #
 814 #   my $bool_feat = gitweb_check_feature('bool_feat');
 815 #   gitweb_check_feature('bool_feat') or somecode;
 816 #
 817 # instead of
 818 #
 819 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 820 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 821 #
 822 sub gitweb_check_feature {
 823         return (gitweb_get_feature(@_))[0];
 824 }
 825
 826
 827 sub feature_bool {
 828         my $key = shift;
 829         my ($val) = git_get_project_config($key, '--bool');
 830
 831         if (!defined $val) {
 832                 return ($_[0]);
 833         } elsif ($val eq 'true') {
 834                 return (1);
 835         } elsif ($val eq 'false') {
 836                 return (0);
 837         }
 838 }
 839
 840 sub feature_snapshot {
 841         my (@fmts) = @_;
 842
 843         my ($val) = git_get_project_config('snapshot');
 844
 845         if ($val) {
 846                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 847         }
 848
 849         return @fmts;
 850 }
 851
 852 sub feature_patches {
 853         my @val = (git_get_project_config('patches', '--int'));
 854
 855         if (@val) {
 856                 return @val;
 857         }
 858
 859         return ($_[0]);
 860 }
 861
 862 sub feature_avatar {
 863         my @val = (git_get_project_config('avatar'));
 864
 865         return @val ? @val : @_;
 866 }
 867
 868 sub feature_extra_branch_refs {
 869         my (@branch_refs) = @_;
 870         my $values = git_get_project_config('extrabranchrefs');
 871
 872         if ($values) {
 873                 $values = config_to_multi ($values);
 874                 @branch_refs = ();
 875                 foreach my $value (@{$values}) {
 876                         push @branch_refs, split /\s+/, $value;
 877                 }
 878         }
 879
 880         return @branch_refs;
 881 }
 882
 883 # checking HEAD file with -e is fragile if the repository was
 884 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 885 # and then pruned.
 886 sub check_head_link {
 887         my ($dir) = @_;
 888         my $headfile = "$dir/HEAD";
 889         return ((-e $headfile) ||
 890                 (-l $headfile && readlink($headfile) =~ /^refs\/heads\//));
 891 }
 892
 893 sub check_export_ok {
 894         my ($dir) = @_;
 895         return (check_head_link($dir) &&
 896                 (!$export_ok || -e "$dir/$export_ok") &&
 897                 (!$export_auth_hook || $export_auth_hook->($dir)));
 898 }
 899
 900 # process alternate names for backward compatibility
 901 # filter out unsupported (unknown) snapshot formats
 902 sub filter_snapshot_fmts {
 903         my @fmts = @_;
 904
 905         @fmts = map {
 906                 exists $known_snapshot_format_aliases{$_} ?
 907                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 908         @fmts = grep {
 909                 exists $known_snapshot_formats{$_} &&
 910                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 911 }
 912
 913 sub filter_and_validate_refs {
 914         my @refs = @_;
 915         my %unique_refs = ();
 916
 917         foreach my $ref (@refs) {
 918                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 919                 # 'heads' are added implicitly in get_branch_refs().
 920                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 921         }
 922         return sort keys %unique_refs;
 923 }
 924
 925 # If it is set to code reference, it is code that it is to be run once per
 926 # request, allowing updating configurations that change with each request,
 927 # while running other code in config file only once.
 928 #
 929 # Otherwise, if it is false then gitweb would process config file only once;
 930 # if it is true then gitweb config would be run for each request.
 931 our $per_request_config = 1;
 932
 933 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 934 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 935 # same way as though the --fcgi option had been given instead.
 936 our $auto_fcgi = 0;
 937
 938 # read and parse gitweb config file given by its parameter.
 939 # returns true on success, false on recoverable error, allowing
 940 # to chain this subroutine, using first file that exists.
 941 # dies on errors during parsing config file, as it is unrecoverable.
 942 sub read_config_file {
 943         my $filename = shift;
 944         return unless defined $filename;
 945         # die if there are errors parsing config file
 946         if (-e $filename) {
 947                 do $filename;
 948                 die $@ if $@;
 949                 return 1;
 950         }
 951         return;
 952 }
 953
 954 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
 955 sub evaluate_gitweb_config {
 956         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
 957         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
 958         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
 959
 960         # Protect against duplications of file names, to not read config twice.
 961         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
 962         # there possibility of duplication of filename there doesn't matter.
 963         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
 964         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
 965
 966         # Common system-wide settings for convenience.
 967         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
 968         read_config_file($GITWEB_CONFIG_COMMON);
 969
 970         # Use first config file that exists.  This means use the per-instance
 971         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
 972         read_config_file($GITWEB_CONFIG) and return;
 973         read_config_file($GITWEB_CONFIG_SYSTEM);
 974 }
 975
 976 our $encode_object;
 977
 978 sub evaluate_encoding {
 979         my $requested = $fallback_encoding || 'ISO-8859-1';
 980         my $obj = Encode::find_encoding($requested) or
 981                 die_error(400, "Requested fallback encoding not found");
 982         if ($obj->name eq 'iso-8859-1') {
 983                 # Use Windows-1252 instead as required by the HTML 5 standard
 984                 my $altobj = Encode::find_encoding('Windows-1252');
 985                 $obj = $altobj if $altobj;
 986         }
 987         $encode_object = $obj;
 988 }
 989
 990 sub evaluate_email_obfuscate {
 991         # email obfuscation
 992         our $email;
 993         if (!$email && eval { require HTML::Email::Obfuscate; 1 }) {
 994                 $email = HTML::Email::Obfuscate->new(lite => 1);
 995         }
 996 }
 997
 998 # Get loadavg of system, to compare against $maxload.
 999 # Currently it requires '/proc/loadavg' present to get loadavg;
1000 # if it is not present it returns 0, which means no load checking.
1001 sub get_loadavg {
1002         if( -e '/proc/loadavg' ){
1003                 open my $fd, '<', '/proc/loadavg'
1004                         or return 0;
1005                 my @load = split(/\s+/, scalar <$fd>);
1006                 close $fd;
1007
1008                 # The first three columns measure CPU and IO utilization of the last one,
1009                 # five, and 10 minute periods.  The fourth column shows the number of
1010                 # currently running processes and the total number of processes in the m/n
1011                 # format.  The last column displays the last process ID used.
1012                 return $load[0] || 0;
1013         }
1014         # additional checks for load average should go here for things that don't export
1015         # /proc/loadavg
1016
1017         return 0;
1018 }
1019
1020 # version of the core git binary
1021 our $git_version;
1022 sub evaluate_git_version {
1023         our $git_version = $version;
1024 }
1025
1026 sub check_loadavg {
1027         if (defined $maxload && get_loadavg() > $maxload) {
1028                 die_error(503, "The load average on the server is too high");
1029         }
1030 }
1031
1032 # ======================================================================
1033 # input validation and dispatch
1034
1035 # input parameters can be collected from a variety of sources (presently, CGI
1036 # and PATH_INFO), so we define an %input_params hash that collects them all
1037 # together during validation: this allows subsequent uses (e.g. href()) to be
1038 # agnostic of the parameter origin
1039
1040 our %input_params = ();
1041
1042 # input parameters are stored with the long parameter name as key. This will
1043 # also be used in the href subroutine to convert parameters to their CGI
1044 # equivalent, and since the href() usage is the most frequent one, we store
1045 # the name -> CGI key mapping here, instead of the reverse.
1046 #
1047 # XXX: Warning: If you touch this, check the search form for updating,
1048 # too.
1049
1050 our @cgi_param_mapping = (
1051         project => "p",
1052         action => "a",
1053         file_name => "f",
1054         file_parent => "fp",
1055         hash => "h",
1056         hash_parent => "hp",
1057         hash_base => "hb",
1058         hash_parent_base => "hpb",
1059         page => "pg",
1060         order => "o",
1061         searchtext => "s",
1062         searchtype => "st",
1063         snapshot_format => "sf",
1064         ctag_filter => 't',
1065         extra_options => "opt",
1066         search_use_regexp => "sr",
1067         ctag => "by_tag",
1068         diff_style => "ds",
1069         project_filter => "pf",
1070         # this must be last entry (for manipulation from JavaScript)
1071         javascript => "js"
1072 );
1073 our %cgi_param_mapping = @cgi_param_mapping;
1074
1075 # we will also need to know the possible actions, for validation
1076 our %actions = (
1077         "blame" => \&git_blame,
1078         "blame_incremental" => \&git_blame_incremental,
1079         "blame_data" => \&git_blame_data,
1080         "blobdiff" => \&git_blobdiff,
1081         "blobdiff_plain" => \&git_blobdiff_plain,
1082         "blob" => \&git_blob,
1083         "blob_plain" => \&git_blob_plain,
1084         "commitdiff" => \&git_commitdiff,
1085         "commitdiff_plain" => \&git_commitdiff_plain,
1086         "commit" => \&git_commit,
1087         "forks" => \&git_forks,
1088         "heads" => \&git_heads,
1089         "history" => \&git_history,
1090         "log" => \&git_log,
1091         "patch" => \&git_patch,
1092         "patches" => \&git_patches,
1093         "refs" => \&git_refs,
1094         "remotes" => \&git_remotes,
1095         "rss" => \&git_rss,
1096         "atom" => \&git_atom,
1097         "search" => \&git_search,
1098         "search_help" => \&git_search_help,
1099         "shortlog" => \&git_shortlog,
1100         "summary" => \&git_summary,
1101         "tag" => \&git_tag,
1102         "tags" => \&git_tags,
1103         "tree" => \&git_tree,
1104         "snapshot" => \&git_snapshot,
1105         "object" => \&git_object,
1106         # those below don't need $project
1107         "opml" => \&git_opml,
1108         "frontpage" => \&git_frontpage,
1109         "project_list" => \&git_project_list,
1110         "project_index" => \&git_project_index,
1111 );
1112
1113 # the only actions we will allow to be cached
1114 my %supported_cache_actions;
1115 BEGIN {%supported_cache_actions = map {( $_ => 1 )} qw(summary)}
1116
1117 # finally, we have the hash of allowed extra_options for the commands that
1118 # allow them
1119 our %allowed_options = (
1120         "--no-merges" => [ qw(rss atom log shortlog history) ],
1121 );
1122
1123 # fill %input_params with the CGI parameters. All values except for 'opt'
1124 # should be single values, but opt can be an array. We should probably
1125 # build an array of parameters that can be multi-valued, but since for the time
1126 # being it's only this one, we just single it out
1127 sub evaluate_query_params {
1128         our $cgi;
1129
1130         while (my ($name, $symbol) = each %cgi_param_mapping) {
1131                 if ($symbol eq 'opt') {
1132                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1133                 } else {
1134                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1135                 }
1136         }
1137
1138         # Backwards compatibility - by_tag= <=> t=
1139         if ($input_params{'ctag'}) {
1140                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1141         }
1142 }
1143
1144 # now read PATH_INFO and update the parameter list for missing parameters
1145 sub evaluate_path_info {
1146         return if defined $input_params{'project'};
1147         return if !$path_info;
1148         $path_info =~ s,^/+,,;
1149         return if !$path_info;
1150
1151         # find which part of PATH_INFO is project
1152         my $project = $path_info;
1153         $project =~ s,/+$,,;
1154         while ($project && !check_head_link("$projectroot/$project")) {
1155                 $project =~ s,/*[^/]*$,,;
1156         }
1157         return unless $project;
1158         $input_params{'project'} = $project;
1159
1160         # do not change any parameters if an action is given using the query string
1161         return if $input_params{'action'};
1162         $path_info =~ s,^\Q$project\E/*,,;
1163
1164         # next, check if we have an action
1165         my $action = $path_info;
1166         $action =~ s,/.*$,,;
1167         if (exists $actions{$action}) {
1168                 $path_info =~ s,^$action/*,,;
1169                 $input_params{'action'} = $action;
1170         }
1171
1172         # list of actions that want hash_base instead of hash, but can have no
1173         # pathname (f) parameter
1174         my @wants_base = (
1175                 'tree',
1176                 'history',
1177         );
1178
1179         # we want to catch, among others
1180         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1181         my ($parentrefname, $parentpathname, $refname, $pathname) =
1182                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1183
1184         # first, analyze the 'current' part
1185         if (defined $pathname) {
1186                 # we got "branch:filename" or "branch:dir/"
1187                 # we could use git_get_type(branch:pathname), but:
1188                 # - it needs $git_dir
1189                 # - it does a git() call
1190                 # - the convention of terminating directories with a slash
1191                 #   makes it superfluous
1192                 # - embedding the action in the PATH_INFO would make it even
1193                 #   more superfluous
1194                 $pathname =~ s,^/+,,;
1195                 if (!$pathname || substr($pathname, -1) eq "/") {
1196                         $input_params{'action'} ||= "tree";
1197                         $pathname =~ s,/$,,;
1198                 } else {
1199                         # the default action depends on whether we had parent info
1200                         # or not
1201                         if ($parentrefname) {
1202                                 $input_params{'action'} ||= "blobdiff_plain";
1203                         } else {
1204                                 $input_params{'action'} ||= "blob_plain";
1205                         }
1206                 }
1207                 $input_params{'hash_base'} ||= $refname;
1208                 $input_params{'file_name'} ||= $pathname;
1209         } elsif (defined $refname) {
1210                 # we got "branch". In this case we have to choose if we have to
1211                 # set hash or hash_base.
1212                 #
1213                 # Most of the actions without a pathname only want hash to be
1214                 # set, except for the ones specified in @wants_base that want
1215                 # hash_base instead. It should also be noted that hand-crafted
1216                 # links having 'history' as an action and no pathname or hash
1217                 # set will fail, but that happens regardless of PATH_INFO.
1218                 if (defined $parentrefname) {
1219                         # if there is parent let the default be 'shortlog' action
1220                         # (for http://git.example.com/repo.git/A..B links); if there
1221                         # is no parent, dispatch will detect type of object and set
1222                         # action appropriately if required (if action is not set)
1223                         $input_params{'action'} ||= "shortlog";
1224                 }
1225                 if ($input_params{'action'} &&
1226                     grep { $_ eq $input_params{'action'} } @wants_base) {
1227                         $input_params{'hash_base'} ||= $refname;
1228                 } else {
1229                         $input_params{'hash'} ||= $refname;
1230                 }
1231         }
1232
1233         # next, handle the 'parent' part, if present
1234         if (defined $parentrefname) {
1235                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1236                 # someproject/blobdiff/oldrev..newrev:/filename
1237                 if ($parentpathname) {
1238                         $parentpathname =~ s,^/+,,;
1239                         $parentpathname =~ s,/$,,;
1240                         $input_params{'file_parent'} ||= $parentpathname;
1241                 } else {
1242                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1243                 }
1244                 # we assume that hash_parent_base is wanted if a path was specified,
1245                 # or if the action wants hash_base instead of hash
1246                 if (defined $input_params{'file_parent'} ||
1247                         grep { $_ eq $input_params{'action'} } @wants_base) {
1248                         $input_params{'hash_parent_base'} ||= $parentrefname;
1249                 } else {
1250                         $input_params{'hash_parent'} ||= $parentrefname;
1251                 }
1252         }
1253
1254         # for the snapshot action, we allow URLs in the form
1255         # $project/snapshot/$hash.ext
1256         # where .ext determines the snapshot and gets removed from the
1257         # passed $refname to provide the $hash.
1258         #
1259         # To be able to tell that $refname includes the format extension, we
1260         # require the following two conditions to be satisfied:
1261         # - the hash input parameter MUST have been set from the $refname part
1262         #   of the URL (i.e. they must be equal)
1263         # - the snapshot format MUST NOT have been defined already (e.g. from
1264         #   CGI parameter sf)
1265         # It's also useless to try any matching unless $refname has a dot,
1266         # so we check for that too
1267         if (defined $input_params{'action'} &&
1268                 $input_params{'action'} eq 'snapshot' &&
1269                 defined $refname && index($refname, '.') != -1 &&
1270                 $refname eq $input_params{'hash'} &&
1271                 !defined $input_params{'snapshot_format'}) {
1272                 # We loop over the known snapshot formats, checking for
1273                 # extensions. Allowed extensions are both the defined suffix
1274                 # (which includes the initial dot already) and the snapshot
1275                 # format key itself, with a prepended dot
1276                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1277                         my $hash = $refname;
1278                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1279                                 next;
1280                         }
1281                         my $sfx = $1;
1282                         # a valid suffix was found, so set the snapshot format
1283                         # and reset the hash parameter
1284                         $input_params{'snapshot_format'} = $fmt;
1285                         $input_params{'hash'} = $hash;
1286                         # we also set the format suffix to the one requested
1287                         # in the URL: this way a request for e.g. .tgz returns
1288                         # a .tgz instead of a .tar.gz
1289                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1290                         last;
1291                 }
1292         }
1293 }
1294
1295 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1296      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1297      $searchtext, $search_regexp, $project_filter);
1298 sub evaluate_and_validate_params {
1299         our $action = $input_params{'action'};
1300         if (defined $action) {
1301                 if (!is_valid_action($action)) {
1302                         die_error(400, "Invalid action parameter");
1303                 }
1304         }
1305
1306         # parameters which are pathnames
1307         our $project = $input_params{'project'};
1308         if (defined $project) {
1309                 if (!is_valid_project($project)) {
1310                         undef $project;
1311                         die_error(404, "No such project");
1312                 }
1313         }
1314
1315         our $project_filter = $input_params{'project_filter'};
1316         if (defined $project_filter) {
1317                 if (!is_valid_pathname($project_filter)) {
1318                         die_error(404, "Invalid project_filter parameter");
1319                 }
1320         }
1321
1322         our $file_name = $input_params{'file_name'};
1323         if (defined $file_name) {
1324                 if (!is_valid_pathname($file_name)) {
1325                         die_error(400, "Invalid file parameter");
1326                 }
1327         }
1328
1329         our $file_parent = $input_params{'file_parent'};
1330         if (defined $file_parent) {
1331                 if (!is_valid_pathname($file_parent)) {
1332                         die_error(400, "Invalid file parent parameter");
1333                 }
1334         }
1335
1336         # parameters which are refnames
1337         our $hash = $input_params{'hash'};
1338         if (defined $hash) {
1339                 if (!is_valid_refname($hash)) {
1340                         die_error(400, "Invalid hash parameter");
1341                 }
1342         }
1343
1344         our $hash_parent = $input_params{'hash_parent'};
1345         if (defined $hash_parent) {
1346                 if (!is_valid_refname($hash_parent)) {
1347                         die_error(400, "Invalid hash parent parameter");
1348                 }
1349         }
1350
1351         our $hash_base = $input_params{'hash_base'};
1352         if (defined $hash_base) {
1353                 if (!is_valid_refname($hash_base)) {
1354                         die_error(400, "Invalid hash base parameter");
1355                 }
1356         }
1357
1358         our @extra_options = @{$input_params{'extra_options'}};
1359         # @extra_options is always defined, since it can only be (currently) set from
1360         # CGI, and $cgi->param() returns the empty array in array context if the param
1361         # is not set
1362         foreach my $opt (@extra_options) {
1363                 if (not exists $allowed_options{$opt}) {
1364                         die_error(400, "Invalid option parameter");
1365                 }
1366                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1367                         die_error(400, "Invalid option parameter for this action");
1368                 }
1369         }
1370
1371         our $hash_parent_base = $input_params{'hash_parent_base'};
1372         if (defined $hash_parent_base) {
1373                 if (!is_valid_refname($hash_parent_base)) {
1374                         die_error(400, "Invalid hash parent base parameter");
1375                 }
1376         }
1377
1378         # other parameters
1379         our $page = $input_params{'page'};
1380         if (defined $page) {
1381                 if ($page =~ m/[^0-9]/) {
1382                         die_error(400, "Invalid page parameter");
1383                 }
1384         }
1385
1386         our $searchtype = $input_params{'searchtype'};
1387         if (defined $searchtype) {
1388                 if ($searchtype =~ m/[^a-z]/) {
1389                         die_error(400, "Invalid searchtype parameter");
1390                 }
1391         }
1392
1393         our $search_use_regexp = $input_params{'search_use_regexp'};
1394
1395         our $searchtext = $input_params{'searchtext'};
1396         our $search_regexp = undef;
1397         if (defined $searchtext) {
1398                 if (length($searchtext) < 2) {
1399                         die_error(403, "At least two characters are required for search parameter");
1400                 }
1401                 if ($search_use_regexp) {
1402                         $search_regexp = $searchtext;
1403                         if (!eval { qr/$search_regexp/; 1; }) {
1404                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1405                                 die_error(400, "Invalid search regexp '$search_regexp'",
1406                                           esc_html($error));
1407                         }
1408                 } else {
1409                         $search_regexp = quotemeta $searchtext;
1410                 }
1411         }
1412 }
1413
1414 # path to the current git repository
1415 our $git_dir;
1416 sub evaluate_git_dir {
1417         our $git_dir = $project ? "$projectroot/$project" : undef;
1418 }
1419
1420 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1421 sub configure_gitweb_features {
1422         # list of supported snapshot formats
1423         our @snapshot_fmts = gitweb_get_feature('snapshot');
1424         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1425
1426         # check that the avatar feature is set to a known provider name,
1427         # and for each provider check if the dependencies are satisfied.
1428         # if the provider name is invalid or the dependencies are not met,
1429         # reset $git_avatar to the empty string.
1430         our ($git_avatar) = gitweb_get_feature('avatar');
1431         if ($git_avatar eq 'gravatar') {
1432                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1433         } elsif ($git_avatar eq 'picon') {
1434                 # no dependencies
1435         } else {
1436                 $git_avatar = '';
1437         }
1438
1439         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1440         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1441 }
1442
1443 sub get_branch_refs {
1444         return ('heads', @extra_branch_refs);
1445 }
1446
1447 # custom error handler: 'die <message>' is Internal Server Error
1448 sub handle_errors_html {
1449         my $msg = shift; # it is already HTML escaped
1450
1451         # to avoid infinite loop where error occurs in die_error,
1452         # change handler to default handler, disabling handle_errors_html
1453         set_message("Error occurred when inside die_error:\n$msg");
1454
1455         # you cannot jump out of die_error when called as error handler;
1456         # the subroutine set via CGI::Carp::set_message is called _after_
1457         # HTTP headers are already written, so it cannot write them itself
1458         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1459 }
1460 set_message(\&handle_errors_html);
1461
1462 our $shown_stale_message = 0;
1463 our $cache_dump = undef;
1464 our $cache_dump_mtime = undef;
1465
1466 # dispatch
1467 my $cache_mode_active;
1468 sub dispatch {
1469         $shown_stale_message = 0;
1470         if (!defined $action) {
1471                 if (defined $hash) {
1472                         $action = git_get_type($hash);
1473                         $action or die_error(404, "Object does not exist");
1474                 } elsif (defined $hash_base && defined $file_name) {
1475                         $action = git_get_type("$hash_base:$file_name");
1476                         $action or die_error(404, "File or directory does not exist");
1477                 } elsif (defined $project) {
1478                         $action = 'summary';
1479                 } else {
1480                         $action = 'frontpage';
1481                 }
1482         }
1483         if (!defined($actions{$action})) {
1484                 die_error(400, "Unknown action");
1485         }
1486         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1487             !$project) {
1488                 die_error(400, "Project needed");
1489         }
1490
1491         my $defstyle = $stylesheet;
1492         local $stylesheet = $defstyle;
1493         if ($ENV{'HTTP_COOKIE'} && ";$ENV{'HTTP_COOKIE'};" =~ /;\s*style\s*=\s*([a-z][a-z0-9_-]*)\s*;/) {{
1494                 my $stylename = $1;
1495                 last unless $ENV{'DOCUMENT_ROOT'} && -r "$ENV{'DOCUMENT_ROOT'}/style/$stylename.css";
1496                 $stylesheet = "/style/$stylename.css";
1497         }}
1498
1499         my $cached_page = $supported_cache_actions{$action}
1500                 ? cached_action_page($action)
1501                 : undef;
1502         goto DUMPCACHE if $cached_page;
1503         local *SAVEOUT = *STDOUT;
1504         $cache_mode_active = $supported_cache_actions{$action}
1505                 ? cached_action_start($action)
1506                 : undef;
1507
1508         configure_gitweb_features();
1509         $actions{$action}->();
1510
1511         return unless $cache_mode_active;
1512
1513         $cached_page = cached_action_finish($action);
1514         *STDOUT = *SAVEOUT;
1515
1516         DUMPCACHE:
1517
1518         $cache_mode_active = 0;
1519         # Avoid any extra unwanted encoding steps as $cached_page is raw bytes
1520         binmode STDOUT, ':raw';
1521         our $fcgi_raw_mode = 1;
1522         print expand_gitweb_pi($cached_page, time);
1523         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
1524         $fcgi_raw_mode = 0;
1525 }
1526
1527 sub reset_timer {
1528         our $t0 = [ gettimeofday() ]
1529                 if defined $t0;
1530         our $number_of_git_cmds = 0;
1531 }
1532
1533 our $first_request = 1;
1534 our $evaluate_uri_force = undef;
1535 sub run_request {
1536         reset_timer();
1537
1538         # do not reuse stale config or project list from prior FCGI request
1539         our $config_file = '';
1540         our $gitweb_project_owner = undef;
1541
1542         # Only allow GET and HEAD methods
1543         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1544                 print <<EOT;
1545 Status: 405 Method Not Allowed
1546 Content-Type: text/plain
1547 Allow: GET,HEAD
1548
1549 405 Method Not Allowed
1550 EOT
1551                 return;
1552         }
1553
1554         evaluate_uri();
1555         &$evaluate_uri_force() if $evaluate_uri_force;
1556         if ($per_request_config) {
1557                 if (ref($per_request_config) eq 'CODE') {
1558                         $per_request_config->();
1559                 } elsif (!$first_request) {
1560                         evaluate_gitweb_config();
1561                         evaluate_email_obfuscate();
1562                 }
1563         }
1564         check_loadavg();
1565
1566         # $projectroot and $projects_list might be set in gitweb config file
1567         $projects_list ||= $projectroot;
1568
1569         evaluate_query_params();
1570         evaluate_path_info();
1571         evaluate_and_validate_params();
1572         evaluate_git_dir();
1573
1574         dispatch();
1575 }
1576
1577 our $is_last_request = sub { 1 };
1578 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1579 our $CGI = 'CGI';
1580 our $cgi;
1581 our $fcgi_mode = 0;
1582 our $fcgi_nproc_active = 0;
1583 our $fcgi_raw_mode = 0;
1584 sub is_fcgi {
1585         use Errno;
1586         my $stdinfno = fileno STDIN;
1587         return 0 unless defined $stdinfno && $stdinfno == 0;
1588         return 0 unless getsockname STDIN;
1589         return 0 if getpeername STDIN;
1590         return $!{ENOTCONN}?1:0;
1591 }
1592 sub configure_as_fcgi {
1593         return if $fcgi_mode;
1594
1595         require FCGI;
1596         require CGI::Fast;
1597
1598         # We have gone to great effort to make sure that all incoming data has
1599         # been converted from whatever format it was in into UTF-8.  We have
1600         # even taken care to make sure the output handle is in ':utf8' mode.
1601         # Now along comes FCGI and blows it with:
1602         #
1603         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1604         #      and will stop wprking[sic] in a future version of FCGI
1605         #
1606         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1607         # first encodes everything and then calls the original routine, but
1608         # not if $fcgi_raw_mode is true (then we just call the original routine).
1609         #
1610         # Note that we could do this by using utf8::is_utf8 to check instead
1611         # of having a $fcgi_raw_mode global, but that would be slower to run
1612         # the test on each element and much slower than skipping the conversion
1613         # entirely when we know we're outputting raw bytes.
1614         my $orig = \&FCGI::Stream::PRINT;
1615         undef *FCGI::Stream::PRINT;
1616         *FCGI::Stream::PRINT = sub {
1617                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1618                         unless $fcgi_raw_mode;
1619                 goto $orig;
1620         };
1621
1622         our $CGI = 'CGI::Fast';
1623
1624         $fcgi_mode = 1;
1625         $first_request = 0;
1626         my $request_number = 0;
1627         # let each child service 100 requests
1628         our $is_last_request = sub { ++$request_number > 100 };
1629 }
1630 sub evaluate_argv {
1631         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1632         configure_as_fcgi()
1633                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1634
1635         my $nproc_sub = sub {
1636                 my ($arg, $val) = @_;
1637                 return unless eval { require FCGI::ProcManager; 1; };
1638                 $fcgi_nproc_active = 1;
1639                 my $proc_manager = FCGI::ProcManager->new({
1640                         n_processes => $val,
1641                 });
1642                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1643                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1644                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1645         };
1646         if (@ARGV) {
1647                 require Getopt::Long;
1648                 Getopt::Long::GetOptions(
1649                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1650                         'nproc|n=i' => $nproc_sub,
1651                 );
1652         };
1653         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1654                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1655         }
1656 }
1657
1658 sub run {
1659         evaluate_gitweb_config();
1660         evaluate_encoding();
1661         evaluate_email_obfuscate();
1662         evaluate_git_version();
1663         my ($mu, $hl, $subroutine) = ($my_uri, $home_link, '');
1664         $subroutine .= '$my_uri = $mu;' if defined $my_uri && $my_uri ne '';
1665         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1666         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1667         $first_request = 1;
1668         evaluate_argv();
1669
1670         $pre_listen_hook->()
1671                 if $pre_listen_hook;
1672
1673  REQUEST:
1674         while ($cgi = $CGI->new()) {
1675                 $pre_dispatch_hook->()
1676                         if $pre_dispatch_hook;
1677
1678                 run_request();
1679
1680                 $post_dispatch_hook->()
1681                         if $post_dispatch_hook;
1682                 $first_request = 0;
1683
1684                 last REQUEST if ($is_last_request->());
1685         }
1686
1687  DONE_GITWEB:
1688         1;
1689 }
1690
1691 run();
1692
1693 if (defined caller) {
1694         # wrapped in a subroutine processing requests,
1695         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1696         return;
1697 } else {
1698         # pure CGI script, serving single request
1699         exit;
1700 }
1701
1702 ## ======================================================================
1703 ## action links
1704
1705 # possible values of extra options
1706 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1707 # -replay => 1      - start from a current view (replay with modifications)
1708 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1709 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1710 sub href {
1711         my %params = @_;
1712         # default is to use -absolute url() i.e. $my_uri
1713         my $href = $params{-full} ? $my_url : $my_uri;
1714
1715         # implicit -replay, must be first of implicit params
1716         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1717
1718         $params{'project'} = $project unless exists $params{'project'};
1719
1720         if ($params{-replay}) {
1721                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1722                         if (!exists $params{$name}) {
1723                                 $params{$name} = $input_params{$name};
1724                         }
1725                 }
1726         }
1727
1728         my $use_pathinfo = gitweb_check_feature('pathinfo');
1729         if (defined $params{'project'} &&
1730             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1731                 # try to put as many parameters as possible in PATH_INFO:
1732                 #   - project name
1733                 #   - action
1734                 #   - hash_parent or hash_parent_base:/file_parent
1735                 #   - hash or hash_base:/filename
1736                 #   - the snapshot_format as an appropriate suffix
1737
1738                 # When the script is the root DirectoryIndex for the domain,
1739                 # $href here would be something like http://gitweb.example.com/
1740                 # Thus, we strip any trailing / from $href, to spare us double
1741                 # slashes in the final URL
1742                 $href =~ s,/$,,;
1743
1744                 # Then add the project name, if present
1745                 $href .= "/".esc_path_info($params{'project'});
1746                 delete $params{'project'};
1747
1748                 # since we destructively absorb parameters, we keep this
1749                 # boolean that remembers if we're handling a snapshot
1750                 my $is_snapshot = $params{'action'} eq 'snapshot';
1751
1752                 # Summary just uses the project path URL, any other action is
1753                 # added to the URL
1754                 if (defined $params{'action'}) {
1755                         $href .= "/".esc_path_info($params{'action'})
1756                                 unless $params{'action'} eq 'summary';
1757                         delete $params{'action'};
1758                 }
1759
1760                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1761                 # stripping nonexistent or useless pieces
1762                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1763                         || $params{'hash_parent'} || $params{'hash'});
1764                 if (defined $params{'hash_base'}) {
1765                         if (defined $params{'hash_parent_base'}) {
1766                                 $href .= esc_path_info($params{'hash_parent_base'});
1767                                 # skip the file_parent if it's the same as the file_name
1768                                 if (defined $params{'file_parent'}) {
1769                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1770                                                 delete $params{'file_parent'};
1771                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1772                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1773                                                 delete $params{'file_parent'};
1774                                         }
1775                                 }
1776                                 $href .= "..";
1777                                 delete $params{'hash_parent'};
1778                                 delete $params{'hash_parent_base'};
1779                         } elsif (defined $params{'hash_parent'}) {
1780                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1781                                 delete $params{'hash_parent'};
1782                         }
1783
1784                         $href .= esc_path_info($params{'hash_base'});
1785                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1786                                 $href .= ":/".esc_path_info($params{'file_name'});
1787                                 delete $params{'file_name'};
1788                         }
1789                         delete $params{'hash'};
1790                         delete $params{'hash_base'};
1791                 } elsif (defined $params{'hash'}) {
1792                         $href .= esc_path_info($params{'hash'});
1793                         delete $params{'hash'};
1794                 }
1795
1796                 # If the action was a snapshot, we can absorb the
1797                 # snapshot_format parameter too
1798                 if ($is_snapshot) {
1799                         my $fmt = $params{'snapshot_format'};
1800                         # snapshot_format should always be defined when href()
1801                         # is called, but just in case some code forgets, we
1802                         # fall back to the default
1803                         $fmt ||= $snapshot_fmts[0];
1804                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1805                         delete $params{'snapshot_format'};
1806                 }
1807         }
1808
1809         # now encode the parameters explicitly
1810         my @result = ();
1811         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1812                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1813                 if (defined $params{$name}) {
1814                         if (ref($params{$name}) eq "ARRAY") {
1815                                 foreach my $par (@{$params{$name}}) {
1816                                         push @result, $symbol . "=" . esc_param($par);
1817                                 }
1818                         } else {
1819                                 push @result, $symbol . "=" . esc_param($params{$name});
1820                         }
1821                 }
1822         }
1823         $href .= "?" . join(';', @result) if scalar @result;
1824
1825         # final transformation: trailing spaces must be escaped (URI-encoded)
1826         $href =~ s/(\s+)$/CGI::escape($1)/e;
1827
1828         if ($params{-anchor}) {
1829                 $href .= "#".esc_param($params{-anchor});
1830         }
1831
1832         return $href;
1833 }
1834
1835
1836 ## ======================================================================
1837 ## validation, quoting/unquoting and escaping
1838
1839 sub is_valid_action {
1840         my $input = shift;
1841         return undef unless exists $actions{$input};
1842         return 1;
1843 }
1844
1845 sub is_valid_project {
1846         my $input = shift;
1847
1848         return unless defined $input;
1849         if (!is_valid_pathname($input) ||
1850                 !(-d "$projectroot/$input") ||
1851                 !check_export_ok("$projectroot/$input") ||
1852                 ($strict_export && !project_in_list($input))) {
1853                 return undef;
1854         } else {
1855                 return 1;
1856         }
1857 }
1858
1859 sub is_valid_pathname {
1860         my $input = shift;
1861
1862         return undef unless defined $input;
1863         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1864         # at the beginning, at the end, and between slashes.
1865         # also this catches doubled slashes
1866         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1867                 return undef;
1868         }
1869         # no null characters
1870         if ($input =~ m!\0!) {
1871                 return undef;
1872         }
1873         return 1;
1874 }
1875
1876 sub is_valid_ref_format {
1877         my $input = shift;
1878
1879         return undef unless defined $input;
1880         # restrictions on ref name according to git-check-ref-format
1881         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1882                 return undef;
1883         }
1884         return 1;
1885 }
1886
1887 sub is_valid_refname {
1888         my $input = shift;
1889
1890         return undef unless defined $input;
1891         # textual hashes are O.K.
1892         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1893                 return 1;
1894         }
1895         # it must be correct pathname
1896         is_valid_pathname($input) or return undef;
1897         # check git-check-ref-format restrictions
1898         is_valid_ref_format($input) or return undef;
1899         return 1;
1900 }
1901
1902 # decode sequences of octets in utf8 into Perl's internal form,
1903 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1904 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1905 sub to_utf8 {
1906         my $str = shift;
1907         return undef unless defined $str;
1908
1909         if (utf8::is_utf8($str) || utf8::decode($str)) {
1910                 return $str;
1911         } else {
1912                 return $encode_object->decode($str, Encode::FB_DEFAULT);
1913         }
1914 }
1915
1916 # quote unsafe chars, but keep the slash, even when it's not
1917 # correct, but quoted slashes look too horrible in bookmarks
1918 sub esc_param {
1919         my $str = shift;
1920         return undef unless defined $str;
1921         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1922         $str =~ s/ /\+/g;
1923         return $str;
1924 }
1925
1926 # the quoting rules for path_info fragment are slightly different
1927 sub esc_path_info {
1928         my $str = shift;
1929         return undef unless defined $str;
1930
1931         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1932         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1933
1934         return $str;
1935 }
1936
1937 # quote unsafe chars in whole URL, so some characters cannot be quoted
1938 sub esc_url {
1939         my $str = shift;
1940         return undef unless defined $str;
1941         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1942         $str =~ s/ /\+/g;
1943         return $str;
1944 }
1945
1946 # quote unsafe characters in HTML attributes
1947 sub esc_attr {
1948
1949         # for XHTML conformance escaping '"' to '&quot;' is not enough
1950         return esc_html(@_);
1951 }
1952
1953 # replace invalid utf8 character with SUBSTITUTION sequence
1954 sub esc_html {
1955         my $str = shift;
1956         my %opts = @_;
1957
1958         return undef unless defined $str;
1959
1960         $str = to_utf8($str);
1961         $str = $cgi->escapeHTML($str);
1962         if ($opts{'-nbsp'}) {
1963                 $str =~ s/ /&#160;/g;
1964         }
1965         use bytes;
1966         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
1967         return $str;
1968 }
1969
1970 # quote control characters and escape filename to HTML
1971 sub esc_path {
1972         my $str = shift;
1973         my %opts = @_;
1974
1975         return undef unless defined $str;
1976
1977         $str = to_utf8($str);
1978         $str = $cgi->escapeHTML($str);
1979         if ($opts{'-nbsp'}) {
1980                 $str =~ s/ /&#160;/g;
1981         }
1982         use bytes;
1983         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
1984         return $str;
1985 }
1986
1987 # Sanitize for use in XHTML + application/xml+xhtm (valid XML 1.0)
1988 sub sanitize {
1989         my $str = shift;
1990
1991         return undef unless defined $str;
1992
1993         $str = to_utf8($str);
1994         use bytes;
1995         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
1996         return $str;
1997 }
1998
1999 # Make control characters "printable", using character escape codes (CEC)
2000 sub quot_cec {
2001         my $cntrl = shift;
2002         my %opts = @_;
2003         my %es = ( # character escape codes, aka escape sequences
2004                 "\t" => '\t',   # tab            (HT)
2005                 "\n" => '\n',   # line feed      (LF)
2006                 "\r" => '\r',   # carrige return (CR)
2007                 "\f" => '\f',   # form feed      (FF)
2008                 "\b" => '\b',   # backspace      (BS)
2009                 "\a" => '\a',   # alarm (bell)   (BEL)
2010                 "\e" => '\e',   # escape         (ESC)
2011                 "\013" => '\v', # vertical tab   (VT)
2012                 "\000" => '\0', # nul character  (NUL)
2013         );
2014         my $chr = ( (exists $es{$cntrl})
2015                     ? $es{$cntrl}
2016                     : sprintf('\x%02x', ord($cntrl)) );
2017         if ($opts{-nohtml}) {
2018                 return $chr;
2019         } else {
2020                 return "<span class=\"cntrl\">$chr</span>";
2021         }
2022 }
2023
2024 # Alternatively use unicode control pictures codepoints,
2025 # Unicode "printable representation" (PR)
2026 sub quot_upr {
2027         my $cntrl = shift;
2028         my %opts = @_;
2029
2030         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
2031         if ($opts{-nohtml}) {
2032                 return $chr;
2033         } else {
2034                 return "<span class=\"cntrl\">$chr</span>";
2035         }
2036 }
2037
2038 # git may return quoted and escaped filenames
2039 sub unquote {
2040         my $str = shift;
2041
2042         sub unq {
2043                 my $seq = shift;
2044                 my %es = ( # character escape codes, aka escape sequences
2045                         't' => "\t",   # tab            (HT, TAB)
2046                         'n' => "\n",   # newline        (NL)
2047                         'r' => "\r",   # return         (CR)
2048                         'f' => "\f",   # form feed      (FF)
2049                         'b' => "\b",   # backspace      (BS)
2050                         'a' => "\a",   # alarm (bell)   (BEL)
2051                         'e' => "\e",   # escape         (ESC)
2052                         'v' => "\013", # vertical tab   (VT)
2053                 );
2054
2055                 if ($seq =~ m/^[0-7]{1,3}$/) {
2056                         # octal char sequence
2057                         return chr(oct($seq));
2058                 } elsif (exists $es{$seq}) {
2059                         # C escape sequence, aka character escape code
2060                         return $es{$seq};
2061                 }
2062                 # quoted ordinary character
2063                 return $seq;
2064         }
2065
2066         if ($str =~ m/^"(.*)"$/) {
2067                 # needs unquoting
2068                 $str = $1;
2069                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
2070         }
2071         return $str;
2072 }
2073
2074 # escape tabs (convert tabs to spaces)
2075 sub untabify {
2076         my $line = shift;
2077
2078         while ((my $pos = index($line, "\t")) != -1) {
2079                 if (my $count = (8 - ($pos % 8))) {
2080                         my $spaces = ' ' x $count;
2081                         $line =~ s/\t/$spaces/;
2082                 }
2083         }
2084
2085         return $line;
2086 }
2087
2088 sub project_in_list {
2089         my $project = shift;
2090         my @list = git_get_projects_list();
2091         return @list && scalar(grep { $_->{'path'} eq $project } @list);
2092 }
2093
2094 sub cached_page_precondition_check {
2095         my $action = shift;
2096         return 1 unless
2097                 $action eq 'summary' &&
2098                 $projlist_cache_lifetime > 0 &&
2099                 gitweb_check_feature('forks');
2100
2101         # Note that ALL the 'forkchange' logic is in this function.
2102         # It does NOT belong in cached_action_page NOR in cached_action_start
2103         # NOR in cached_action_finish.  None of those functions should know anything
2104         # about nor do anything to any of the 'forkchange'/"$action.forkchange" files.
2105
2106         # besides the basic 'changed' "$action.changed" check, we may only use
2107         # a summary cache if:
2108         #
2109         #   1) we are not using a project list cache file
2110         #   -OR-
2111         #   2) we are not using the 'forks' feature
2112         #   -OR-
2113         #   3) there is no 'forkchange' nor "$action.forkchange" file in $html_cache_dir
2114         #   -OR-
2115         #   4) there is no cache file ("$cache_dir/$projlist_cache_name")
2116         #   -OR-
2117         #   5) the OLDER of 'forkchange'/"$action.forkchange" is NEWER than the cache file
2118         #
2119         # Otherwise we must re-generate the cache because we've had a fork change
2120         # (either a fork was added or a fork was removed) AND the change has been
2121         # picked up in the cache file AND we've not got that in our cached copy
2122         #
2123         # For (5) regenerating the cached page wouldn't get us anything if the project
2124         # cache file is older than the 'forkchange'/"$action.forkchange" because the
2125         # forks information comes from the project cache file and it's clearly not
2126         # picked up the changes yet so we may continue to use a cached page until it does.
2127
2128         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2129         my $fc_mt = (stat("$htmlcd/forkchange"))[9];
2130         my $afc_mt = (stat("$htmlcd/$action.forkchange"))[9];
2131         return 1 unless defined($fc_mt) || defined($afc_mt);
2132         my $prj_mt = (stat("$cache_dir/$projlist_cache_name"))[9];
2133         return 1 unless $prj_mt;
2134         my $old_mt = $fc_mt;
2135         $old_mt = $afc_mt if !defined($old_mt) || (defined($afc_mt) && $afc_mt < $old_mt);
2136         return 1 if $old_mt > $prj_mt;
2137
2138         # We're going to regenerate the cached page because we know the project cache
2139         # has new fork information that we cannot possibly have in our cached copy.
2140         #
2141         # However, if both 'forkchange' and "$action.forkchange" exist and one of
2142         # them is older than the project cache and one of them is newer, we still
2143         # need to regenerate the page cache, but we will also need to do it again
2144         # in the future because there's yet another fork update not yet in the cache.
2145         #
2146         # So we make sure to touch "$action.changed" to force a cache regeneration
2147         # and then we remove either or both of 'forkchange'/"$action.forkchange" if
2148         # they're older than the project cache (they've served their purpose, we're
2149         # forcing a page regeneration by touching "$action.changed" but the project
2150         # cache was rebuilt since then so there are no more pending fork updates to
2151         # pick up in the future and they need to go).
2152
2153         # For best results, the external code that touches 'forkchange' should always
2154         # touch 'forkchange' and additionally touch 'summary.forkchange' but only
2155         # if it does not already exist.  That way the cached page will be regenerated
2156         # each time it's requested and ANY fork updates are available in the proj
2157         # cache rather than waiting until they all are before updating.
2158
2159         # Note that we take a shortcut here and will zap 'forkchange' since we know
2160         # that it only affects the 'summary' cache.  If, in the future, it affects
2161         # other cache types, it will first need to be propogated down to
2162         # "$action.forkchange" for those types before we zap it.
2163
2164         my $fd;
2165         open $fd, '>', "$htmlcd/$action.changed" and close $fd;
2166         $fc_mt=undef, unlink "$htmlcd/forkchange" if defined $fc_mt && $fc_mt < $prj_mt;
2167         $afc_mt=undef, unlink "$htmlcd/$action.forkchange" if defined $afc_mt && $afc_mt < $prj_mt;
2168
2169         # Now we propagate 'forkchange' to "$action.forkchange" if we have the
2170         # one and not the other.
2171
2172         if (defined $fc_mt && ! defined $afc_mt) {
2173                 open $fd, '>', "$htmlcd/$action.forkchange" and close $fd;
2174                 -e "$htmlcd/$action.forkchange" and
2175                 utime($fc_mt, $fc_mt, "$htmlcd/$action.forkchange") and
2176                 unlink "$htmlcd/forkchange";
2177         }
2178
2179         return 0;
2180 }
2181
2182 sub cached_action_page {
2183         my $action = shift;
2184
2185         return undef unless $action && $html_cache_actions{$action} && $html_cache_dir;
2186         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2187         return undef if -e "$htmlcd/changed" || -e "$htmlcd/$action.changed";
2188         return undef unless cached_page_precondition_check($action);
2189         open my $fd, '<', "$htmlcd/$action" or return undef;
2190         binmode $fd;
2191         local $/;
2192         my $cached_page = <$fd>;
2193         close $fd or return undef;
2194         return $cached_page;
2195 }
2196
2197 package Git::Gitweb::CacheFile;
2198
2199 sub TIEHANDLE {
2200         use POSIX qw(:fcntl_h);
2201         my $class = shift;
2202         my $cachefile = shift;
2203
2204         sysopen(my $self, $cachefile, O_WRONLY|O_CREAT|O_EXCL, 0664)
2205                 or return undef;
2206         $$self->{'cachefile'} = $cachefile;
2207         $$self->{'opened'} = 1;
2208         $$self->{'contents'} = '';
2209         return bless $self, $class;
2210 }
2211
2212 sub CLOSE {
2213         my $self = shift;
2214         if ($$self->{'opened'}) {
2215                 $$self->{'opened'} = 0;
2216                 my $result = close $self;
2217                 unlink $$self->{'cachefile'} unless $result;
2218                 return $result;
2219         }
2220         return 0;
2221 }
2222
2223 sub DESTROY {
2224         my $self = shift;
2225         if ($$self->{'opened'}) {
2226                 $self->CLOSE() and unlink $$self->{'cachefile'};
2227         }
2228 }
2229
2230 sub PRINT {
2231         my $self = shift;
2232         @_ = (map {my $x=$_; utf8::encode($x); $x} @_) unless $fcgi_raw_mode;
2233         print $self @_ if $$self->{'opened'};
2234         $$self->{'contents'} .= join('', @_);
2235         return 1;
2236 }
2237
2238 sub PRINTF {
2239         my $self = shift;
2240         my $template = shift;
2241         return $self->PRINT(sprintf $template, @_);
2242 }
2243
2244 sub contents {
2245         my $self = shift;
2246         return $$self->{'contents'};
2247 }
2248
2249 package main;
2250
2251 # Caller is responsible for preserving STDOUT beforehand if needed
2252 sub cached_action_start {
2253         my $action = shift;
2254
2255         return undef unless $html_cache_actions{$action} && $html_cache_dir;
2256         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2257         return undef unless -d $htmlcd;
2258         if (-e "$htmlcd/changed") {
2259                 foreach my $cacheable (keys(%html_cache_actions)) {
2260                         next unless $supported_cache_actions{$cacheable} &&
2261                                     $html_cache_actions{$cacheable};
2262                         my $fd;
2263                         open $fd, '>', "$htmlcd/$cacheable.changed"
2264                         and close $fd;
2265                 }
2266                 unlink "$htmlcd/changed";
2267         }
2268         local *CACHEFILE;
2269         tie *CACHEFILE, 'Git::Gitweb::CacheFile', "$htmlcd/$action.lock"  or return undef;
2270         *STDOUT = *CACHEFILE;
2271         unlink "$htmlcd/$action", "$htmlcd/$action.changed";
2272         return 1;
2273 }
2274
2275 # Caller is responsible for restoring STDOUT afterward if needed
2276 sub cached_action_finish {
2277         my $action = shift;
2278
2279         use File::Spec;
2280
2281         my $obj = tied *STDOUT;
2282         return undef unless ref($obj) eq 'Git::Gitweb::CacheFile';
2283         my $cached_page = $obj->contents;
2284         (my $result = close(STDOUT)) or warn "couldn't close cache file on STDOUT: $!";
2285         # Do not leave STDOUT file descriptor invalid!
2286         local *NULL;
2287         open(NULL, '>', File::Spec->devnull) or die "couldn't open NULL to devnull: $!";
2288         *STDOUT = *NULL;
2289         return $cached_page unless $result;
2290         my $htmlcd = "$projectroot/$project/$html_cache_dir";
2291         return $cached_page unless -d $htmlcd;
2292         unlink "$htmlcd/$action.lock" unless rename "$htmlcd/$action.lock", "$htmlcd/$action";
2293         return $cached_page;
2294 }
2295
2296 my %expand_pi_subs;
2297 BEGIN {%expand_pi_subs = (
2298         'age_string'               => \&age_string,
2299         'age_string_date'          => \&age_string_date,
2300         'age_string_age'           => \&age_string_age,
2301         'compute_timed_interval'   => \&compute_timed_interval,
2302         'compute_commands_count'   => \&compute_commands_count,
2303         'compute_stylesheet_links' => \&compute_stylesheet_links,
2304 )}
2305
2306 # Expands any <?gitweb...> processing instructions and returns the result
2307 sub expand_gitweb_pi {
2308         my $page = shift;
2309         $page .= '';
2310         my @time_now = gettimeofday();
2311         $page =~ s{<\?gitweb(?:\s+([^\s>]+)([^>]*))?\s*\?>}
2312                   {defined($1) ?
2313                           (ref($expand_pi_subs{$1}) eq 'CODE' ?
2314                                   $expand_pi_subs{$1}->(split(' ',$2), @time_now) :
2315                                   '') :
2316                           '' }goes;
2317         return $page;
2318 }
2319
2320 ## ----------------------------------------------------------------------
2321 ## HTML aware string manipulation
2322
2323 # Try to chop given string on a word boundary between position
2324 # $len and $len+$add_len. If there is no word boundary there,
2325 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
2326 # (marking chopped part) would be longer than given string.
2327 sub chop_str {
2328         my $str = shift;
2329         my $len = shift;
2330         my $add_len = shift || 10;
2331         my $where = shift || 'right'; # 'left' | 'center' | 'right'
2332
2333         # Make sure perl knows it is utf8 encoded so we don't
2334         # cut in the middle of a utf8 multibyte char.
2335         $str = to_utf8($str);
2336
2337         # allow only $len chars, but don't cut a word if it would fit in $add_len
2338         # if it doesn't fit, cut it if it's still longer than the dots we would add
2339         # remove chopped character entities entirely
2340
2341         # when chopping in the middle, distribute $len into left and right part
2342         # return early if chopping wouldn't make string shorter
2343         if ($where eq 'center') {
2344                 return $str if ($len + 5 >= length($str)); # filler is length 5
2345                 $len = int($len/2);
2346         } else {
2347                 return $str if ($len + 4 >= length($str)); # filler is length 4
2348         }
2349
2350         # regexps: ending and beginning with word part up to $add_len
2351         my $endre = qr/.{$len}\w{0,$add_len}/;
2352         my $begre = qr/\w{0,$add_len}.{$len}/;
2353
2354         if ($where eq 'left') {
2355                 $str =~ m/^(.*?)($begre)$/;
2356                 my ($lead, $body) = ($1, $2);
2357                 if (length($lead) > 4) {
2358                         $lead = " ...";
2359                 }
2360                 return "$lead$body";
2361
2362         } elsif ($where eq 'center') {
2363                 $str =~ m/^($endre)(.*)$/;
2364                 my ($left, $str)  = ($1, $2);
2365                 $str =~ m/^(.*?)($begre)$/;
2366                 my ($mid, $right) = ($1, $2);
2367                 if (length($mid) > 5) {
2368                         $mid = " ... ";
2369                 }
2370                 return "$left$mid$right";
2371
2372         } else {
2373                 $str =~ m/^($endre)(.*)$/;
2374                 my $body = $1;
2375                 my $tail = $2;
2376                 if (length($tail) > 4) {
2377                         $tail = "... ";
2378                 }
2379                 return "$body$tail";
2380         }
2381 }
2382
2383 # pass-through email filter, obfuscating it when possible
2384 sub email_obfuscate {
2385         our $email;
2386         my ($str) = @_;
2387         if ($email) {
2388                 $str = $email->escape_html($str);
2389                 # Stock HTML::Email::Obfuscate version likes to produce
2390                 # invalid XHTML...
2391                 $str =~ s#<(/?)B>#<$1b>#g;
2392                 return $str;
2393         } else {
2394                 $str = esc_html($str);
2395                 $str =~ s/@/&#x40;/;
2396                 return $str;
2397         }
2398 }
2399
2400 # takes the same arguments as chop_str, but also wraps a <span> around the
2401 # result with a title attribute if it does get chopped. Additionally, the
2402 # string is HTML-escaped.
2403 sub chop_and_escape_str {
2404         my ($str) = @_;
2405
2406         my $chopped = chop_str(@_);
2407         $str = to_utf8($str);
2408         if ($chopped eq $str) {
2409                 return email_obfuscate($chopped);
2410         } else {
2411                 use bytes;
2412                 $str =~ s/[[:cntrl:]]/?/g;
2413                 return $cgi->span({-title=>$str}, email_obfuscate($chopped));
2414         }
2415 }
2416
2417 # Highlight selected fragments of string, using given CSS class,
2418 # and escape HTML.  It is assumed that fragments do not overlap.
2419 # Regions are passed as list of pairs (array references).
2420 #
2421 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2422 # '<span class="mark">foo</span>bar'
2423 sub esc_html_hl_regions {
2424         my ($str, $css_class, @sel) = @_;
2425         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2426         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2427         return esc_html($str, %opts) unless @sel;
2428
2429         my $out = '';
2430         my $pos = 0;
2431
2432         for my $s (@sel) {
2433                 my ($begin, $end) = @$s;
2434
2435                 # Don't create empty <span> elements.
2436                 next if $end <= $begin;
2437
2438                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2439                                        %opts);
2440
2441                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2442                         if ($begin - $pos > 0);
2443                 $out .= $cgi->span({-class => $css_class}, $escaped);
2444
2445                 $pos = $end;
2446         }
2447         $out .= esc_html(substr($str, $pos), %opts)
2448                 if ($pos < length($str));
2449
2450         return $out;
2451 }
2452
2453 # return positions of beginning and end of each match
2454 sub matchpos_list {
2455         my ($str, $regexp) = @_;
2456         return unless (defined $str && defined $regexp);
2457
2458         my @matches;
2459         while ($str =~ /$regexp/g) {
2460                 push @matches, [$-[0], $+[0]];
2461         }
2462         return @matches;
2463 }
2464
2465 # highlight match (if any), and escape HTML
2466 sub esc_html_match_hl {
2467         my ($str, $regexp) = @_;
2468         return esc_html($str) unless defined $regexp;
2469
2470         my @matches = matchpos_list($str, $regexp);
2471         return esc_html($str) unless @matches;
2472
2473         return esc_html_hl_regions($str, 'match', @matches);
2474 }
2475
2476
2477 # highlight match (if any) of shortened string, and escape HTML
2478 sub esc_html_match_hl_chopped {
2479         my ($str, $chopped, $regexp) = @_;
2480         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2481
2482         my @matches = matchpos_list($str, $regexp);
2483         return esc_html($chopped) unless @matches;
2484
2485         # filter matches so that we mark chopped string
2486         my $tail = "... "; # see chop_str
2487         unless ($chopped =~ s/\Q$tail\E$//) {
2488                 $tail = '';
2489         }
2490         my $chop_len = length($chopped);
2491         my $tail_len = length($tail);
2492         my @filtered;
2493
2494         for my $m (@matches) {
2495                 if ($m->[0] > $chop_len) {
2496                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2497                         last;
2498                 } elsif ($m->[1] > $chop_len) {
2499                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2500                         last;
2501                 }
2502                 push @filtered, $m;
2503         }
2504
2505         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2506 }
2507
2508 ## ----------------------------------------------------------------------
2509 ## functions returning short strings
2510
2511 # CSS class for given age epoch value (in seconds)
2512 # and reference time (optional, defaults to now) as second value
2513 sub age_class {
2514         my ($age_epoch, $time_now) = @_;
2515         return "noage" unless defined $age_epoch;
2516         defined $time_now or $time_now = time;
2517         my $age = $time_now - $age_epoch;
2518
2519         if ($age < 60*60*2) {
2520                 return "age0";
2521         } elsif ($age < 60*60*24*2) {
2522                 return "age1";
2523         } else {
2524                 return "age2";
2525         }
2526 }
2527
2528 # convert age epoch in seconds to "nn units ago" string
2529 # reference time used is now unless second argument passed in
2530 # to get the old behavior, pass 0 as the first argument and
2531 # the time in seconds as the second
2532 sub age_string {
2533         my ($age_epoch, $time_now) = @_;
2534         return "unknown" unless defined $age_epoch;
2535         return "<?gitweb age_string $age_epoch?>" if $cache_mode_active;
2536         defined $time_now or $time_now = time;
2537         my $age = $time_now - $age_epoch;
2538         my $age_str;
2539
2540         if ($age > 60*60*24*365*2) {
2541                 $age_str = (int $age/60/60/24/365);
2542                 $age_str .= " years ago";
2543         } elsif ($age > 60*60*24*(365/12)*2) {
2544                 $age_str = int $age/60/60/24/(365/12);
2545                 $age_str .= " months ago";
2546         } elsif ($age > 60*60*24*7*2) {
2547                 $age_str = int $age/60/60/24/7;
2548                 $age_str .= " weeks ago";
2549         } elsif ($age > 60*60*24*2) {
2550                 $age_str = int $age/60/60/24;
2551                 $age_str .= " days ago";
2552         } elsif ($age > 60*60*2) {
2553                 $age_str = int $age/60/60;
2554                 $age_str .= " hours ago";
2555         } elsif ($age > 60*2) {
2556                 $age_str = int $age/60;
2557                 $age_str .= " min ago";
2558         } elsif ($age > 2) {
2559                 $age_str = int $age;
2560                 $age_str .= " sec ago";
2561         } else {
2562                 $age_str .= " right now";
2563         }
2564         return $age_str;
2565 }
2566
2567 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2568 # this is typically shown to the user directly with the age_string_age as a title
2569 sub age_string_date {
2570         my ($age_epoch, $time_now) = @_;
2571         return "unknown" unless defined $age_epoch;
2572         return "<?gitweb age_string_date $age_epoch?>" if $cache_mode_active;
2573         defined $time_now or $time_now = time;
2574         my $age = $time_now - $age_epoch;
2575
2576         if ($age > 60*60*24*7*2) {
2577                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2578                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2579         } else {
2580                 return age_string($age_epoch, $time_now);
2581         }
2582 }
2583
2584 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2585 # this is typically used for the 'title' attribute so it will show as a tooltip
2586 sub age_string_age {
2587         my ($age_epoch, $time_now) = @_;
2588         return "unknown" unless defined $age_epoch;
2589         return "<?gitweb age_string_age $age_epoch?>" if $cache_mode_active;
2590         defined $time_now or $time_now = time;
2591         my $age = $time_now - $age_epoch;
2592
2593         if ($age > 60*60*24*7*2) {
2594                 return age_string($age_epoch, $time_now);
2595         } else {
2596                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2597                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2598         }
2599 }
2600
2601 use constant {
2602         S_IFINVALID => 0030000,
2603         S_IFGITLINK => 0160000,
2604 };
2605
2606 # submodule/subproject, a commit object reference
2607 sub S_ISGITLINK {
2608         my $mode = shift;
2609
2610         return (($mode & S_IFMT) == S_IFGITLINK)
2611 }
2612
2613 # convert file mode in octal to symbolic file mode string
2614 sub mode_str {
2615         my $mode = oct shift;
2616
2617         if (S_ISGITLINK($mode)) {
2618                 return 'm---------';
2619         } elsif (S_ISDIR($mode & S_IFMT)) {
2620                 return 'drwxr-xr-x';
2621         } elsif (S_ISLNK($mode)) {
2622                 return 'lrwxrwxrwx';
2623         } elsif (S_ISREG($mode)) {
2624                 # git cares only about the executable bit
2625                 if ($mode & S_IXUSR) {
2626                         return '-rwxr-xr-x';
2627                 } else {
2628                         return '-rw-r--r--';
2629                 };
2630         } else {
2631                 return '----------';
2632         }
2633 }
2634
2635 # convert file mode in octal to file type string
2636 sub file_type {
2637         my $mode = shift;
2638
2639         if ($mode !~ m/^[0-7]+$/) {
2640                 return $mode;
2641         } else {
2642                 $mode = oct $mode;
2643         }
2644
2645         if (S_ISGITLINK($mode)) {
2646                 return "submodule";
2647         } elsif (S_ISDIR($mode & S_IFMT)) {
2648                 return "directory";
2649         } elsif (S_ISLNK($mode)) {
2650                 return "symlink";
2651         } elsif (S_ISREG($mode)) {
2652                 return "file";
2653         } else {
2654                 return "unknown";
2655         }
2656 }
2657
2658 # convert file mode in octal to file type description string
2659 sub file_type_long {
2660         my $mode = shift;
2661
2662         if ($mode !~ m/^[0-7]+$/) {
2663                 return $mode;
2664         } else {
2665                 $mode = oct $mode;
2666         }
2667
2668         if (S_ISGITLINK($mode)) {
2669                 return "submodule";
2670         } elsif (S_ISDIR($mode & S_IFMT)) {
2671                 return "directory";
2672         } elsif (S_ISLNK($mode)) {
2673                 return "symlink";
2674         } elsif (S_ISREG($mode)) {
2675                 if ($mode & S_IXUSR) {
2676                         return "executable";
2677                 } else {
2678                         return "file";
2679                 };
2680         } else {
2681                 return "unknown";
2682         }
2683 }
2684
2685
2686 ## ----------------------------------------------------------------------
2687 ## functions returning short HTML fragments, or transforming HTML fragments
2688 ## which don't belong to other sections
2689
2690 # format line of commit message.
2691 sub format_log_line_html {
2692         my $line = shift;
2693
2694         $line = esc_html($line, -nbsp=>1);
2695         $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
2696                 $cgi->a({-href => href(action=>"object", hash=>$1),
2697                                         -class => "text"}, $1);
2698         }eg unless $line =~ /^\s*git-svn-id:/;
2699
2700         return $line;
2701 }
2702
2703 # format marker of refs pointing to given object
2704
2705 # the destination action is chosen based on object type and current context:
2706 # - for annotated tags, we choose the tag view unless it's the current view
2707 #   already, in which case we go to shortlog view
2708 # - for other refs, we keep the current view if we're in history, shortlog or
2709 #   log view, and select shortlog otherwise
2710 sub format_ref_marker {
2711         my ($refs, $id) = @_;
2712         my $markers = '';
2713
2714         if (defined $refs->{$id}) {
2715                 foreach my $ref (@{$refs->{$id}}) {
2716                         # this code exploits the fact that non-lightweight tags are the
2717                         # only indirect objects, and that they are the only objects for which
2718                         # we want to use tag instead of shortlog as action
2719                         my ($type, $name) = qw();
2720                         my $indirect = ($ref =~ s/\^\{\}$//);
2721                         # e.g. tags/v2.6.11 or heads/next
2722                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2723                                 $type = $1;
2724                                 $name = $2;
2725                         } else {
2726                                 $type = "ref";
2727                                 $name = $ref;
2728                         }
2729
2730                         my $class = $type;
2731                         $class .= " indirect" if $indirect;
2732
2733                         my $dest_action = "shortlog";
2734
2735                         if ($indirect) {
2736                                 $dest_action = "tag" unless $action eq "tag";
2737                         } elsif ($action =~ /^(history|(short)?log)$/) {
2738                                 $dest_action = $action;
2739                         }
2740
2741                         my $dest = "";
2742                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2743                         $dest .= $ref;
2744
2745                         my $link = $cgi->a({
2746                                 -href => href(
2747                                         action=>$dest_action,
2748                                         hash=>$dest
2749                                 )}, $name);
2750
2751                         $markers .= "<span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2752                                 $link . "</span>";
2753                 }
2754         }
2755
2756         if ($markers) {
2757                 return '<span class="refs">'. $markers . '</span>';
2758         } else {
2759                 return "";
2760         }
2761 }
2762
2763 # format, perhaps shortened and with markers, title line
2764 sub format_subject_html {
2765         my ($long, $short, $href, $extra) = @_;
2766         $extra = '' unless defined($extra);
2767
2768         if (length($short) < length($long)) {
2769                 use bytes;
2770                 $long =~ s/[[:cntrl:]]/?/g;
2771                 return $cgi->a({-href => $href, -class => "list subject",
2772                                 -title => to_utf8($long)},
2773                        esc_html($short)) . $extra;
2774         } else {
2775                 return $cgi->a({-href => $href, -class => "list subject"},
2776                        esc_html($long)) . $extra;
2777         }
2778 }
2779
2780 # Rather than recomputing the url for an email multiple times, we cache it
2781 # after the first hit. This gives a visible benefit in views where the avatar
2782 # for the same email is used repeatedly (e.g. shortlog).
2783 # The cache is shared by all avatar engines (currently gravatar only), which
2784 # are free to use it as preferred. Since only one avatar engine is used for any
2785 # given page, there's no risk for cache conflicts.
2786 our %avatar_cache = ();
2787
2788 # Compute the picon url for a given email, by using the picon search service over at
2789 # http://www.cs.indiana.edu/picons/search.html
2790 sub picon_url {
2791         my $email = lc shift;
2792         if (!$avatar_cache{$email}) {
2793                 my ($user, $domain) = split('@', $email);
2794                 $avatar_cache{$email} =
2795                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2796                         "$domain/$user/" .
2797                         "users+domains+unknown/up/single";
2798         }
2799         return $avatar_cache{$email};
2800 }
2801
2802 # Compute the gravatar url for a given email, if it's not in the cache already.
2803 # Gravatar stores only the part of the URL before the size, since that's the
2804 # one computationally more expensive. This also allows reuse of the cache for
2805 # different sizes (for this particular engine).
2806 sub gravatar_url {
2807         my $email = lc shift;
2808         my $size = shift;
2809         $avatar_cache{$email} ||=
2810                 "//www.gravatar.com/avatar/" .
2811                         Digest::MD5::md5_hex($email) . "?s=";
2812         return $avatar_cache{$email} . $size;
2813 }
2814
2815 # Insert an avatar for the given $email at the given $size if the feature
2816 # is enabled.
2817 sub git_get_avatar {
2818         my ($email, %opts) = @_;
2819         my $pre_white  = ($opts{-pad_before} ? "&#160;" : "");
2820         my $post_white = ($opts{-pad_after}  ? "&#160;" : "");
2821         $opts{-size} ||= 'default';
2822         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2823         my $url = "";
2824         if ($git_avatar eq 'gravatar') {
2825                 $url = gravatar_url($email, $size);
2826         } elsif ($git_avatar eq 'picon') {
2827                 $url = picon_url($email);
2828         }
2829         # Other providers can be added by extending the if chain, defining $url
2830         # as needed. If no variant puts something in $url, we assume avatars
2831         # are completely disabled/unavailable.
2832         if ($url) {
2833                 return $pre_white .
2834                        "<img width=\"$size\" " .
2835                             "class=\"avatar\" " .
2836                             "src=\"".esc_url($url)."\" " .
2837                             "alt=\"\" " .
2838                        "/>" . $post_white;
2839         } else {
2840                 return "";
2841         }
2842 }
2843
2844 sub format_search_author {
2845         my ($author, $searchtype, $displaytext) = @_;
2846         my $have_search = gitweb_check_feature('search');
2847
2848         if ($have_search) {
2849                 my $performed = "";
2850                 if ($searchtype eq 'author') {
2851                         $performed = "authored";
2852                 } elsif ($searchtype eq 'committer') {
2853                         $performed = "committed";
2854                 }
2855
2856                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2857                                 searchtext=>$author,
2858                                 searchtype=>$searchtype), class=>"list",
2859                                 title=>"Search for commits $performed by $author"},
2860                                 $displaytext);
2861
2862         } else {
2863                 return $displaytext;
2864         }
2865 }
2866
2867 # format the author name of the given commit with the given tag
2868 # the author name is chopped and escaped according to the other
2869 # optional parameters (see chop_str).
2870 sub format_author_html {
2871         my $tag = shift;
2872         my $co = shift;
2873         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2874         return "<$tag class=\"author\">" .
2875                format_search_author($co->{'author_name'}, "author",
2876                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2877                        $author) .
2878                "</$tag>";
2879 }
2880
2881 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2882 sub format_git_diff_header_line {
2883         my $line = shift;
2884         my $diffinfo = shift;
2885         my ($from, $to) = @_;
2886
2887         if ($diffinfo->{'nparents'}) {
2888                 # combined diff
2889                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2890                 if ($to->{'href'}) {
2891                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2892                                          esc_path($to->{'file'}));
2893                 } else { # file was deleted (no href)
2894                         $line .= esc_path($to->{'file'});
2895                 }
2896         } else {
2897                 # "ordinary" diff
2898                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2899                 if ($from->{'href'}) {
2900                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2901                                          'a/' . esc_path($from->{'file'}));
2902                 } else { # file was added (no href)
2903                         $line .= 'a/' . esc_path($from->{'file'});
2904                 }
2905                 $line .= ' ';
2906                 if ($to->{'href'}) {
2907                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2908                                          'b/' . esc_path($to->{'file'}));
2909                 } else { # file was deleted
2910                         $line .= 'b/' . esc_path($to->{'file'});
2911                 }
2912         }
2913
2914         return "<div class=\"diff header\">$line</div>\n";
2915 }
2916
2917 # format extended diff header line, before patch itself
2918 sub format_extended_diff_header_line {
2919         my $line = shift;
2920         my $diffinfo = shift;
2921         my ($from, $to) = @_;
2922
2923         # match <path>
2924         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2925                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2926                                        esc_path($from->{'file'}));
2927         }
2928         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2929                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2930                                  esc_path($to->{'file'}));
2931         }
2932         # match single <mode>
2933         if ($line =~ m/\s(\d{6})$/) {
2934                 $line .= '<span class="info"> (' .
2935                          file_type_long($1) .
2936                          ')</span>';
2937         }
2938         # match <hash>
2939         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2940                 # can match only for combined diff
2941                 $line = 'index ';
2942                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2943                         if ($from->{'href'}[$i]) {
2944                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
2945                                                   -class=>"hash"},
2946                                                  substr($diffinfo->{'from_id'}[$i],0,7));
2947                         } else {
2948                                 $line .= '0' x 7;
2949                         }
2950                         # separator
2951                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
2952                 }
2953                 $line .= '..';
2954                 if ($to->{'href'}) {
2955                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2956                                          substr($diffinfo->{'to_id'},0,7));
2957                 } else {
2958                         $line .= '0' x 7;
2959                 }
2960
2961         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
2962                 # can match only for ordinary diff
2963                 my ($from_link, $to_link);
2964                 if ($from->{'href'}) {
2965                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
2966                                              substr($diffinfo->{'from_id'},0,7));
2967                 } else {
2968                         $from_link = '0' x 7;
2969                 }
2970                 if ($to->{'href'}) {
2971                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2972                                            substr($diffinfo->{'to_id'},0,7));
2973                 } else {
2974                         $to_link = '0' x 7;
2975                 }
2976                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
2977                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
2978         }
2979
2980         return $line . "<br/>\n";
2981 }
2982
2983 # format from-file/to-file diff header
2984 sub format_diff_from_to_header {
2985         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
2986         my $line;
2987         my $result = '';
2988
2989         $line = $from_line;
2990         #assert($line =~ m/^---/) if DEBUG;
2991         # no extra formatting for "^--- /dev/null"
2992         if (! $diffinfo->{'nparents'}) {
2993                 # ordinary (single parent) diff
2994                 if ($line =~ m!^--- "?a/!) {
2995                         if ($from->{'href'}) {
2996                                 $line = '--- a/' .
2997                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2998                                                 esc_path($from->{'file'}));
2999                         } else {
3000                                 $line = '--- a/' .
3001                                         esc_path($from->{'file'});
3002                         }
3003                 }
3004                 $result .= qq!<div class="diff from_file">$line</div>\n!;
3005
3006         } else {
3007                 # combined diff (merge commit)
3008                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3009                         if ($from->{'href'}[$i]) {
3010                                 $line = '--- ' .
3011                                         $cgi->a({-href=>href(action=>"blobdiff",
3012                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
3013                                                              hash_parent_base=>$parents[$i],
3014                                                              file_parent=>$from->{'file'}[$i],
3015                                                              hash=>$diffinfo->{'to_id'},
3016                                                              hash_base=>$hash,
3017                                                              file_name=>$to->{'file'}),
3018                                                  -class=>"path",
3019                                                  -title=>"diff" . ($i+1)},
3020                                                 $i+1) .
3021                                         '/' .
3022                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
3023                                                 esc_path($from->{'file'}[$i]));
3024                         } else {
3025                                 $line = '--- /dev/null';
3026                         }
3027                         $result .= qq!<div class="diff from_file">$line</div>\n!;
3028                 }
3029         }
3030
3031         $line = $to_line;
3032         #assert($line =~ m/^\+\+\+/) if DEBUG;
3033         # no extra formatting for "^+++ /dev/null"
3034         if ($line =~ m!^\+\+\+ "?b/!) {
3035                 if ($to->{'href'}) {
3036                         $line = '+++ b/' .
3037                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
3038                                         esc_path($to->{'file'}));
3039                 } else {
3040                         $line = '+++ b/' .
3041                                 esc_path($to->{'file'});
3042                 }
3043         }
3044         $result .= qq!<div class="diff to_file">$line</div>\n!;
3045
3046         return $result;
3047 }
3048
3049 # create note for patch simplified by combined diff
3050 sub format_diff_cc_simplified {
3051         my ($diffinfo, @parents) = @_;
3052         my $result = '';
3053
3054         $result .= "<div class=\"diff header\">" .
3055                    "diff --cc ";
3056         if (!is_deleted($diffinfo)) {
3057                 $result .= $cgi->a({-href => href(action=>"blob",
3058                                                   hash_base=>$hash,
3059                                                   hash=>$diffinfo->{'to_id'},
3060                                                   file_name=>$diffinfo->{'to_file'}),
3061                                     -class => "path"},
3062                                    esc_path($diffinfo->{'to_file'}));
3063         } else {
3064                 $result .= esc_path($diffinfo->{'to_file'});
3065         }
3066         $result .= "</div>\n" . # class="diff header"
3067                    "<div class=\"diff nodifferences\">" .
3068                    "Simple merge" .
3069                    "</div>\n"; # class="diff nodifferences"
3070
3071         return $result;
3072 }
3073
3074 sub diff_line_class {
3075         my ($line, $from, $to) = @_;
3076
3077         # ordinary diff
3078         my $num_sign = 1;
3079         # combined diff
3080         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
3081                 $num_sign = scalar @{$from->{'href'}};
3082         }
3083
3084         my @diff_line_classifier = (
3085                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
3086                 { regexp => qr/^\\/,               class => "incomplete"  },
3087                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
3088                 # classifier for context must come before classifier add/rem,
3089                 # or we would have to use more complicated regexp, for example
3090                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
3091                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
3092                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
3093         );
3094         for my $clsfy (@diff_line_classifier) {
3095                 return $clsfy->{'class'}
3096                         if ($line =~ $clsfy->{'regexp'});
3097         }
3098
3099         # fallback
3100         return "";
3101 }
3102
3103 # assumes that $from and $to are defined and correctly filled,
3104 # and that $line holds a line of chunk header for unified diff
3105 sub format_unidiff_chunk_header {
3106         my ($line, $from, $to) = @_;
3107
3108         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
3109                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
3110
3111         $from_lines = 0 unless defined $from_lines;
3112         $to_lines   = 0 unless defined $to_lines;
3113
3114         if ($from->{'href'}) {
3115                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
3116                                      -class=>"list"}, $from_text);
3117         }
3118         if ($to->{'href'}) {
3119                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
3120                                      -class=>"list"}, $to_text);
3121         }
3122         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
3123                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3124         return $line;
3125 }
3126
3127 # assumes that $from and $to are defined and correctly filled,
3128 # and that $line holds a line of chunk header for combined diff
3129 sub format_cc_diff_chunk_header {
3130         my ($line, $from, $to) = @_;
3131
3132         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
3133         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
3134
3135         @from_text = split(' ', $ranges);
3136         for (my $i = 0; $i < @from_text; ++$i) {
3137                 ($from_start[$i], $from_nlines[$i]) =
3138                         (split(',', substr($from_text[$i], 1)), 0);
3139         }
3140
3141         $to_text   = pop @from_text;
3142         $to_start  = pop @from_start;
3143         $to_nlines = pop @from_nlines;
3144
3145         $line = "<span class=\"chunk_info\">$prefix ";
3146         for (my $i = 0; $i < @from_text; ++$i) {
3147                 if ($from->{'href'}[$i]) {
3148                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
3149                                           -class=>"list"}, $from_text[$i]);
3150                 } else {
3151                         $line .= $from_text[$i];
3152                 }
3153                 $line .= " ";
3154         }
3155         if ($to->{'href'}) {
3156                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
3157                                   -class=>"list"}, $to_text);
3158         } else {
3159                 $line .= $to_text;
3160         }
3161         $line .= " $prefix</span>" .
3162                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
3163         return $line;
3164 }
3165
3166 # process patch (diff) line (not to be used for diff headers),
3167 # returning HTML-formatted (but not wrapped) line.
3168 # If the line is passed as a reference, it is treated as HTML and not
3169 # esc_html()'ed.
3170 sub format_diff_line {
3171         my ($line, $diff_class, $from, $to) = @_;
3172
3173         if (ref($line)) {
3174                 $line = $$line;
3175         } else {
3176                 chomp $line;
3177                 $line = untabify($line);
3178
3179                 if ($from && $to && $line =~ m/^\@{2} /) {
3180                         $line = format_unidiff_chunk_header($line, $from, $to);
3181                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
3182                         $line = format_cc_diff_chunk_header($line, $from, $to);
3183                 } else {
3184                         $line = esc_html($line, -nbsp=>1);
3185                 }
3186         }
3187
3188         my $diff_classes = "diff diff_body";
3189         $diff_classes .= " $diff_class" if ($diff_class);
3190         $line = "<div class=\"$diff_classes\">$line</div>\n";
3191
3192         return $line;
3193 }
3194
3195 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
3196 # linked.  Pass the hash of the tree/commit to snapshot.
3197 sub format_snapshot_links {
3198         my ($hash) = @_;
3199         my $num_fmts = @snapshot_fmts;
3200         if ($num_fmts > 1) {
3201                 # A parenthesized list of links bearing format names.
3202                 # e.g. "snapshot (_tar.gz_ _zip_)"
3203                 return "<span class=\"snapshots\">snapshot (" . join(' ', map
3204                         $cgi->a({
3205                                 -href => href(
3206                                         action=>"snapshot",
3207                                         hash=>$hash,
3208                                         snapshot_format=>$_
3209                                 )
3210                         }, $known_snapshot_formats{$_}{'display'})
3211                 , @snapshot_fmts) . ")</span>";
3212         } elsif ($num_fmts == 1) {
3213                 # A single "snapshot" link whose tooltip bears the format name.
3214                 # i.e. "_snapshot_"
3215                 my ($fmt) = @snapshot_fmts;
3216                 return "<span class=\"snapshots\">" .
3217                         $cgi->a({
3218                                 -href => href(
3219                                         action=>"snapshot",
3220                                         hash=>$hash,
3221                                         snapshot_format=>$fmt
3222                                 ),
3223                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
3224                         }, "snapshot") . "</span>";
3225         } else { # $num_fmts == 0
3226                 return undef;
3227         }
3228 }
3229
3230 ## ......................................................................
3231 ## functions returning values to be passed, perhaps after some
3232 ## transformation, to other functions; e.g. returning arguments to href()
3233
3234 # returns hash to be passed to href to generate gitweb URL
3235 # in -title key it returns description of link
3236 sub get_feed_info {
3237         my $format = shift || 'Atom';
3238         my %res = (action => lc($format));
3239         my $matched_ref = 0;
3240
3241         # feed links are possible only for project views
3242         return unless (defined $project);
3243         # some views should link to OPML, or to generic project feed,
3244         # or don't have specific feed yet (so they should use generic)
3245         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
3246
3247         my $branch = undef;
3248         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
3249         # (fullname) to differentiate from tag links; this also makes
3250         # possible to detect branch links
3251         for my $ref (get_branch_refs()) {
3252                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
3253                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
3254                         $branch = $1;
3255                         $matched_ref = $ref;
3256                         last;
3257                 }
3258         }
3259         # find log type for feed description (title)
3260         my $type = 'log';
3261         if (defined $file_name) {
3262                 $type  = "history of $file_name";
3263                 $type .= "/" if ($action eq 'tree');
3264                 $type .= " on '$branch'" if (defined $branch);
3265         } else {
3266                 $type = "log of $branch" if (defined $branch);
3267         }
3268
3269         $res{-title} = $type;
3270         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
3271         $res{'file_name'} = $file_name;
3272
3273         return %res;
3274 }
3275
3276 ## ----------------------------------------------------------------------
3277 ## git utility subroutines, invoking git commands
3278
3279 # returns path to the core git executable and the --git-dir parameter as list
3280 sub git_cmd {
3281         $number_of_git_cmds++;
3282         return $GIT, '--git-dir='.$git_dir;
3283 }
3284
3285 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
3286 sub cmd_pipe {
3287
3288         # In order to be compatible with FCGI mode we must use POSIX
3289         # and access the STDERR_FILENO file descriptor directly
3290
3291         use POSIX qw(STDERR_FILENO dup dup2);
3292
3293         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
3294         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
3295         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
3296         close($null) or !$dup2ok or die "couldn't close NULL: $!";
3297         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
3298         my $result = open(my $fd, "-|", @_);
3299         $dup2ok = dup2($saveerr, STDERR_FILENO);
3300         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
3301         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
3302
3303         return $result ? $fd : undef;
3304 }
3305
3306 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
3307 sub git_cmd_pipe {
3308         return cmd_pipe git_cmd(), @_;
3309 }
3310
3311 # quote the given arguments for passing them to the shell
3312 # quote_command("command", "arg 1", "arg with ' and ! characters")
3313 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
3314 # Try to avoid using this function wherever possible.
3315 sub quote_command {
3316         return join(' ',
3317                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
3318 }
3319
3320 # get HEAD ref of given project as hash
3321 sub git_get_head_hash {
3322         return git_get_full_hash(shift, 'HEAD');
3323 }
3324
3325 sub git_get_full_hash {
3326         return git_get_hash(@_);
3327 }
3328
3329 sub git_get_short_hash {
3330         return git_get_hash(@_, '--short=7');
3331 }
3332
3333 sub git_get_hash {
3334         my ($project, $hash, @options) = @_;
3335         my $o_git_dir = $git_dir;
3336         my $retval = undef;
3337         $git_dir = "$projectroot/$project";
3338         if (defined(my $fd = git_cmd_pipe 'rev-parse',
3339             '--verify', '-q', @options, $hash)) {
3340                 $retval = <$fd>;
3341                 chomp $retval if defined $retval;
3342                 close $fd;
3343         }
3344         if (defined $o_git_dir) {
3345                 $git_dir = $o_git_dir;
3346         }
3347         return $retval;
3348 }
3349
3350 # get type of given object
3351 sub git_get_type {
3352         my $hash = shift;
3353
3354         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
3355         my $type = <$fd>;
3356         close $fd or return;
3357         chomp $type;
3358         return $type;
3359 }
3360
3361 # repository configuration
3362 our $config_file = '';
3363 our %config;
3364
3365 # store multiple values for single key as anonymous array reference
3366 # single values stored directly in the hash, not as [ <value> ]
3367 sub hash_set_multi {
3368         my ($hash, $key, $value) = @_;
3369
3370         if (!exists $hash->{$key}) {
3371                 $hash->{$key} = $value;
3372         } elsif (!ref $hash->{$key}) {
3373                 $hash->{$key} = [ $hash->{$key}, $value ];
3374         } else {
3375                 push @{$hash->{$key}}, $value;
3376         }
3377 }
3378
3379 # return hash of git project configuration
3380 # optionally limited to some section, e.g. 'gitweb'
3381 sub git_parse_project_config {
3382         my $section_regexp = shift;
3383         my %config;
3384
3385         local $/ = "\0";
3386
3387         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3388                 or return;
3389
3390         while (my $keyval = to_utf8(scalar <$fh>)) {
3391                 chomp $keyval;
3392                 my ($key, $value) = split(/\n/, $keyval, 2);
3393
3394                 hash_set_multi(\%config, $key, $value)
3395                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3396         }
3397         close $fh;
3398
3399         return %config;
3400 }
3401
3402 # convert config value to boolean: 'true' or 'false'
3403 # no value, number > 0, 'true' and 'yes' values are true
3404 # rest of values are treated as false (never as error)
3405 sub config_to_bool {
3406         my $val = shift;
3407
3408         return 1 if !defined $val;             # section.key
3409
3410         # strip leading and trailing whitespace
3411         $val =~ s/^\s+//;
3412         $val =~ s/\s+$//;
3413
3414         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3415                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3416 }
3417
3418 # convert config value to simple decimal number
3419 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3420 # to be multiplied by 1024, 1048576, or 1073741824
3421 sub config_to_int {
3422         my $val = shift;
3423
3424         # strip leading and trailing whitespace
3425         $val =~ s/^\s+//;
3426         $val =~ s/\s+$//;
3427
3428         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3429                 $unit = lc($unit);
3430                 # unknown unit is treated as 1
3431                 return $num * ($unit eq 'g' ? 1073741824 :
3432                                $unit eq 'm' ?    1048576 :
3433                                $unit eq 'k' ?       1024 : 1);
3434         }
3435         return $val;
3436 }
3437
3438 # convert config value to array reference, if needed
3439 sub config_to_multi {
3440         my $val = shift;
3441
3442         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3443 }
3444
3445 sub git_get_project_config {
3446         my ($key, $type) = @_;
3447
3448         return unless defined $git_dir;
3449
3450         # key sanity check
3451         return unless ($key);
3452         # only subsection, if exists, is case sensitive,
3453         # and not lowercased by 'git config -z -l'
3454         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3455                 $lo =~ s/_//g;
3456                 $key = join(".", lc($hi), $mi, lc($lo));
3457                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3458         } else {
3459                 $key = lc($key);
3460                 $key =~ s/_//g;
3461                 return if ($key =~ /\W/);
3462         }
3463         $key =~ s/^gitweb\.//;
3464
3465         # type sanity check
3466         if (defined $type) {
3467                 $type =~ s/^--//;
3468                 $type = undef
3469                         unless ($type eq 'bool' || $type eq 'int');
3470         }
3471
3472         # get config
3473         if (!defined $config_file ||
3474             $config_file ne "$git_dir/config") {
3475                 %config = git_parse_project_config('gitweb');
3476                 $config_file = "$git_dir/config";
3477         }
3478
3479         # check if config variable (key) exists
3480         return unless exists $config{"gitweb.$key"};
3481
3482         # ensure given type
3483         if (!defined $type) {
3484                 return $config{"gitweb.$key"};
3485         } elsif ($type eq 'bool') {
3486                 # backward compatibility: 'git config --bool' returns true/false
3487                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3488         } elsif ($type eq 'int') {
3489                 return config_to_int($config{"gitweb.$key"});
3490         }
3491         return $config{"gitweb.$key"};
3492 }
3493
3494 # get hash of given path at given ref
3495 sub git_get_hash_by_path {
3496         my $base = shift;
3497         my $path = shift || return undef;
3498         my $type = shift;
3499
3500         $path =~ s,/+$,,;
3501
3502         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3503                 or die_error(500, "Open git-ls-tree failed");
3504         my $line = to_utf8(scalar <$fd>);
3505         close $fd or return undef;
3506
3507         if (!defined $line) {
3508                 # there is no tree or hash given by $path at $base
3509                 return undef;
3510         }
3511
3512         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3513         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3514         if (defined $type && $type ne $2) {
3515                 # type doesn't match
3516                 return undef;
3517         }
3518         return $3;
3519 }
3520
3521 # get path of entry with given hash at given tree-ish (ref)
3522 # used to get 'from' filename for combined diff (merge commit) for renames
3523 sub git_get_path_by_hash {
3524         my $base = shift || return;
3525         my $hash = shift || return;
3526
3527         local $/ = "\0";
3528
3529         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3530                 or return undef;
3531         while (my $line = to_utf8(scalar <$fd>)) {
3532                 chomp $line;
3533
3534                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3535                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3536                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3537                         close $fd;
3538                         return $1;
3539                 }
3540         }
3541         close $fd;
3542         return undef;
3543 }
3544
3545 ## ......................................................................
3546 ## git utility functions, directly accessing git repository
3547
3548 # get the value of config variable either from file named as the variable
3549 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3550 # configuration variable in the repository config file.
3551 sub git_get_file_or_project_config {
3552         my ($path, $name) = @_;
3553
3554         $git_dir = "$projectroot/$path";
3555         open my $fd, '<', "$git_dir/$name"
3556                 or return git_get_project_config($name);
3557         my $conf = to_utf8(scalar <$fd>);
3558         close $fd;
3559         if (defined $conf) {
3560                 chomp $conf;
3561         }
3562         return $conf;
3563 }
3564
3565 sub git_get_project_description {
3566         my $path = shift;
3567         return git_get_file_or_project_config($path, 'description');
3568 }
3569
3570 sub git_get_project_category {
3571         my $path = shift;
3572         return git_get_file_or_project_config($path, 'category');
3573 }
3574
3575
3576 # supported formats:
3577 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3578 #   - if its contents is a number, use it as tag weight,
3579 #   - otherwise add a tag with weight 1
3580 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3581 #   the same value multiple times increases tag weight
3582 # * `gitweb.ctag' multi-valued repo config variable
3583 sub git_get_project_ctags {
3584         my $project = shift;
3585         my $ctags = {};
3586
3587         $git_dir = "$projectroot/$project";
3588         if (opendir my $dh, "$git_dir/ctags") {
3589                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3590                 foreach my $tagfile (@files) {
3591                         open my $ct, '<', $tagfile
3592                                 or next;
3593                         my $val = <$ct>;
3594                         chomp $val if $val;
3595                         close $ct;
3596
3597                         (my $ctag = $tagfile) =~ s#.*/##;
3598                         $ctag = to_utf8($ctag);
3599                         if ($val =~ /^\d+$/) {
3600                                 $ctags->{$ctag} = $val;
3601                         } else {
3602                                 $ctags->{$ctag} = 1;
3603                         }
3604                 }
3605                 closedir $dh;
3606
3607         } elsif (open my $fh, '<', "$git_dir/ctags") {
3608                 while (my $line = to_utf8(scalar <$fh>)) {
3609                         chomp $line;
3610                         $ctags->{$line}++ if $line;
3611                 }
3612                 close $fh;
3613
3614         } else {
3615                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3616                 foreach my $tag (@$taglist) {
3617                         $ctags->{$tag}++;
3618                 }
3619         }
3620
3621         return $ctags;
3622 }
3623
3624 # return hash, where keys are content tags ('ctags'),
3625 # and values are sum of weights of given tag in every project
3626 sub git_gather_all_ctags {
3627         my $projects = shift;
3628         my $ctags = {};
3629
3630         foreach my $p (@$projects) {
3631                 foreach my $ct (keys %{$p->{'ctags'}}) {
3632                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3633                 }
3634         }
3635
3636         return $ctags;
3637 }
3638
3639 sub git_populate_project_tagcloud {
3640         my ($ctags, $action) = @_;
3641
3642         # First, merge different-cased tags; tags vote on casing
3643         my %ctags_lc;
3644         foreach (keys %$ctags) {
3645                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3646                 if (not $ctags_lc{lc $_}->{topcount}
3647                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3648                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3649                         $ctags_lc{lc $_}->{topname} = $_;
3650                 }
3651         }
3652
3653         my $cloud;
3654         my $matched = $input_params{'ctag_filter'};
3655         if (eval { require HTML::TagCloud; 1; }) {
3656                 $cloud = HTML::TagCloud->new;
3657                 foreach my $ctag (sort keys %ctags_lc) {
3658                         # Pad the title with spaces so that the cloud looks
3659                         # less crammed.
3660                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3661                         $title =~ s/ /&#160;/g;
3662                         $title =~ s/^/&#160;/g;
3663                         $title =~ s/$/&#160;/g;
3664                         if (defined $matched && $matched eq $ctag) {
3665                                 $title = qq(<span class="match">$title</span>);
3666                         }
3667                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3668                                     $ctags_lc{$ctag}->{count});
3669                 }
3670         } else {
3671                 $cloud = {};
3672                 foreach my $ctag (keys %ctags_lc) {
3673                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3674                         if (defined $matched && $matched eq $ctag) {
3675                                 $title = qq(<span class="match">$title</span>);
3676                         }
3677                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3678                         $cloud->{$ctag}{ctag} =
3679                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3680                 }
3681         }
3682         return $cloud;
3683 }
3684
3685 sub git_show_project_tagcloud {
3686         my ($cloud, $count) = @_;
3687         if (ref $cloud eq 'HTML::TagCloud') {
3688                 return $cloud->html_and_css($count);
3689         } else {
3690                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3691                 return
3692                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3693                         join (', ', map {
3694                                 $cloud->{$_}->{'ctag'}
3695                         } splice(@tags, 0, $count)) .
3696                         '</div>';
3697         }
3698 }
3699
3700 sub git_get_project_url_list {
3701         my $path = shift;
3702
3703         $git_dir = "$projectroot/$path";
3704         open my $fd, '<', "$git_dir/cloneurl"
3705                 or return wantarray ?
3706                 @{ config_to_multi(git_get_project_config('url')) } :
3707                    config_to_multi(git_get_project_config('url'));
3708         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3709         close $fd;
3710
3711         return wantarray ? @git_project_url_list : \@git_project_url_list;
3712 }
3713
3714 sub git_get_projects_list {
3715         my $filter = shift || '';
3716         my $paranoid = shift;
3717         my @list;
3718
3719         if (-d $projects_list) {
3720                 # search in directory
3721                 my $dir = $projects_list;
3722                 # remove the trailing "/"
3723                 $dir =~ s!/+$!!;
3724                 my $pfxlen = length("$dir");
3725                 my $pfxdepth = ($dir =~ tr!/!!);
3726                 # when filtering, search only given subdirectory
3727                 if ($filter && !$paranoid) {
3728                         $dir .= "/$filter";
3729                         $dir =~ s!/+$!!;
3730                 }
3731
3732                 File::Find::find({
3733                         follow_fast => 1, # follow symbolic links
3734                         follow_skip => 2, # ignore duplicates
3735                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3736                         wanted => sub {
3737                                 # global variables
3738                                 our $project_maxdepth;
3739                                 our $projectroot;
3740                                 # skip project-list toplevel, if we get it.
3741                                 return if (m!^[/.]$!);
3742                                 # only directories can be git repositories
3743                                 return unless (-d $_);
3744                                 # don't traverse too deep (Find is super slow on os x)
3745                                 # $project_maxdepth excludes depth of $projectroot
3746                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3747                                         $File::Find::prune = 1;
3748                                         return;
3749                                 }
3750
3751                                 my $path = substr($File::Find::name, $pfxlen + 1);
3752                                 # paranoidly only filter here
3753                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3754                                         next;
3755                                 }
3756                                 # we check related file in $projectroot
3757                                 if (check_export_ok("$projectroot/$path")) {
3758                                         push @list, { path => $path };
3759                                         $File::Find::prune = 1;
3760                                 }
3761                         },
3762                 }, "$dir");
3763
3764         } elsif (-f $projects_list) {
3765                 # read from file(url-encoded):
3766                 # 'git%2Fgit.git Linus+Torvalds'
3767                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3768                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3769                 open my $fd, '<', $projects_list or return;
3770         PROJECT:
3771                 while (my $line = <$fd>) {
3772                         chomp $line;
3773                         my ($path, $owner) = split ' ', $line;
3774                         $path = unescape($path);
3775                         $owner = unescape($owner);
3776                         if (!defined $path) {
3777                                 next;
3778                         }
3779                         # if $filter is rpovided, check if $path begins with $filter
3780                         if ($filter && $path !~ m!^\Q$filter\E/!) {
3781                                 next;
3782                         }
3783                         if (check_export_ok("$projectroot/$path")) {
3784                                 my $pr = {
3785                                         path => $path
3786                                 };
3787                                 if ($owner) {
3788                                         $pr->{'owner'} = to_utf8($owner);
3789                                 }
3790                                 push @list, $pr;
3791                         }
3792                 }
3793                 close $fd;
3794         }
3795         return @list;
3796 }
3797
3798 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3799 # as side effects it sets 'forks' field to list of forks for forked projects
3800 sub filter_forks_from_projects_list {
3801         my $projects = shift;
3802
3803         my %trie; # prefix tree of directories (path components)
3804         # generate trie out of those directories that might contain forks
3805         foreach my $pr (@$projects) {
3806                 my $path = $pr->{'path'};
3807                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3808                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3809                 next unless ($path);      # skip '.git' repository: tests, git-instaweb
3810                 next unless (-d "$projectroot/$path"); # containing directory exists
3811                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3812
3813                 # add to trie
3814                 my @dirs = split('/', $path);
3815                 # walk the trie, until either runs out of components or out of trie
3816                 my $ref = \%trie;
3817                 while (scalar @dirs &&
3818                        exists($ref->{$dirs[0]})) {
3819                         $ref = $ref->{shift @dirs};
3820                 }
3821                 # create rest of trie structure from rest of components
3822                 foreach my $dir (@dirs) {
3823                         $ref = $ref->{$dir} = {};
3824                 }
3825                 # create end marker, store $pr as a data
3826                 $ref->{''} = $pr if (!exists $ref->{''});
3827         }
3828
3829         # filter out forks, by finding shortest prefix match for paths
3830         my @filtered;
3831  PROJECT:
3832         foreach my $pr (@$projects) {
3833                 # trie lookup
3834                 my $ref = \%trie;
3835         DIR:
3836                 foreach my $dir (split('/', $pr->{'path'})) {
3837                         if (exists $ref->{''}) {
3838                                 # found [shortest] prefix, is a fork - skip it
3839                                 push @{$ref->{''}{'forks'}}, $pr;
3840                                 next PROJECT;
3841                         }
3842                         if (!exists $ref->{$dir}) {
3843                                 # not in trie, cannot have prefix, not a fork
3844                                 push @filtered, $pr;
3845                                 next PROJECT;
3846                         }
3847                         # If the dir is there, we just walk one step down the trie.
3848                         $ref = $ref->{$dir};
3849                 }
3850                 # we ran out of trie
3851                 # (shouldn't happen: it's either no match, or end marker)
3852                 push @filtered, $pr;
3853         }
3854
3855         return @filtered;
3856 }
3857
3858 # note: fill_project_list_info must be run first,
3859 # for 'descr_long' and 'ctags' to be filled
3860 sub search_projects_list {
3861         my ($projlist, %opts) = @_;
3862         my $tagfilter  = $opts{'tagfilter'};
3863         my $search_re = $opts{'search_regexp'};
3864
3865         return @$projlist
3866                 unless ($tagfilter || $search_re);
3867
3868         # searching projects require filling to be run before it;
3869         fill_project_list_info($projlist,
3870                                $tagfilter  ? 'ctags' : (),
3871                                $search_re ? ('path', 'descr') : ());
3872         my @projects;
3873  PROJECT:
3874         foreach my $pr (@$projlist) {
3875
3876                 if ($tagfilter) {
3877                         next unless ref($pr->{'ctags'}) eq 'HASH';
3878                         next unless
3879                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3880                 }
3881
3882                 if ($search_re) {
3883                         my $path = $pr->{'path'};
3884                         $path =~ s/\.git$//; # should not be included in search
3885                         next unless
3886                                 $path =~ /$search_re/ ||
3887                                 $pr->{'descr_long'} =~ /$search_re/;
3888                 }
3889
3890                 push @projects, $pr;
3891         }
3892
3893         return @projects;
3894 }
3895
3896 our $gitweb_project_owner = undef;
3897 sub git_get_project_list_from_file {
3898
3899         return if (defined $gitweb_project_owner);
3900
3901         $gitweb_project_owner = {};
3902         # read from file (url-encoded):
3903         # 'git%2Fgit.git Linus+Torvalds'
3904         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3905         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3906         if (-f $projects_list) {
3907                 open(my $fd, '<', $projects_list);
3908                 while (my $line = <$fd>) {
3909                         chomp $line;
3910                         my ($pr, $ow) = split ' ', $line;
3911                         $pr = unescape($pr);
3912                         $ow = unescape($ow);
3913                         $gitweb_project_owner->{$pr} = to_utf8($ow);
3914                 }
3915                 close $fd;
3916         }
3917 }
3918
3919 sub git_get_project_owner {
3920         my $proj = shift;
3921         my $owner;
3922
3923         return undef unless $proj;
3924         $git_dir = "$projectroot/$proj";
3925
3926         if (defined $project && $proj eq $project) {
3927                 $owner = git_get_project_config('owner');
3928         }
3929         if (!defined $owner && !defined $gitweb_project_owner) {
3930                 git_get_project_list_from_file();
3931         }
3932         if (!defined $owner && exists $gitweb_project_owner->{$proj}) {
3933                 $owner = $gitweb_project_owner->{$proj};
3934         }
3935         if (!defined $owner && (!defined $project || $proj ne $project)) {
3936                 $owner = git_get_project_config('owner');
3937         }
3938         if (!defined $owner) {
3939                 $owner = get_file_owner("$git_dir");
3940         }
3941
3942         return $owner;
3943 }
3944
3945 sub parse_activity_date {
3946         my $dstr = shift;
3947
3948         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
3949                 # Unix timestamp
3950                 return 0 + $1;
3951         }
3952         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
3953                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
3954                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
3955                 defined($z) && $z ne '' or $z = 'Z';
3956                 $z =~ s/://;
3957                 substr($z,1,0) = '0' if length($z) == 4;
3958                 my $off = 0;
3959                 if (uc($z) ne 'Z') {
3960                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
3961                         $off = -$off if substr($z,0,1) eq '-';
3962                 }
3963                 return $seconds - $off;
3964         }
3965         return undef;
3966 }
3967
3968 # If $quick is true only look at $lastactivity_file
3969 sub git_get_last_activity {
3970         my ($path, $quick) = @_;
3971         my $fd;
3972
3973         $git_dir = "$projectroot/$path";
3974         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
3975                 my $activity = <$fd>;
3976                 close $fd;
3977                 return (undef) unless defined $activity;
3978                 chomp $activity;
3979                 return (undef) if $activity eq '';
3980                 if (my $timestamp = parse_activity_date($activity)) {
3981                         return ($timestamp);
3982                 }
3983         }
3984         return (undef) if $quick;
3985         defined($fd = git_cmd_pipe 'for-each-ref',
3986              '--format=%(committer)',
3987              '--sort=-committerdate',
3988              '--count=1',
3989              map { "refs/$_" } get_branch_refs ()) or return;
3990         my $most_recent = <$fd>;
3991         close $fd or return (undef);
3992         if (defined $most_recent &&
3993             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
3994                 my $timestamp = $1;
3995                 return ($timestamp);
3996         }
3997         return (undef);
3998 }
3999
4000 # Implementation note: when a single remote is wanted, we cannot use 'git
4001 # remote show -n' because that command always work (assuming it's a remote URL
4002 # if it's not defined), and we cannot use 'git remote show' because that would
4003 # try to make a network roundtrip. So the only way to find if that particular
4004 # remote is defined is to walk the list provided by 'git remote -v' and stop if
4005 # and when we find what we want.
4006 sub git_get_remotes_list {
4007         my $wanted = shift;
4008         my %remotes = ();
4009
4010         my $fd = git_cmd_pipe 'remote', '-v';
4011         return unless $fd;
4012         while (my $remote = to_utf8(scalar <$fd>)) {
4013                 chomp $remote;
4014                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
4015                 next if $wanted and not $remote eq $wanted;
4016                 my ($url, $key) = ($1, $2);
4017
4018                 $remotes{$remote} ||= { 'heads' => [] };
4019                 $remotes{$remote}{$key} = $url;
4020         }
4021         close $fd or return;
4022         return wantarray ? %remotes : \%remotes;
4023 }
4024
4025 # Takes a hash of remotes as first parameter and fills it by adding the
4026 # available remote heads for each of the indicated remotes.
4027 sub fill_remote_heads {
4028         my $remotes = shift;
4029         my @heads = map { "remotes/$_" } keys %$remotes;
4030         my @remoteheads = git_get_heads_list(undef, @heads);
4031         foreach my $remote (keys %$remotes) {
4032                 $remotes->{$remote}{'heads'} = [ grep {
4033                         $_->{'name'} =~ s!^$remote/!!
4034                         } @remoteheads ];
4035         }
4036 }
4037
4038 sub git_get_references {
4039         my $type = shift || "";
4040         my %refs;
4041         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
4042         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
4043         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
4044                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
4045                 or return;
4046
4047         while (my $line = to_utf8(scalar <$fd>)) {
4048                 chomp $line;
4049                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
4050                         if (defined $refs{$1}) {
4051                                 push @{$refs{$1}}, $2;
4052                         } else {
4053                                 $refs{$1} = [ $2 ];
4054                         }
4055                 }
4056         }
4057         close $fd or return;
4058         return \%refs;
4059 }
4060
4061 sub git_get_rev_name_tags {
4062         my $hash = shift || return undef;
4063
4064         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
4065                 or return;
4066         my $name_rev = to_utf8(scalar <$fd>);
4067         close $fd;
4068
4069         if ($name_rev =~ m|^$hash tags/(.*)$|) {
4070                 return $1;
4071         } else {
4072                 # catches also '$hash undefined' output
4073                 return undef;
4074         }
4075 }
4076
4077 ## ----------------------------------------------------------------------
4078 ## parse to hash functions
4079
4080 sub parse_date {
4081         my $epoch = shift;
4082         my $tz = shift || "-0000";
4083
4084         my %date;
4085         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
4086         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
4087         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
4088         $date{'hour'} = $hour;
4089         $date{'minute'} = $min;
4090         $date{'mday'} = $mday;
4091         $date{'day'} = $days[$wday];
4092         $date{'month'} = $months[$mon];
4093         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
4094                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
4095         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
4096                              $mday, $months[$mon], $hour ,$min;
4097         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
4098                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
4099
4100         my ($tz_sign, $tz_hour, $tz_min) =
4101                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
4102         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
4103         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
4104         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
4105         $date{'hour_local'} = $hour;
4106         $date{'minute_local'} = $min;
4107         $date{'mday_local'} = $mday;
4108         $date{'tz_local'} = $tz;
4109         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
4110                                   1900+$year, $mon+1, $mday,
4111                                   $hour, $min, $sec, $tz);
4112         return %date;
4113 }
4114
4115 my %parse_date_rfc2822_month_names;
4116 BEGIN {
4117         %parse_date_rfc2822_month_names = (
4118                 jan => 0, feb => 1, mar => 2, apr => 3, may => 4, jun => 5,
4119                 jul => 6, aug => 7, sep => 8, oct => 9, nov => 10, dec => 11
4120         );
4121 }
4122
4123 sub parse_date_rfc2822 {
4124         my $datestr = shift;
4125         return () unless defined $datestr;
4126         $datestr = $1 if $datestr =~/^[^\s]+,\s*(.*)$/;
4127         return () unless $datestr =~
4128                 /^\s*(\d{1,2})\s+([A-Za-z]{3})\s+(\d{4})\s+(\d{1,2}):(\d{2}):(\d{2})\s+([+-]\d{4})\s*$/;
4129         my ($d,$b,$Y,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7);
4130         my $m = $parse_date_rfc2822_month_names{lc($b)};
4131         return () unless defined($m);
4132         my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, 0+$m, $Y-1900);
4133         my $tzoffset = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
4134         $tzoffset = -$tzoffset if substr($z,0,1) eq '-';
4135         my $tzstring;
4136         if ($tzoffset >= 0) {
4137                 $tzstring = sprintf('+%02d%02d', int($tzoffset / 3600), int(($tzoffset % 3600) / 60));
4138         } else {
4139                 $tzstring = sprintf('-%02d%02d', int(-$tzoffset / 3600), int((-$tzoffset % 3600) / 60));
4140         }
4141         return parse_date($seconds - $tzoffset, $tzstring);
4142 }
4143
4144 sub parse_tag {
4145         my $tag_id = shift;
4146         my %tag;
4147         my @comment;
4148
4149         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
4150         $tag{'id'} = $tag_id;
4151         while (my $line = to_utf8(scalar <$fd>)) {
4152                 chomp $line;
4153                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
4154                         $tag{'object'} = $1;
4155                 } elsif ($line =~ m/^type (.+)$/) {
4156                         $tag{'type'} = $1;
4157                 } elsif ($line =~ m/^tag (.+)$/) {
4158                         $tag{'name'} = $1;
4159                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
4160                         $tag{'author'} = $1;
4161                         $tag{'author_epoch'} = $2;
4162                         $tag{'author_tz'} = $3;
4163                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4164                                 $tag{'author_name'}  = $1;
4165                                 $tag{'author_email'} = $2;
4166                         } else {
4167                                 $tag{'author_name'} = $tag{'author'};
4168                         }
4169                 } elsif ($line =~ m/--BEGIN/) {
4170                         push @comment, $line;
4171                         last;
4172                 } elsif ($line eq "") {
4173                         last;
4174                 }
4175         }
4176         push @comment, map(to_utf8($_), <$fd>);
4177         $tag{'comment'} = \@comment;
4178         close $fd or return;
4179         if (!defined $tag{'name'}) {
4180                 return
4181         };
4182         return %tag
4183 }
4184
4185 sub parse_commit_text {
4186         my ($commit_text, $withparents) = @_;
4187         my @commit_lines = split '\n', $commit_text;
4188         my %co;
4189
4190         pop @commit_lines; # Remove '\0'
4191
4192         if (! @commit_lines) {
4193                 return;
4194         }
4195
4196         my $header = shift @commit_lines;
4197         if ($header !~ m/^[0-9a-fA-F]{40}/) {
4198                 return;
4199         }
4200         ($co{'id'}, my @parents) = split ' ', $header;
4201         while (my $line = shift @commit_lines) {
4202                 last if $line eq "\n";
4203                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
4204                         $co{'tree'} = $1;
4205                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
4206                         push @parents, $1;
4207                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
4208                         $co{'author'} = to_utf8($1);
4209                         $co{'author_epoch'} = $2;
4210                         $co{'author_tz'} = $3;
4211                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
4212                                 $co{'author_name'}  = $1;
4213                                 $co{'author_email'} = $2;
4214                         } else {
4215                                 $co{'author_name'} = $co{'author'};
4216                         }
4217                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
4218                         $co{'committer'} = to_utf8($1);
4219                         $co{'committer_epoch'} = $2;
4220                         $co{'committer_tz'} = $3;
4221                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
4222                                 $co{'committer_name'}  = $1;
4223                                 $co{'committer_email'} = $2;
4224                         } else {
4225                                 $co{'committer_name'} = $co{'committer'};
4226                         }
4227                 }
4228         }
4229         if (!defined $co{'tree'}) {
4230                 return;
4231         };
4232         $co{'parents'} = \@parents;
4233         $co{'parent'} = $parents[0];
4234
4235         @commit_lines = map to_utf8($_), @commit_lines;
4236         foreach my $title (@commit_lines) {
4237                 $title =~ s/^    //;
4238                 if ($title ne "") {
4239                         $co{'title'} = chop_str($title, 80, 5);
4240                         # remove leading stuff of merges to make the interesting part visible
4241                         if (length($title) > 50) {
4242                                 $title =~ s/^Automatic //;
4243                                 $title =~ s/^merge (of|with) /Merge ... /i;
4244                                 if (length($title) > 50) {
4245                                         $title =~ s/(http|rsync):\/\///;
4246                                 }
4247                                 if (length($title) > 50) {
4248                                         $title =~ s/(master|www|rsync)\.//;
4249                                 }
4250                                 if (length($title) > 50) {
4251                                         $title =~ s/kernel.org:?//;
4252                                 }
4253                                 if (length($title) > 50) {
4254                                         $title =~ s/\/pub\/scm//;
4255                                 }
4256                         }
4257                         $co{'title_short'} = chop_str($title, 50, 5);
4258                         last;
4259                 }
4260         }
4261         if (! defined $co{'title'} || $co{'title'} eq "") {
4262                 $co{'title'} = $co{'title_short'} = '(no commit message)';
4263         }
4264         # remove added spaces
4265         foreach my $line (@commit_lines) {
4266                 $line =~ s/^    //;
4267         }
4268         $co{'comment'} = \@commit_lines;
4269
4270         my $age_epoch = $co{'committer_epoch'};
4271         $co{'age_epoch'} = $age_epoch;
4272         my $time_now = time;
4273         $co{'age_string'} = age_string($age_epoch, $time_now);
4274         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
4275         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
4276         return %co;
4277 }
4278
4279 sub parse_commit {
4280         my ($commit_id) = @_;
4281         my %co;
4282
4283         local $/ = "\0";
4284
4285         defined(my $fd = git_cmd_pipe "rev-list",
4286                 "--parents",
4287                 "--header",
4288                 "--max-count=1",
4289                 $commit_id,
4290                 "--")
4291                 or die_error(500, "Open git-rev-list failed");
4292         %co = parse_commit_text(<$fd>, 1);
4293         close $fd;
4294
4295         return %co;
4296 }
4297
4298 sub parse_commits {
4299         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
4300         my @cos;
4301
4302         $maxcount ||= 1;
4303         $skip ||= 0;
4304
4305         local $/ = "\0";
4306
4307         defined(my $fd = git_cmd_pipe "rev-list",
4308                 "--header",
4309                 @args,
4310                 ("--max-count=" . $maxcount),
4311                 ("--skip=" . $skip),
4312                 @extra_options,
4313                 $commit_id,
4314                 "--",
4315                 ($filename ? ($filename) : ()))
4316                 or die_error(500, "Open git-rev-list failed");
4317         while (my $line = <$fd>) {
4318                 my %co = parse_commit_text($line);
4319                 push @cos, \%co;
4320         }
4321         close $fd;
4322
4323         return wantarray ? @cos : \@cos;
4324 }
4325
4326 # parse line of git-diff-tree "raw" output
4327 sub parse_difftree_raw_line {
4328         my $line = shift;
4329         my %res;
4330
4331         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
4332         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
4333         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
4334                 $res{'from_mode'} = $1;
4335                 $res{'to_mode'} = $2;
4336                 $res{'from_id'} = $3;
4337                 $res{'to_id'} = $4;
4338                 $res{'status'} = $5;
4339                 $res{'similarity'} = $6;
4340                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
4341                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
4342                 } else {
4343                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
4344                 }
4345         }
4346         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
4347         # combined diff (for merge commit)
4348         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
4349                 $res{'nparents'}  = length($1);
4350                 $res{'from_mode'} = [ split(' ', $2) ];
4351                 $res{'to_mode'} = pop @{$res{'from_mode'}};
4352                 $res{'from_id'} = [ split(' ', $3) ];
4353                 $res{'to_id'} = pop @{$res{'from_id'}};
4354                 $res{'status'} = [ split('', $4) ];
4355                 $res{'to_file'} = unquote($5);
4356         }
4357         # 'c512b523472485aef4fff9e57b229d9d243c967f'
4358         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
4359                 $res{'commit'} = $1;
4360         }
4361
4362         return wantarray ? %res : \%res;
4363 }
4364
4365 # wrapper: return parsed line of git-diff-tree "raw" output
4366 # (the argument might be raw line, or parsed info)
4367 sub parsed_difftree_line {
4368         my $line_or_ref = shift;
4369
4370         if (ref($line_or_ref) eq "HASH") {
4371                 # pre-parsed (or generated by hand)
4372                 return $line_or_ref;
4373         } else {
4374                 return parse_difftree_raw_line($line_or_ref);
4375         }
4376 }
4377
4378 # parse line of git-ls-tree output
4379 sub parse_ls_tree_line {
4380         my $line = shift;
4381         my %opts = @_;
4382         my %res;
4383
4384         if ($opts{'-l'}) {
4385                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
4386                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
4387
4388                 $res{'mode'} = $1;
4389                 $res{'type'} = $2;
4390                 $res{'hash'} = $3;
4391                 $res{'size'} = $4;
4392                 if ($opts{'-z'}) {
4393                         $res{'name'} = $5;
4394                 } else {
4395                         $res{'name'} = unquote($5);
4396                 }
4397         } else {
4398                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
4399                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
4400
4401                 $res{'mode'} = $1;
4402                 $res{'type'} = $2;
4403                 $res{'hash'} = $3;
4404                 if ($opts{'-z'}) {
4405                         $res{'name'} = $4;
4406                 } else {
4407                         $res{'name'} = unquote($4);
4408                 }
4409         }
4410
4411         return wantarray ? %res : \%res;
4412 }
4413
4414 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4415 sub parse_from_to_diffinfo {
4416         my ($diffinfo, $from, $to, @parents) = @_;
4417
4418         if ($diffinfo->{'nparents'}) {
4419                 # combined diff
4420                 $from->{'file'} = [];
4421                 $from->{'href'} = [];
4422                 fill_from_file_info($diffinfo, @parents)
4423                         unless exists $diffinfo->{'from_file'};
4424                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4425                         $from->{'file'}[$i] =
4426                                 defined $diffinfo->{'from_file'}[$i] ?
4427                                         $diffinfo->{'from_file'}[$i] :
4428                                         $diffinfo->{'to_file'};
4429                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4430                                 $from->{'href'}[$i] = href(action=>"blob",
4431                                                            hash_base=>$parents[$i],
4432                                                            hash=>$diffinfo->{'from_id'}[$i],
4433                                                            file_name=>$from->{'file'}[$i]);
4434                         } else {
4435                                 $from->{'href'}[$i] = undef;
4436                         }
4437                 }
4438         } else {
4439                 # ordinary (not combined) diff
4440                 $from->{'file'} = $diffinfo->{'from_file'};
4441                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4442                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4443                                                hash=>$diffinfo->{'from_id'},
4444                                                file_name=>$from->{'file'});
4445                 } else {
4446                         delete $from->{'href'};
4447                 }
4448         }
4449
4450         $to->{'file'} = $diffinfo->{'to_file'};
4451         if (!is_deleted($diffinfo)) { # file exists in result
4452                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4453                                      hash=>$diffinfo->{'to_id'},
4454                                      file_name=>$to->{'file'});
4455         } else {
4456                 delete $to->{'href'};
4457         }
4458 }
4459
4460 ## ......................................................................
4461 ## parse to array of hashes functions
4462
4463 sub git_get_heads_list {
4464         my ($limit, @classes) = @_;
4465         @classes = get_branch_refs() unless @classes;
4466         my @patterns = map { "refs/$_" } @classes;
4467         my @headslist;
4468
4469         defined(my $fd = git_cmd_pipe 'for-each-ref',
4470                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4471                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4472                 @patterns)
4473                 or return;
4474         while (my $line = to_utf8(scalar <$fd>)) {
4475                 my %ref_item;
4476
4477                 chomp $line;
4478                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4479                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4480                 my ($committer, $epoch, $tz) =
4481                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4482                 $ref_item{'fullname'}  = $name;
4483                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4484                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4485                 $ref_item{'name'} = $name;
4486                 # for refs neither in 'heads' nor 'remotes' we want to
4487                 # show their ref dir
4488                 my $ref_dir = (defined $1) ? $1 : '';
4489                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4490                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4491                 }
4492
4493                 $ref_item{'id'}    = $hash;
4494                 $ref_item{'title'} = $title || '(no commit message)';
4495                 $ref_item{'epoch'} = $epoch;
4496                 if ($epoch) {
4497                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4498                 } else {
4499                         $ref_item{'age'} = "unknown";
4500                 }
4501
4502                 push @headslist, \%ref_item;
4503         }
4504         close $fd;
4505
4506         return wantarray ? @headslist : \@headslist;
4507 }
4508
4509 sub git_get_tags_list {
4510         my $limit = shift;
4511         my @tagslist;
4512         my $all = shift || 0;
4513         my $order = shift || $default_refs_order;
4514         my $sortkey = $all && $order eq 'name' ? 'refname' : '-creatordate';
4515
4516         defined(my $fd = git_cmd_pipe 'for-each-ref',
4517                 ($limit ? '--count='.($limit+1) : ()), "--sort=$sortkey",
4518                 '--format=%(objectname) %(objecttype) %(refname) '.
4519                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4520                 ($all ? 'refs' : 'refs/tags'))
4521                 or return;
4522         while (my $line = to_utf8(scalar <$fd>)) {
4523                 my %ref_item;
4524
4525                 chomp $line;
4526                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4527                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4528                 my ($creator, $epoch, $tz) =
4529                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4530                 $ref_item{'fullname'} = $name;
4531                 $name =~ s!^refs/!! if $all;
4532                 $name =~ s!^refs/tags/!! unless $all;
4533
4534                 $ref_item{'type'} = $type;
4535                 $ref_item{'id'} = $id;
4536                 $ref_item{'name'} = $name;
4537                 if ($type eq "tag") {
4538                         $ref_item{'subject'} = $title;
4539                         $ref_item{'reftype'} = $reftype;
4540                         $ref_item{'refid'}   = $refid;
4541                 } else {
4542                         $ref_item{'reftype'} = $type;
4543                         $ref_item{'refid'}   = $id;
4544                 }
4545
4546                 if ($type eq "tag" || $type eq "commit") {
4547                         $ref_item{'epoch'} = $epoch;
4548                         if ($epoch) {
4549                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4550                         } else {
4551                                 $ref_item{'age'} = "unknown";
4552                         }
4553                 }
4554
4555                 push @tagslist, \%ref_item;
4556         }
4557         close $fd;
4558
4559         return wantarray ? @tagslist : \@tagslist;
4560 }
4561
4562 ## ----------------------------------------------------------------------
4563 ## filesystem-related functions
4564
4565 sub get_file_owner {
4566         my $path = shift;
4567
4568         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4569         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4570         if (!defined $gcos) {
4571                 return undef;
4572         }
4573         my $owner = $gcos;
4574         $owner =~ s/[,;].*$//;
4575         return to_utf8($owner);
4576 }
4577
4578 # assume that file exists
4579 sub insert_file {
4580         my $filename = shift;
4581
4582         open my $fd, '<', $filename;
4583         while (<$fd>) {
4584                 print to_utf8($_);
4585         }
4586         close $fd;
4587 }
4588
4589 ## ......................................................................
4590 ## mimetype related functions
4591
4592 sub mimetype_guess_file {
4593         my $filename = shift;
4594         my $mimemap = shift;
4595         my $rawmode = shift;
4596         -r $mimemap or return undef;
4597
4598         my %mimemap;
4599         open(my $mh, '<', $mimemap) or return undef;
4600         while (<$mh>) {
4601                 next if m/^#/; # skip comments
4602                 my ($mimetype, @exts) = split(/\s+/);
4603                 foreach my $ext (@exts) {
4604                         $mimemap{$ext} = $mimetype;
4605                 }
4606         }
4607         close($mh);
4608
4609         my ($ext, $ans);
4610         $ext = $1 if $filename =~ /\.([^.]*)$/;
4611         $ans = $mimemap{$ext} if $ext;
4612         if (defined $ans) {
4613                 my $l = lc($ans);
4614                 $ans = 'text/html' if $l eq 'application/xhtml+xml';
4615                 if (!$rawmode) {
4616                         $ans = 'text/xml' if $l =~ m!^application/[^\s:;,=]+\+xml$! ||
4617                                              $l eq 'image/svg+xml' ||
4618                                              $l eq 'application/xml-dtd' ||
4619                                              $l eq 'application/xml-external-parsed-entity';
4620                 }
4621         }
4622         return $ans;
4623 }
4624
4625 sub mimetype_guess {
4626         my $filename = shift;
4627         my $rawmode = shift;
4628         my $mime;
4629         $filename =~ /\./ or return undef;
4630
4631         if ($mimetypes_file) {
4632                 my $file = $mimetypes_file;
4633                 if ($file !~ m!^/!) { # if it is relative path
4634                         # it is relative to project
4635                         $file = "$projectroot/$project/$file";
4636                 }
4637                 $mime = mimetype_guess_file($filename, $file, $rawmode);
4638         }
4639         $mime ||= mimetype_guess_file($filename, '/etc/mime.types', $rawmode);
4640         return $mime;
4641 }
4642
4643 sub blob_mimetype {
4644         my $fd = shift;
4645         my $filename = shift;
4646         my $rawmode = shift;
4647         my $mime;
4648
4649         # The -T/-B file operators produce the wrong result unless a perlio
4650         # layer is present when the file handle is a pipe that delivers less
4651         # than 512 bytes of data before reaching EOF.
4652         #
4653         # If we are running in a Perl that uses the stdio layer rather than the
4654         # unix+perlio layers we will end up adding a perlio layer on top of the
4655         # stdio layer and get a second level of buffering.  This is harmless
4656         # and it makes the -T/-B file operators work properly in all cases.
4657
4658         binmode $fd, ":perlio" or die_error(500, "Adding perlio layer failed")
4659                 unless grep /^perlio$/, PerlIO::get_layers($fd);
4660
4661         $mime = mimetype_guess($filename, $rawmode) if defined $filename;
4662
4663         if (!$mime && $filename) {
4664                 if ($filename =~ m/\.html?$/i) {
4665                         $mime = 'text/html';
4666                 } elsif ($filename =~ m/\.xht(?:ml)?$/i) {
4667                         $mime = 'text/html';
4668                 } elsif ($filename =~ m/\.te?xt?$/i) {
4669                         $mime = 'text/plain';
4670                 } elsif ($filename =~ m/\.(?:markdown|md)$/i) {
4671                         $mime = 'text/plain';
4672                 } elsif ($filename =~ m/\.png$/i) {
4673                         $mime = 'image/png';
4674                 } elsif ($filename =~ m/\.gif$/i) {
4675                         $mime = 'image/gif';
4676                 } elsif ($filename =~ m/\.jpe?g$/i) {
4677                         $mime = 'image/jpeg';
4678                 } elsif ($filename =~ m/\.svgz?$/i) {
4679                         $mime = 'image/svg+xml';
4680                 }
4681         }
4682
4683         # just in case
4684         return $default_blob_plain_mimetype || 'application/octet-stream' unless $fd || $mime;
4685
4686         $mime = -T $fd ? 'text/plain' : 'application/octet-stream' unless $mime;
4687
4688         return $mime;
4689 }
4690
4691 sub is_ascii {
4692         use bytes;
4693         my $data = shift;
4694         return scalar($data =~ /^[\x00-\x7f]*$/);
4695 }
4696
4697 sub is_valid_utf8 {
4698         my $data = shift;
4699         return utf8::decode($data);
4700 }
4701
4702 sub extract_html_charset {
4703         return undef unless $_[0] && "$_[0]</head>" =~ m#<head(?:\s+[^>]*)?(?<!/)>(.*?)</head\s*>#is;
4704         my $head = $1;
4705         return $2 if $head =~ m#<meta\s+charset\s*=\s*(['"])\s*([a-z0-9(:)_.+-]+)\s*\1\s*/?>#is;
4706         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) {
4707                 my %kv = (lc($1) => $3, lc($4) => $6);
4708                 my ($he, $c) = (lc($kv{'http-equiv'}), $kv{'content'});
4709                 return $1 if $he && $c && $he eq 'content-type' &&
4710                         $c =~ m!\s*text/html\s*;\s*charset\s*=\s*([a-z0-9(:)_.+-]+)\s*$!is;
4711         }
4712         return undef;
4713 }
4714
4715 sub blob_contenttype {
4716         my ($fd, $file_name, $type) = @_;
4717
4718         $type ||= blob_mimetype($fd, $file_name, 1);
4719         return $type unless $type =~ m!^text/.+!i;
4720         my ($leader, $charset, $htmlcharset);
4721         if ($fd && read($fd, $leader, 32768)) {{
4722                 $charset='US-ASCII' if is_ascii($leader);
4723                 return ("$type; charset=UTF-8", $leader) if !$charset && is_valid_utf8($leader);
4724                 $charset='ISO-8859-1' unless $charset;
4725                 $htmlcharset = extract_html_charset($leader) if $type eq 'text/html';
4726                 if ($htmlcharset && $charset ne 'US-ASCII') {
4727                         $htmlcharset = undef if $htmlcharset =~ /^(?:utf-8|us-ascii)$/i
4728                 }
4729         }}
4730         return ("$type; charset=$htmlcharset", $leader) if $htmlcharset;
4731         my $defcharset = $default_text_plain_charset || '';
4732         $defcharset =~ s/^\s+//;
4733         $defcharset =~ s/\s+$//;
4734         $defcharset = '' if $charset && $charset ne 'US-ASCII' && $defcharset =~ /^(?:utf-8|us-ascii)$/i;
4735         return ("$type; charset=" . ($defcharset || 'ISO-8859-1'), $leader);
4736 }
4737
4738 # peek the first upto 128 bytes off a file handle
4739 sub peek128bytes {
4740         my $fd = shift;
4741
4742         use IO::Handle;
4743         use bytes;
4744
4745         my $prefix128;
4746         return '' unless $fd && read($fd, $prefix128, 128);
4747
4748         # In the general case, we're guaranteed only to be able to ungetc one
4749         # character (provided, of course, we actually got a character first).
4750         #
4751         # However, we know:
4752         #
4753         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4754         #    already been called at least once on the file handle before us
4755         #
4756         # 2) we have an $fd positioned at the start of the input stream and
4757         #    therefore know we were positioned at a buffer boundary before
4758         #    reading the initial upto 128 bytes
4759         #
4760         # 3) the buffer size is at least 512 bytes
4761         #
4762         # 4) we are careful to only unget raw bytes
4763         #
4764         # 5) we are attempting to unget exactly the same number of bytes we got
4765         #
4766         # Given the above conditions we will ALWAYS be able to safely unget
4767         # the $prefix128 value we just got.
4768         #
4769         # In fact, we could read up to 511 bytes and still be sure.
4770         # (Reading 512 might pop us into the next internal buffer, but probably
4771         # not since that could break the always able to unget at least the one
4772         # you just got guarantee.)
4773
4774         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4775
4776         return $prefix128;
4777 }
4778
4779 # guess file syntax for syntax highlighting; return undef if no highlighting
4780 # the name of syntax can (in the future) depend on syntax highlighter used
4781 sub guess_file_syntax {
4782         my ($fd, $mimetype, $file_name) = @_;
4783         return undef unless $fd && defined $file_name &&
4784                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4785         my $basename = basename($file_name, '.in');
4786         return $highlight_basename{$basename}
4787                 if exists $highlight_basename{$basename};
4788
4789         # Peek to see if there's a shebang or xml line.
4790         # We always operate on bytes when testing this.
4791         {
4792                 use bytes;
4793                 my $shebang = peek128bytes($fd);
4794                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4795                         foreach my $key (keys %highlight_shebang) {
4796                                 my $ar = ref($highlight_shebang{$key}) ?
4797                                         $highlight_shebang{$key} :
4798                                         [$highlight_shebang{key}];
4799                                 map {return $key if $shebang =~ /$_/} @$ar;
4800                         }
4801                 }
4802                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4803         }
4804
4805         $basename =~ /\.([^.]*)$/;
4806         my $ext = $1 or return undef;
4807         return $highlight_ext{$ext}
4808                 if exists $highlight_ext{$ext};
4809
4810         return undef;
4811 }
4812
4813 # run highlighter and return FD of its output,
4814 # or return original FD if no highlighting
4815 sub run_highlighter {
4816         my ($fd, $syntax) = @_;
4817         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4818
4819         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4820                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4821                 quote_command($highlight_bin).
4822                 " --replace-tabs=8 --fragment --syntax $syntax")
4823                 or die_error(500, "Couldn't open file or run syntax highlighter");
4824         if (eof $hifd) {
4825                 # just in case, should not happen as we tested !eof($fd) above
4826                 return $fd if close($hifd);
4827
4828                 # should not happen
4829                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4830
4831                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4832                 # instead of dying horribly on this, just skip the highlighting
4833                 # but do output a message about it to STDERR that will end up in the log
4834                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4835                         sprintf("child exit status 0x%x\n", $?);
4836                 return $fd
4837         }
4838         close $fd;
4839         return ($hifd, 1);
4840 }
4841
4842 ## ======================================================================
4843 ## functions printing HTML: header, footer, error page
4844
4845 sub get_page_title {
4846         my $title = to_utf8($site_name);
4847
4848         unless (defined $project) {
4849                 if (defined $project_filter) {
4850                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4851                 }
4852                 return $title;
4853         }
4854         $title .= " - " . to_utf8($project);
4855
4856         return $title unless (defined $action);
4857         my $action_print = $action eq 'blame_incremental' ? 'blame' : $action;
4858         $title .= "/$action_print"; # $action is US-ASCII (7bit ASCII)
4859
4860         return $title unless (defined $file_name);
4861         $title .= " - " . esc_path($file_name);
4862         if ($action eq "tree" && $file_name !~ m|/$|) {
4863                 $title .= "/";
4864         }
4865
4866         return $title;
4867 }
4868
4869 sub get_content_type_html {
4870         # We do not ever emit application/xhtml+xml since that gives us
4871         # no benefits and it makes many browsers (e.g. Firefox) exceedingly
4872         # strict, which is troublesome for example when showing user-supplied
4873         # README.html files.
4874         return 'text/html';
4875 }
4876
4877 sub print_feed_meta {
4878         if (defined $project) {
4879                 my %href_params = get_feed_info();
4880                 if (!exists $href_params{'-title'}) {
4881                         $href_params{'-title'} = 'log';
4882                 }
4883
4884                 foreach my $format (qw(RSS Atom)) {
4885                         my $type = lc($format);
4886                         my %link_attr = (
4887                                 '-rel' => 'alternate',
4888                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4889                                 '-type' => "application/$type+xml"
4890                         );
4891
4892                         $href_params{'extra_options'} = undef;
4893                         $href_params{'action'} = $type;
4894                         $link_attr{'-href'} = href(%href_params);
4895                         print "<link ".
4896                               "rel=\"$link_attr{'-rel'}\" ".
4897                               "title=\"$link_attr{'-title'}\" ".
4898                               "href=\"$link_attr{'-href'}\" ".
4899                               "type=\"$link_attr{'-type'}\" ".
4900                               "/>\n";
4901
4902                         $href_params{'extra_options'} = '--no-merges';
4903                         $link_attr{'-href'} = href(%href_params);
4904                         $link_attr{'-title'} .= ' (no merges)';
4905                         print "<link ".
4906                               "rel=\"$link_attr{'-rel'}\" ".
4907                               "title=\"$link_attr{'-title'}\" ".
4908                               "href=\"$link_attr{'-href'}\" ".
4909                               "type=\"$link_attr{'-type'}\" ".
4910                               "/>\n";
4911                 }
4912
4913         } else {
4914                 printf('<link rel="alternate" title="%s projects list" '.
4915                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4916                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4917                 printf('<link rel="alternate" title="%s projects feeds" '.
4918                        'href="%s" type="text/x-opml" />'."\n",
4919                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4920         }
4921 }
4922
4923 sub compute_stylesheet_links {
4924         return "<?gitweb compute_stylesheet_links?>" if $cache_mode_active;
4925
4926         # include each stylesheet that exists, providing backwards capability
4927         # for those people who defined $stylesheet in a config file
4928         if (defined $stylesheet) {
4929                 return '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4930         } else {
4931                 my $sheets = '';
4932                 foreach my $stylesheet (@stylesheets) {
4933                         next unless $stylesheet;
4934                         $sheets .= '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4935                 }
4936                 return $sheets;
4937         }
4938 }
4939
4940 sub print_header_links {
4941         my $status = shift;
4942
4943         print compute_stylesheet_links();
4944         print_feed_meta()
4945                 if ($status eq '200 OK');
4946         if (defined $favicon) {
4947                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4948         }
4949 }
4950
4951 sub print_nav_breadcrumbs_path {
4952         my $dirprefix = undef;
4953         while (my $part = shift) {
4954                 $dirprefix .= "/" if defined $dirprefix;
4955                 $dirprefix .= $part;
4956                 print $cgi->a({-href => href(project => undef,
4957                                              project_filter => $dirprefix,
4958                                              action => "project_list")},
4959                               esc_html($part)) . " / ";
4960         }
4961 }
4962
4963 sub print_nav_breadcrumbs {
4964         my %opts = @_;
4965
4966         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4967                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4968         }
4969         if (defined $project) {
4970                 my @dirname = split '/', $project;
4971                 my $projectbasename = pop @dirname;
4972                 print_nav_breadcrumbs_path(@dirname);
4973                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4974                 if (defined $action) {
4975                         my $action_print = $action ;
4976                         $action_print = 'blame' if $action_print eq 'blame_incremental';
4977                         if (defined $opts{-action_extra}) {
4978                                 $action_print = $cgi->a({-href => href(action=>$action)},
4979                                         $action);
4980                         }
4981                         print " / $action_print";
4982                 }
4983                 if (defined $opts{-action_extra}) {
4984                         print " / $opts{-action_extra}";
4985                 }
4986                 print "\n";
4987         } elsif (defined $project_filter) {
4988                 print_nav_breadcrumbs_path(split '/', $project_filter);
4989         }
4990 }
4991
4992 sub print_search_form {
4993         if (!defined $searchtext) {
4994                 $searchtext = "";
4995         }
4996         my $search_hash;
4997         if (defined $hash_base) {
4998                 $search_hash = $hash_base;
4999         } elsif (defined $hash) {
5000                 $search_hash = $hash;
5001         } else {
5002                 $search_hash = "HEAD";
5003         }
5004         # We can't use href() here because we need to encode the
5005         # URL parameters into the form, not into the action link.
5006         my $action = $my_uri;
5007         my $use_pathinfo = gitweb_check_feature('pathinfo');
5008         if ($use_pathinfo) {
5009                 # See notes about doubled / in href()
5010                 $action =~ s,/$,,;
5011                 $action .= "/".esc_path_info($project);
5012         }
5013         print $cgi->start_form(-method => "get", -action => $action) .
5014               "<div class=\"search\">\n" .
5015               (!$use_pathinfo &&
5016               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
5017               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
5018               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
5019               $cgi->popup_menu(-name => 'st', -default => 'commit',
5020                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
5021               $cgi->sup($cgi->a({-href => href(action=>"search_help"),
5022                                  -title => "search help" },
5023                                 "<span style=\"padding-bottom:1em\">?&#160;</span>")) . " search:\n",
5024               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
5025               "<span title=\"Extended regular expression\">" .
5026               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5027                              -checked => $search_use_regexp) .
5028               "</span>" .
5029               "</div>" .
5030               $cgi->end_form() . "\n";
5031 }
5032
5033 sub git_header_html {
5034         my $status = shift || "200 OK";
5035         my $expires = shift;
5036         my %opts = @_;
5037
5038         my $title = get_page_title();
5039         my $content_type = get_content_type_html();
5040         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
5041                            -status=> $status, -expires => $expires)
5042                 unless ($opts{'-no_http_header'});
5043         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
5044         print <<EOF;
5045 <?xml version="1.0" encoding="utf-8"?>
5046 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
5047 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
5048 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
5049 <!-- git core binaries version $git_version -->
5050 <head>
5051 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
5052 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
5053 <meta name="robots" content="index, nofollow"/>
5054 <title>$title</title>
5055 <script type="text/javascript">/* <![CDATA[ */
5056 function fixBlameLinks() {
5057         var allLinks = document.getElementsByTagName("a");
5058         for (var i = 0; i < allLinks.length; i++) {
5059                 var link = allLinks.item(i);
5060                 if (link.className == 'blamelink')
5061                         link.href = link.href.replace("/blame/", "/blame_incremental/");
5062         }
5063 }
5064 /* ]]> */</script>
5065 EOF
5066         # the stylesheet, favicon etc urls won't work correctly with path_info
5067         # unless we set the appropriate base URL
5068         if ($ENV{'PATH_INFO'}) {
5069                 print "<base href=\"".esc_url($base_url)."\" />\n";
5070         }
5071         print_header_links($status);
5072
5073         if (defined $site_html_head_string) {
5074                 print to_utf8($site_html_head_string);
5075         }
5076
5077         print "</head>\n" .
5078               "<body><span class=\"body\">\n";
5079
5080         if (defined $site_header && -f $site_header) {
5081                 insert_file($site_header);
5082         }
5083
5084         print "<div class=\"page_header\">\n";
5085         if (defined $logo) {
5086                 print $cgi->a({-href => esc_url($logo_url),
5087                                -title => $logo_label},
5088                               $cgi->img({-src => esc_url($logo),
5089                                          -width => 72, -height => 27,
5090                                          -alt => "git",
5091                                          -class => "logo"}));
5092         }
5093         print_nav_breadcrumbs(%opts);
5094         print "</div>\n";
5095
5096         my $have_search = gitweb_check_feature('search');
5097         if (defined $project && $have_search) {
5098                 print_search_form();
5099         }
5100 }
5101
5102 sub compute_timed_interval {
5103         return "<?gitweb compute_timed_interval?>" if $cache_mode_active;
5104         return tv_interval($t0, [ gettimeofday() ]);
5105 }
5106
5107 sub compute_commands_count {
5108         return "<?gitweb compute_commands_count?>" if $cache_mode_active;
5109         my $s = $number_of_git_cmds == 1 ? '' : 's';
5110         return '<span id="generating_cmd">'.
5111                 $number_of_git_cmds.
5112                 "</span> git command$s";
5113 }
5114
5115 sub git_footer_html {
5116         my $feed_class = 'rss_logo';
5117
5118         print "<div class=\"page_footer\">\n";
5119         if (defined $project) {
5120                 my $descr = git_get_project_description($project);
5121                 if (defined $descr) {
5122                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
5123                 }
5124
5125                 my %href_params = get_feed_info();
5126                 if (!%href_params) {
5127                         $feed_class .= ' generic';
5128                 }
5129                 $href_params{'-title'} ||= 'log';
5130
5131                 foreach my $format (qw(RSS Atom)) {
5132                         $href_params{'action'} = lc($format);
5133                         print $cgi->a({-href => href(%href_params),
5134                                       -title => "$href_params{'-title'} $format feed",
5135                                       -class => $feed_class}, $format)."\n";
5136                 }
5137
5138         } else {
5139                 print $cgi->a({-href => href(project=>undef, action=>"opml",
5140                                              project_filter => $project_filter),
5141                               -class => $feed_class}, "OPML") . " ";
5142                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
5143                                              project_filter => $project_filter),
5144                               -class => $feed_class}, "TXT") . "\n";
5145         }
5146         print "</div>\n"; # class="page_footer"
5147
5148         if (defined $t0 && gitweb_check_feature('timed')) {
5149                 print "<div id=\"generating_info\">\n";
5150                 print 'This page took '.
5151                       '<span id="generating_time" class="time_span">'.
5152                       compute_timed_interval().
5153                       ' seconds </span>'.
5154                       ' and '.
5155                       compute_commands_count().
5156                       " to generate.\n";
5157                 print "</div>\n"; # class="page_footer"
5158         }
5159
5160         if (defined $site_footer && -f $site_footer) {
5161                 insert_file($site_footer);
5162         }
5163
5164         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
5165         if (defined $action &&
5166             $action eq 'blame_incremental') {
5167                 print qq!<script type="text/javascript">\n!.
5168                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
5169                       qq!           "!. href() .qq!");\n!.
5170                       qq!</script>\n!;
5171         } else {
5172                 my ($jstimezone, $tz_cookie, $datetime_class) =
5173                         gitweb_get_feature('javascript-timezone');
5174
5175                 print qq!<script type="text/javascript">\n!.
5176                       qq!window.onload = function () {\n!;
5177                 if (gitweb_check_feature('blame_incremental')) {
5178                         print qq!       fixBlameLinks();\n!;
5179                 }
5180                 if (gitweb_check_feature('javascript-actions')) {
5181                         print qq!       fixLinks();\n!;
5182                 }
5183                 if ($jstimezone && $tz_cookie && $datetime_class) {
5184                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
5185                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
5186                 }
5187                 print qq!};\n!.
5188                       qq!</script>\n!;
5189         }
5190
5191         print "</span></body>\n" .
5192               "</html>";
5193 }
5194
5195 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
5196 # Example: die_error(404, 'Hash not found')
5197 # By convention, use the following status codes (as defined in RFC 2616):
5198 # 400: Invalid or missing CGI parameters, or
5199 #      requested object exists but has wrong type.
5200 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
5201 #      this server or project.
5202 # 404: Requested object/revision/project doesn't exist.
5203 # 500: The server isn't configured properly, or
5204 #      an internal error occurred (e.g. failed assertions caused by bugs), or
5205 #      an unknown error occurred (e.g. the git binary died unexpectedly).
5206 # 503: The server is currently unavailable (because it is overloaded,
5207 #      or down for maintenance).  Generally, this is a temporary state.
5208 sub die_error {
5209         my $status = shift || 500;
5210         my $error = esc_html(shift) || "Internal Server Error";
5211         my $extra = shift;
5212         my %opts = @_;
5213
5214         my %http_responses = (
5215                 400 => '400 Bad Request',
5216                 403 => '403 Forbidden',
5217                 404 => '404 Not Found',
5218                 500 => '500 Internal Server Error',
5219                 503 => '503 Service Unavailable',
5220         );
5221         git_header_html($http_responses{$status}, undef, %opts);
5222         print <<EOF;
5223 <div class="page_body">
5224 <br /><br />
5225 $status - $error
5226 <br />
5227 EOF
5228         if (defined $extra) {
5229                 print "<hr />\n" .
5230                       "$extra\n";
5231         }
5232         print "</div>\n";
5233
5234         git_footer_html();
5235         goto DONE_GITWEB
5236                 unless ($opts{'-error_handler'});
5237 }
5238
5239 ## ----------------------------------------------------------------------
5240 ## functions printing or outputting HTML: navigation
5241
5242 # $content is wrapped in a span with class 'tab'
5243 # If $selected is true it also has class 'selected'
5244 # If $disabled is true it also has class 'disabled'
5245 # Whether or not a tab can be disabled and selected at the same time
5246 # is up to the caller
5247 # If $extra_classes is non-empty, it is a whitespace-separated list of
5248 # additional class names to include
5249 # Note that $content MUST already be html-escaped as needed because
5250 # it is included verbatim.  And so are any extra class names.
5251 sub tabspan {
5252         my ($content, $selected, $disabled, $extra_classes) = @_;
5253         my @classes = ("tab");
5254         push(@classes, "selected") if $selected;
5255         push(@classes, "disabled") if $disabled;
5256         push(@classes, split(' ', $extra_classes)) if $extra_classes;
5257         return "<span class=\"" . join(" ", @classes) . "\">". $content . "</span>";
5258 }
5259
5260 sub git_print_page_nav {
5261         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
5262         $extra = '' if !defined $extra; # pager or formats
5263         $extra = "<span class=\"page_nav_sub\">".$extra."</span>" if $extra ne '';
5264
5265         my @navs = qw(summary log commit commitdiff tree refs);
5266         if ($suppress) {
5267                 @navs = grep { $_ ne $suppress } @navs;
5268         }
5269
5270         my %arg = map { $_ => {action=>$_} } @navs;
5271         if (defined $head) {
5272                 for (qw(commit commitdiff)) {
5273                         $arg{$_}{'hash'} = $head;
5274                 }
5275                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
5276                         $arg{'log'}{'hash'} = $head;
5277                 }
5278         }
5279
5280         $arg{'log'}{'action'} = 'shortlog';
5281         if ($current eq 'log') {
5282                 $current = 'shortlog';
5283         } elsif ($current eq 'shortlog') {
5284                 $current = 'log';
5285         }
5286         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
5287         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
5288
5289         my @actions = gitweb_get_feature('actions');
5290         my $escname = $project;
5291         $escname =~ s/[+]/%2B/g;
5292         my %repl = (
5293                 '%' => '%',
5294                 'n' => $project,         # project name
5295                 'f' => $git_dir,         # project path within filesystem
5296                 'h' => $treehead || '',  # current hash ('h' parameter)
5297                 'b' => $treebase || '',  # hash base ('hb' parameter)
5298                 'e' => $escname,         # project name with '+' escaped
5299         );
5300         while (@actions) {
5301                 my ($label, $link, $pos) = splice(@actions,0,3);
5302                 # insert
5303                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
5304                 # munch munch
5305                 $link =~ s/%([%nfhbe])/$repl{$1}/g;
5306                 $arg{$label}{'_href'} = $link;
5307         }
5308
5309         print "<div class=\"page_nav\">\n" .
5310                 (join $barsep,
5311                  map { $_ eq $current ?
5312                        tabspan($_, 1) :
5313                        tabspan($cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_"))
5314                  } @navs);
5315         print "<br/>\n$extra<br/>\n" .
5316               "</div>\n";
5317 }
5318
5319 # returns a submenu for the nagivation of the refs views (tags, heads,
5320 # remotes) with the current view disabled and the remotes view only
5321 # available if the feature is enabled
5322 sub format_ref_views {
5323         my ($current) = @_;
5324         my @ref_views = qw{tags heads};
5325         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
5326         return join $barsep, map {
5327                 $_ eq $current ? tabspan($_, 1) :
5328                 tabspan($cgi->a({-href => href(action=>$_)}, $_))
5329         } @ref_views
5330 }
5331
5332 sub format_paging_nav {
5333         my ($action, $page, $has_next_link) = @_;
5334         my $paging_nav = "<span class=\"paging_nav\">";
5335
5336         if ($page > 0) {
5337                 $paging_nav .= tabspan(
5338                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first")) .
5339                         $mdotsep . tabspan(
5340                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
5341                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
5342         } else {
5343                 $paging_nav .= tabspan("first", 1).${mdotsep}.tabspan("prev", 0, 1);
5344         }
5345
5346         if ($has_next_link) {
5347                 $paging_nav .= $mdotsep . tabspan(
5348                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
5349                                  -accesskey => "n", -title => "Alt-n"}, "next"));
5350         } else {
5351                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
5352         }
5353
5354         return $paging_nav."</span>";
5355 }
5356
5357 sub format_log_nav {
5358         my ($action, $page, $has_next_link, $extra) = @_;
5359         my $paging_nav;
5360         defined $extra or $extra = '';
5361         $extra eq '' or $extra .= $barsep;
5362
5363         if ($action eq 'shortlog') {
5364                 $paging_nav .= tabspan('shortlog', 1);
5365         } else {
5366                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'shortlog', -replay=>1)}, 'shortlog'));
5367         }
5368         $paging_nav .= $barsep;
5369         if ($action eq 'log') {
5370                 $paging_nav .= tabspan('fulllog', 1);
5371         } else {
5372                 $paging_nav .= tabspan($cgi->a({-href => href(action=>'log', -replay=>1)}, 'fulllog'));
5373         }
5374
5375         $paging_nav .= $barsep . $extra . format_paging_nav($action, $page, $has_next_link);
5376         return $paging_nav;
5377 }
5378
5379 ## ......................................................................
5380 ## functions printing or outputting HTML: div
5381
5382 sub git_print_header_div {
5383         my ($action, $title, $hash, $hash_base, $extra) = @_;
5384         my %args = ();
5385         defined $extra or $extra = '';
5386
5387         $args{'action'} = $action;
5388         $args{'hash'} = $hash if $hash;
5389         $args{'hash_base'} = $hash_base if $hash_base;
5390
5391         my $link1 = $cgi->a({-href => href(%args), -class => "title"},
5392                             $title ? $title : $action);
5393         my $link2 = $cgi->a({-href => href(%args), -class => "cover"}, "");
5394         print "<div class=\"header\">\n" . '<span class="title">' .
5395               $link1 . $extra . $link2 . '</span>' . "\n</div>\n";
5396 }
5397
5398 sub format_repo_url {
5399         my ($name, $url) = @_;
5400         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
5401 }
5402
5403 # Group output by placing it in a DIV element and adding a header.
5404 # Options for start_div() can be provided by passing a hash reference as the
5405 # first parameter to the function.
5406 # Options to git_print_header_div() can be provided by passing an array
5407 # reference. This must follow the options to start_div if they are present.
5408 # The content can be a scalar, which is output as-is, a scalar reference, which
5409 # is output after html escaping, an IO handle passed either as *handle or
5410 # *handle{IO}, or a function reference. In the latter case all following
5411 # parameters will be taken as argument to the content function call.
5412 sub git_print_section {
5413         my ($div_args, $header_args, $content);
5414         my $arg = shift;
5415         if (ref($arg) eq 'HASH') {
5416                 $div_args = $arg;
5417                 $arg = shift;
5418         }
5419         if (ref($arg) eq 'ARRAY') {
5420                 $header_args = $arg;
5421                 $arg = shift;
5422         }
5423         $content = $arg;
5424
5425         print $cgi->start_div($div_args);
5426         git_print_header_div(@$header_args);
5427
5428         if (ref($content) eq 'CODE') {
5429                 $content->(@_);
5430         } elsif (ref($content) eq 'SCALAR') {
5431                 print esc_html($$content);
5432         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
5433                 while (<$content>) {
5434                         print to_utf8($_);
5435                 }
5436         } elsif (!ref($content) && defined($content)) {
5437                 print $content;
5438         }
5439
5440         print $cgi->end_div;
5441 }
5442
5443 sub format_timestamp_html {
5444         my $date = shift;
5445         my $strtime = $date->{'rfc2822'};
5446
5447         my (undef, undef, $datetime_class) =
5448                 gitweb_get_feature('javascript-timezone');
5449         if ($datetime_class) {
5450                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
5451         }
5452
5453         my $localtime_format = '(%d %02d:%02d %s)';
5454         if ($date->{'hour_local'} < 6) {
5455                 $localtime_format = '(<span class="atnight">%d %02d:%02d</span> %s)';
5456         }
5457         $strtime .= ' ' .
5458                     sprintf($localtime_format, $date->{'mday_local'},
5459                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
5460
5461         return $strtime;
5462 }
5463
5464 # Outputs the author name and date in long form
5465 sub git_print_authorship {
5466         my $co = shift;
5467         my %opts = @_;
5468         my $tag = $opts{-tag} || 'div';
5469         my $author = $co->{'author_name'};
5470
5471         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
5472         print "<$tag class=\"author_date\">" .
5473               format_search_author($author, "author", esc_html($author)) .
5474               " [".format_timestamp_html(\%ad)."]".
5475               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
5476               "</$tag>\n";
5477 }
5478
5479 # Outputs table rows containing the full author or committer information,
5480 # in the format expected for 'commit' view (& similar).
5481 # Parameters are a commit hash reference, followed by the list of people
5482 # to output information for. If the list is empty it defaults to both
5483 # author and committer.
5484 sub git_print_authorship_rows {
5485         my $co = shift;
5486         # too bad we can't use @people = @_ || ('author', 'committer')
5487         my @people = @_;
5488         @people = ('author', 'committer') unless @people;
5489         foreach my $who (@people) {
5490                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
5491                 print "<tr><td>$who</td><td>" .
5492                       format_search_author($co->{"${who}_name"}, $who,
5493                                            esc_html($co->{"${who}_name"})) . " " .
5494                       format_search_author($co->{"${who}_email"}, $who,
5495                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
5496                       "</td><td rowspan=\"2\">" .
5497                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
5498                       "</td></tr>\n" .
5499                       "<tr>" .
5500                       "<td></td><td>" .
5501                       format_timestamp_html(\%wd) .
5502                       "</td>" .
5503                       "</tr>\n";
5504         }
5505 }
5506
5507 sub git_print_page_path {
5508         my $name = shift;
5509         my $type = shift;
5510         my $hb = shift;
5511
5512
5513         print "<div class=\"page_path\">";
5514         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
5515                       -title => 'tree root'}, to_utf8("[$project]"));
5516         print " / ";
5517         if (defined $name) {
5518                 my @dirname = split '/', $name;
5519                 my $basename = pop @dirname;
5520                 my $fullname = '';
5521
5522                 foreach my $dir (@dirname) {
5523                         $fullname .= ($fullname ? '/' : '') . $dir;
5524                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
5525                                                      hash_base=>$hb),
5526                                       -title => $fullname}, esc_path($dir));
5527                         print " / ";
5528                 }
5529                 if (defined $type && $type eq 'blob') {
5530                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
5531                                                      hash_base=>$hb),
5532                                       -title => $name}, esc_path($basename));
5533                 } elsif (defined $type && $type eq 'tree') {
5534                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
5535                                                      hash_base=>$hb),
5536                                       -title => $name}, esc_path($basename));
5537                         print " / ";
5538                 } else {
5539                         print esc_path($basename);
5540                 }
5541         }
5542         print "<br/></div>\n";
5543 }
5544
5545 sub git_print_log {
5546         my $log = shift;
5547         my %opts = @_;
5548
5549         if ($opts{'-remove_title'}) {
5550                 # remove title, i.e. first line of log
5551                 shift @$log;
5552         }
5553         # remove leading empty lines
5554         while (defined $log->[0] && $log->[0] eq "") {
5555                 shift @$log;
5556         }
5557
5558         # print log
5559         my $skip_blank_line = 0;
5560         foreach my $line (@$log) {
5561                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5562                         if (! $opts{'-remove_signoff'}) {
5563                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5564                                 $skip_blank_line = 1;
5565                         }
5566                         next;
5567                 }
5568
5569                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5570                         if (! $opts{'-remove_signoff'}) {
5571                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5572                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5573                                         "</span><br/>\n";
5574                                 $skip_blank_line = 1;
5575                         }
5576                         next;
5577                 }
5578
5579                 # print only one empty line
5580                 # do not print empty line after signoff
5581                 if ($line eq "") {
5582                         next if ($skip_blank_line);
5583                         $skip_blank_line = 1;
5584                 } else {
5585                         $skip_blank_line = 0;
5586                 }
5587
5588                 print format_log_line_html($line) . "<br/>\n";
5589         }
5590
5591         if ($opts{'-final_empty_line'}) {
5592                 # end with single empty line
5593                 print "<br/>\n" unless $skip_blank_line;
5594         }
5595 }
5596
5597 # return link target (what link points to)
5598 sub git_get_link_target {
5599         my $hash = shift;
5600         my $link_target;
5601
5602         # read link
5603         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5604                 or return;
5605         {
5606                 local $/ = undef;
5607                 $link_target = to_utf8(scalar <$fd>);
5608         }
5609         close $fd
5610                 or return;
5611
5612         return $link_target;
5613 }
5614
5615 # given link target, and the directory (basedir) the link is in,
5616 # return target of link relative to top directory (top tree);
5617 # return undef if it is not possible (including absolute links).
5618 sub normalize_link_target {
5619         my ($link_target, $basedir) = @_;
5620
5621         # absolute symlinks (beginning with '/') cannot be normalized
5622         return if (substr($link_target, 0, 1) eq '/');
5623
5624         # normalize link target to path from top (root) tree (dir)
5625         my $path;
5626         if ($basedir) {
5627                 $path = $basedir . '/' . $link_target;
5628         } else {
5629                 # we are in top (root) tree (dir)
5630                 $path = $link_target;
5631         }
5632
5633         # remove //, /./, and /../
5634         my @path_parts;
5635         foreach my $part (split('/', $path)) {
5636                 # discard '.' and ''
5637                 next if (!$part || $part eq '.');
5638                 # handle '..'
5639                 if ($part eq '..') {
5640                         if (@path_parts) {
5641                                 pop @path_parts;
5642                         } else {
5643                                 # link leads outside repository (outside top dir)
5644                                 return;
5645                         }
5646                 } else {
5647                         push @path_parts, $part;
5648                 }
5649         }
5650         $path = join('/', @path_parts);
5651
5652         return $path;
5653 }
5654
5655 # print tree entry (row of git_tree), but without encompassing <tr> element
5656 sub git_print_tree_entry {
5657         my ($t, $basedir, $hash_base, $have_blame) = @_;
5658
5659         my %base_key = ();
5660         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5661
5662         # The format of a table row is: mode list link.  Where mode is
5663         # the mode of the entry, list is the name of the entry, an href,
5664         # and link is the action links of the entry.
5665
5666         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5667         if (exists $t->{'size'}) {
5668                 print "<td class=\"size\">$t->{'size'}</td>\n";
5669         }
5670         if ($t->{'type'} eq "blob") {
5671                 print "<td class=\"list\">" .
5672                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5673                                                file_name=>"$basedir$t->{'name'}", %base_key),
5674                                 -class => "list"}, esc_path($t->{'name'}));
5675                 if (S_ISLNK(oct $t->{'mode'})) {
5676                         my $link_target = git_get_link_target($t->{'hash'});
5677                         if ($link_target) {
5678                                 my $norm_target = normalize_link_target($link_target, $basedir);
5679                                 if (defined $norm_target) {
5680                                         print " -> " .
5681                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5682                                                                      file_name=>$norm_target),
5683                                                        -title => $norm_target}, esc_path($link_target));
5684                                 } else {
5685                                         print " -> " . esc_path($link_target);
5686                                 }
5687                         }
5688                 }
5689                 print "</td>\n";
5690                 print "<td class=\"link\">";
5691                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5692                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5693                               "blob");
5694                 if ($have_blame) {
5695                         print $barsep .
5696                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5697                                                      file_name=>"$basedir$t->{'name'}", %base_key),
5698                                       -class => "blamelink"},
5699                                       "blame");
5700                 }
5701                 if (defined $hash_base) {
5702                         print $barsep .
5703                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5704                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5705                                       "history");
5706                 }
5707                 print $barsep .
5708                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5709                                                file_name=>"$basedir$t->{'name'}")},
5710                                 "raw");
5711                 print "</td>\n";
5712
5713         } elsif ($t->{'type'} eq "tree") {
5714                 print "<td class=\"list\">";
5715                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5716                                              file_name=>"$basedir$t->{'name'}",
5717                                              %base_key)},
5718                               esc_path($t->{'name'}));
5719                 print "</td>\n";
5720                 print "<td class=\"link\">";
5721                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5722                                              file_name=>"$basedir$t->{'name'}",
5723                                              %base_key)},
5724                               "tree");
5725                 if (defined $hash_base) {
5726                         print $barsep .
5727                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5728                                                      file_name=>"$basedir$t->{'name'}")},
5729                                       "history");
5730                 }
5731                 print "</td>\n";
5732         } else {
5733                 # unknown object: we can only present history for it
5734                 # (this includes 'commit' object, i.e. submodule support)
5735                 print "<td class=\"list\">" .
5736                       esc_path($t->{'name'}) .
5737                       "</td>\n";
5738                 print "<td class=\"link\">";
5739                 if (defined $hash_base) {
5740                         print $cgi->a({-href => href(action=>"history",
5741                                                      hash_base=>$hash_base,
5742                                                      file_name=>"$basedir$t->{'name'}")},
5743                                       "history");
5744                 }
5745                 print "</td>\n";
5746         }
5747 }
5748
5749 ## ......................................................................
5750 ## functions printing large fragments of HTML
5751
5752 # get pre-image filenames for merge (combined) diff
5753 sub fill_from_file_info {
5754         my ($diff, @parents) = @_;
5755
5756         $diff->{'from_file'} = [ ];
5757         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5758         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5759                 if ($diff->{'status'}[$i] eq 'R' ||
5760                     $diff->{'status'}[$i] eq 'C') {
5761                         $diff->{'from_file'}[$i] =
5762                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5763                 }
5764         }
5765
5766         return $diff;
5767 }
5768
5769 # is current raw difftree line of file deletion
5770 sub is_deleted {
5771         my $diffinfo = shift;
5772
5773         return $diffinfo->{'to_id'} eq ('0' x 40);
5774 }
5775
5776 # does patch correspond to [previous] difftree raw line
5777 # $diffinfo  - hashref of parsed raw diff format
5778 # $patchinfo - hashref of parsed patch diff format
5779 #              (the same keys as in $diffinfo)
5780 sub is_patch_split {
5781         my ($diffinfo, $patchinfo) = @_;
5782
5783         return defined $diffinfo && defined $patchinfo
5784                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5785 }
5786
5787
5788 sub git_difftree_body {
5789         my ($difftree, $hash, @parents) = @_;
5790         my ($parent) = $parents[0];
5791         my $have_blame = gitweb_check_feature('blame');
5792         print "<div class=\"list_head\">\n";
5793         if ($#{$difftree} > 10) {
5794                 print(($#{$difftree} + 1) . " files changed:\n");
5795         }
5796         print "</div>\n";
5797
5798         print "<table class=\"" .
5799               (@parents > 1 ? "combined " : "") .
5800               "diff_tree\">\n";
5801
5802         # header only for combined diff in 'commitdiff' view
5803         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5804         if ($has_header) {
5805                 # table header
5806                 print "<thead><tr>\n" .
5807                        "<th></th><th></th>\n"; # filename, patchN link
5808                 for (my $i = 0; $i < @parents; $i++) {
5809                         my $par = $parents[$i];
5810                         print "<th>" .
5811                               $cgi->a({-href => href(action=>"commitdiff",
5812                                                      hash=>$hash, hash_parent=>$par),
5813                                        -title => 'commitdiff to parent number ' .
5814                                                   ($i+1) . ': ' . substr($par,0,7)},
5815                                       $i+1) .
5816                               "&#160;</th>\n";
5817                 }
5818                 print "</tr></thead>\n<tbody>\n";
5819         }
5820
5821         my $alternate = 1;
5822         my $patchno = 0;
5823         foreach my $line (@{$difftree}) {
5824                 my $diff = parsed_difftree_line($line);
5825
5826                 if ($alternate) {
5827                         print "<tr class=\"dark\">\n";
5828                 } else {
5829                         print "<tr class=\"light\">\n";
5830                 }
5831                 $alternate ^= 1;
5832
5833                 if (exists $diff->{'nparents'}) { # combined diff
5834
5835                         fill_from_file_info($diff, @parents)
5836                                 unless exists $diff->{'from_file'};
5837
5838                         if (!is_deleted($diff)) {
5839                                 # file exists in the result (child) commit
5840                                 print "<td>" .
5841                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5842                                                              file_name=>$diff->{'to_file'},
5843                                                              hash_base=>$hash),
5844                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5845                                       "</td>\n";
5846                         } else {
5847                                 print "<td>" .
5848                                       esc_path($diff->{'to_file'}) .
5849                                       "</td>\n";
5850                         }
5851
5852                         if ($action eq 'commitdiff') {
5853                                 # link to patch
5854                                 $patchno++;
5855                                 print "<td class=\"link\">" .
5856                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5857                                               "patch") .
5858                                       $barsep .
5859                                       "</td>\n";
5860                         }
5861
5862                         my $has_history = 0;
5863                         my $not_deleted = 0;
5864                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5865                                 my $hash_parent = $parents[$i];
5866                                 my $from_hash = $diff->{'from_id'}[$i];
5867                                 my $from_path = $diff->{'from_file'}[$i];
5868                                 my $status = $diff->{'status'}[$i];
5869
5870                                 $has_history ||= ($status ne 'A');
5871                                 $not_deleted ||= ($status ne 'D');
5872
5873                                 if ($status eq 'A') {
5874                                         print "<td  class=\"link\" align=\"right\">$barsep</td>\n";
5875                                 } elsif ($status eq 'D') {
5876                                         print "<td class=\"link\">" .
5877                                               $cgi->a({-href => href(action=>"blob",
5878                                                                      hash_base=>$hash,
5879                                                                      hash=>$from_hash,
5880                                                                      file_name=>$from_path)},
5881                                                       "blob" . ($i+1)) .
5882                                               "$barsep</td>\n";
5883                                 } else {
5884                                         if ($diff->{'to_id'} eq $from_hash) {
5885                                                 print "<td class=\"link nochange\">";
5886                                         } else {
5887                                                 print "<td class=\"link\">";
5888                                         }
5889                                         print $cgi->a({-href => href(action=>"blobdiff",
5890                                                                      hash=>$diff->{'to_id'},
5891                                                                      hash_parent=>$from_hash,
5892                                                                      hash_base=>$hash,
5893                                                                      hash_parent_base=>$hash_parent,
5894                                                                      file_name=>$diff->{'to_file'},
5895                                                                      file_parent=>$from_path)},
5896                                                       "diff" . ($i+1)) .
5897                                               "$barsep</td>\n";
5898                                 }
5899                         }
5900
5901                         print "<td class=\"link\">";
5902                         if ($not_deleted) {
5903                                 print $cgi->a({-href => href(action=>"blob",
5904                                                              hash=>$diff->{'to_id'},
5905                                                              file_name=>$diff->{'to_file'},
5906                                                              hash_base=>$hash)},
5907                                               "blob");
5908                                 print $barsep if ($has_history);
5909                         }
5910                         if ($has_history) {
5911                                 print $cgi->a({-href => href(action=>"history",
5912                                                              file_name=>$diff->{'to_file'},
5913                                                              hash_base=>$hash)},
5914                                               "history");
5915                         }
5916                         print "</td>\n";
5917
5918                         print "</tr>\n";
5919                         next; # instead of 'else' clause, to avoid extra indent
5920                 }
5921                 # else ordinary diff
5922
5923                 my ($to_mode_oct, $to_mode_str, $to_file_type);
5924                 my ($from_mode_oct, $from_mode_str, $from_file_type);
5925                 if ($diff->{'to_mode'} ne ('0' x 6)) {
5926                         $to_mode_oct = oct $diff->{'to_mode'};
5927                         if (S_ISREG($to_mode_oct)) { # only for regular file
5928                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
5929                         }
5930                         $to_file_type = file_type($diff->{'to_mode'});
5931                 }
5932                 if ($diff->{'from_mode'} ne ('0' x 6)) {
5933                         $from_mode_oct = oct $diff->{'from_mode'};
5934                         if (S_ISREG($from_mode_oct)) { # only for regular file
5935                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
5936                         }
5937                         $from_file_type = file_type($diff->{'from_mode'});
5938                 }
5939
5940                 if ($diff->{'status'} eq "A") { # created
5941                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
5942                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
5943                         $mode_chng   .= "]</span>";
5944                         print "<td>";
5945                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5946                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5947                                       -class => "list"}, esc_path($diff->{'file'}));
5948                         print "</td>\n";
5949                         print "<td>$mode_chng</td>\n";
5950                         print "<td class=\"link\">";
5951                         if ($action eq 'commitdiff') {
5952                                 # link to patch
5953                                 $patchno++;
5954                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5955                                               "patch") .
5956                                       $barsep;
5957                         }
5958                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5959                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5960                                       "blob");
5961                         print "</td>\n";
5962
5963                 } elsif ($diff->{'status'} eq "D") { # deleted
5964                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5965                         print "<td>";
5966                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5967                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
5968                                        -class => "list"}, esc_path($diff->{'file'}));
5969                         print "</td>\n";
5970                         print "<td>$mode_chng</td>\n";
5971                         print "<td class=\"link\">";
5972                         if ($action eq 'commitdiff') {
5973                                 # link to patch
5974                                 $patchno++;
5975                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5976                                               "patch") .
5977                                       $barsep;
5978                         }
5979                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5980                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
5981                                       "blob") . $barsep;
5982                         if ($have_blame) {
5983                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5984                                                              file_name=>$diff->{'file'}),
5985                                               -class => "blamelink"},
5986                                               "blame") . $barsep;
5987                         }
5988                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5989                                                      file_name=>$diff->{'file'})},
5990                                       "history");
5991                         print "</td>\n";
5992
5993                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5994                         my $mode_chnge = "";
5995                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5996                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5997                                 if ($from_file_type ne $to_file_type) {
5998                                         $mode_chnge .= " from $from_file_type to $to_file_type";
5999                                 }
6000                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
6001                                         if ($from_mode_str && $to_mode_str) {
6002                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
6003                                         } elsif ($to_mode_str) {
6004                                                 $mode_chnge .= " mode: $to_mode_str";
6005                                         }
6006                                 }
6007                                 $mode_chnge .= "]</span>\n";
6008                         }
6009                         print "<td>";
6010                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6011                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
6012                                       -class => "list"}, esc_path($diff->{'file'}));
6013                         print "</td>\n";
6014                         print "<td>$mode_chnge</td>\n";
6015                         print "<td class=\"link\">";
6016                         if ($action eq 'commitdiff') {
6017                                 # link to patch
6018                                 $patchno++;
6019                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6020                                               "patch") .
6021                                       $barsep;
6022                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6023                                 # "commit" view and modified file (not onlu mode changed)
6024                                 print $cgi->a({-href => href(action=>"blobdiff",
6025                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6026                                                              hash_base=>$hash, hash_parent_base=>$parent,
6027                                                              file_name=>$diff->{'file'})},
6028                                               "diff") .
6029                                       $barsep;
6030                         }
6031                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6032                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
6033                                        "blob") . $barsep;
6034                         if ($have_blame) {
6035                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6036                                                              file_name=>$diff->{'file'}),
6037                                               -class => "blamelink"},
6038                                               "blame") . $barsep;
6039                         }
6040                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6041                                                      file_name=>$diff->{'file'})},
6042                                       "history");
6043                         print "</td>\n";
6044
6045                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
6046                         my %status_name = ('R' => 'moved', 'C' => 'copied');
6047                         my $nstatus = $status_name{$diff->{'status'}};
6048                         my $mode_chng = "";
6049                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
6050                                 # mode also for directories, so we cannot use $to_mode_str
6051                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
6052                         }
6053                         print "<td>" .
6054                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
6055                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
6056                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
6057                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
6058                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
6059                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
6060                                       -class => "list"}, esc_path($diff->{'from_file'})) .
6061                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
6062                               "<td class=\"link\">";
6063                         if ($action eq 'commitdiff') {
6064                                 # link to patch
6065                                 $patchno++;
6066                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
6067                                               "patch") .
6068                                       $barsep;
6069                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
6070                                 # "commit" view and modified file (not only pure rename or copy)
6071                                 print $cgi->a({-href => href(action=>"blobdiff",
6072                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
6073                                                              hash_base=>$hash, hash_parent_base=>$parent,
6074                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
6075                                               "diff") .
6076                                       $barsep;
6077                         }
6078                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
6079                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
6080                                       "blob") . $barsep;
6081                         if ($have_blame) {
6082                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
6083                                                              file_name=>$diff->{'to_file'}),
6084                                               -class => "blamelink"},
6085                                               "blame") . $barsep;
6086                         }
6087                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
6088                                                     file_name=>$diff->{'to_file'})},
6089                                       "history");
6090                         print "</td>\n";
6091
6092                 } # we should not encounter Unmerged (U) or Unknown (X) status
6093                 print "</tr>\n";
6094         }
6095         print "</tbody>" if $has_header;
6096         print "</table>\n";
6097 }
6098
6099 # Print context lines and then rem/add lines in a side-by-side manner.
6100 sub print_sidebyside_diff_lines {
6101         my ($ctx, $rem, $add) = @_;
6102
6103         # print context block before add/rem block
6104         if (@$ctx) {
6105                 print join '',
6106                         '<div class="chunk_block ctx">',
6107                                 '<div class="old">',
6108                                 @$ctx,
6109                                 '</div>',
6110                                 '<div class="new">',
6111                                 @$ctx,
6112                                 '</div>',
6113                         '</div>';
6114         }
6115
6116         if (!@$add) {
6117                 # pure removal
6118                 print join '',
6119                         '<div class="chunk_block rem">',
6120                                 '<div class="old">',
6121                                 @$rem,
6122                                 '</div>',
6123                         '</div>';
6124         } elsif (!@$rem) {
6125                 # pure addition
6126                 print join '',
6127                         '<div class="chunk_block add">',
6128                                 '<div class="new">',
6129                                 @$add,
6130                                 '</div>',
6131                         '</div>';
6132         } else {
6133                 print join '',
6134                         '<div class="chunk_block chg">',
6135                                 '<div class="old">',
6136                                 @$rem,
6137                                 '</div>',
6138                                 '<div class="new">',
6139                                 @$add,
6140                                 '</div>',
6141                         '</div>';
6142         }
6143 }
6144
6145 # Print context lines and then rem/add lines in inline manner.
6146 sub print_inline_diff_lines {
6147         my ($ctx, $rem, $add) = @_;
6148
6149         print @$ctx, @$rem, @$add;
6150 }
6151
6152 # Format removed and added line, mark changed part and HTML-format them.
6153 # Implementation is based on contrib/diff-highlight
6154 sub format_rem_add_lines_pair {
6155         my ($rem, $add, $num_parents) = @_;
6156
6157         # We need to untabify lines before split()'ing them;
6158         # otherwise offsets would be invalid.
6159         chomp $rem;
6160         chomp $add;
6161         $rem = untabify($rem);
6162         $add = untabify($add);
6163
6164         my @rem = split(//, $rem);
6165         my @add = split(//, $add);
6166         my ($esc_rem, $esc_add);
6167         # Ignore leading +/- characters for each parent.
6168         my ($prefix_len, $suffix_len) = ($num_parents, 0);
6169         my ($prefix_has_nonspace, $suffix_has_nonspace);
6170
6171         my $shorter = (@rem < @add) ? @rem : @add;
6172         while ($prefix_len < $shorter) {
6173                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
6174
6175                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
6176                 $prefix_len++;
6177         }
6178
6179         while ($prefix_len + $suffix_len < $shorter) {
6180                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
6181
6182                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
6183                 $suffix_len++;
6184         }
6185
6186         # Mark lines that are different from each other, but have some common
6187         # part that isn't whitespace.  If lines are completely different, don't
6188         # mark them because that would make output unreadable, especially if
6189         # diff consists of multiple lines.
6190         if ($prefix_has_nonspace || $suffix_has_nonspace) {
6191                 $esc_rem = esc_html_hl_regions($rem, 'marked',
6192                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
6193                 $esc_add = esc_html_hl_regions($add, 'marked',
6194                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
6195         } else {
6196                 $esc_rem = esc_html($rem, -nbsp=>1);
6197                 $esc_add = esc_html($add, -nbsp=>1);
6198         }
6199
6200         return format_diff_line(\$esc_rem, 'rem'),
6201                format_diff_line(\$esc_add, 'add');
6202 }
6203
6204 # HTML-format diff context, removed and added lines.
6205 sub format_ctx_rem_add_lines {
6206         my ($ctx, $rem, $add, $num_parents) = @_;
6207         my (@new_ctx, @new_rem, @new_add);
6208         my $can_highlight = 0;
6209         my $is_combined = ($num_parents > 1);
6210
6211         # Highlight if every removed line has a corresponding added line.
6212         if (@$add > 0 && @$add == @$rem) {
6213                 $can_highlight = 1;
6214
6215                 # Highlight lines in combined diff only if the chunk contains
6216                 # diff between the same version, e.g.
6217                 #
6218                 #    - a
6219                 #   -  b
6220                 #    + c
6221                 #   +  d
6222                 #
6223                 # Otherwise the highlightling would be confusing.
6224                 if ($is_combined) {
6225                         for (my $i = 0; $i < @$add; $i++) {
6226                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
6227                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
6228
6229                                 $prefix_rem =~ s/-/+/g;
6230
6231                                 if ($prefix_rem ne $prefix_add) {
6232                                         $can_highlight = 0;
6233                                         last;
6234                                 }
6235                         }
6236                 }
6237         }
6238
6239         if ($can_highlight) {
6240                 for (my $i = 0; $i < @$add; $i++) {
6241                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
6242                                 $rem->[$i], $add->[$i], $num_parents);
6243                         push @new_rem, $line_rem;
6244                         push @new_add, $line_add;
6245                 }
6246         } else {
6247                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
6248                 @new_add = map { format_diff_line($_, 'add') } @$add;
6249         }
6250
6251         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
6252
6253         return (\@new_ctx, \@new_rem, \@new_add);
6254 }
6255
6256 # Print context lines and then rem/add lines.
6257 sub print_diff_lines {
6258         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
6259         my $is_combined = $num_parents > 1;
6260
6261         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
6262                 $num_parents);
6263
6264         if ($diff_style eq 'sidebyside' && !$is_combined) {
6265                 print_sidebyside_diff_lines($ctx, $rem, $add);
6266         } else {
6267                 # default 'inline' style and unknown styles
6268                 print_inline_diff_lines($ctx, $rem, $add);
6269         }
6270 }
6271
6272 sub print_diff_chunk {
6273         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
6274         my (@ctx, @rem, @add);
6275
6276         # The class of the previous line.
6277         my $prev_class = '';
6278
6279         return unless @chunk;
6280
6281         # incomplete last line might be among removed or added lines,
6282         # or both, or among context lines: find which
6283         for (my $i = 1; $i < @chunk; $i++) {
6284                 if ($chunk[$i][0] eq 'incomplete') {
6285                         $chunk[$i][0] = $chunk[$i-1][0];
6286                 }
6287         }
6288
6289         # guardian
6290         push @chunk, ["", ""];
6291
6292         foreach my $line_info (@chunk) {
6293                 my ($class, $line) = @$line_info;
6294
6295                 # print chunk headers
6296                 if ($class && $class eq 'chunk_header') {
6297                         print format_diff_line($line, $class, $from, $to);
6298                         next;
6299                 }
6300
6301                 ## print from accumulator when have some add/rem lines or end
6302                 # of chunk (flush context lines), or when have add and rem
6303                 # lines and new block is reached (otherwise add/rem lines could
6304                 # be reordered)
6305                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
6306                     (@rem && @add && $class ne $prev_class)) {
6307                         print_diff_lines(\@ctx, \@rem, \@add,
6308                                          $diff_style, $num_parents);
6309                         @ctx = @rem = @add = ();
6310                 }
6311
6312                 ## adding lines to accumulator
6313                 # guardian value
6314                 last unless $line;
6315                 # rem, add or change
6316                 if ($class eq 'rem') {
6317                         push @rem, $line;
6318                 } elsif ($class eq 'add') {
6319                         push @add, $line;
6320                 }
6321                 # context line
6322                 if ($class eq 'ctx') {
6323                         push @ctx, $line;
6324                 }
6325
6326                 $prev_class = $class;
6327         }
6328 }
6329
6330 sub git_patchset_body {
6331         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
6332         my ($hash_parent) = $hash_parents[0];
6333
6334         my $is_combined = (@hash_parents > 1);
6335         my $patch_idx = 0;
6336         my $patch_number = 0;
6337         my $patch_line;
6338         my $diffinfo;
6339         my $to_name;
6340         my (%from, %to);
6341         my @chunk; # for side-by-side diff
6342
6343         print "<div class=\"patchset\">\n";
6344
6345         # skip to first patch
6346         while ($patch_line = to_utf8(scalar <$fd>)) {
6347                 chomp $patch_line;
6348
6349                 last if ($patch_line =~ m/^diff /);
6350         }
6351
6352  PATCH:
6353         while ($patch_line) {
6354
6355                 # parse "git diff" header line
6356                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
6357                         # $1 is from_name, which we do not use
6358                         $to_name = unquote($2);
6359                         $to_name =~ s!^b/!!;
6360                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
6361                         # $1 is 'cc' or 'combined', which we do not use
6362                         $to_name = unquote($2);
6363                 } else {
6364                         $to_name = undef;
6365                 }
6366
6367                 # check if current patch belong to current raw line
6368                 # and parse raw git-diff line if needed
6369                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
6370                         # this is continuation of a split patch
6371                         print "<div class=\"patch cont\">\n";
6372                 } else {
6373                         # advance raw git-diff output if needed
6374                         $patch_idx++ if defined $diffinfo;
6375
6376                         # read and prepare patch information
6377                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6378
6379                         # compact combined diff output can have some patches skipped
6380                         # find which patch (using pathname of result) we are at now;
6381                         if ($is_combined) {
6382                                 while ($to_name ne $diffinfo->{'to_file'}) {
6383                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6384                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
6385                                               "</div>\n";  # class="patch"
6386
6387                                         $patch_idx++;
6388                                         $patch_number++;
6389
6390                                         last if $patch_idx > $#$difftree;
6391                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6392                                 }
6393                         }
6394
6395                         # modifies %from, %to hashes
6396                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
6397
6398                         # this is first patch for raw difftree line with $patch_idx index
6399                         # we index @$difftree array from 0, but number patches from 1
6400                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
6401                 }
6402
6403                 # git diff header
6404                 #assert($patch_line =~ m/^diff /) if DEBUG;
6405                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
6406                 $patch_number++;
6407                 # print "git diff" header
6408                 print format_git_diff_header_line($patch_line, $diffinfo,
6409                                                   \%from, \%to);
6410
6411                 # print extended diff header
6412                 print "<div class=\"diff extended_header\">\n";
6413         EXTENDED_HEADER:
6414                 while ($patch_line = to_utf8(scalar<$fd>)) {
6415                         chomp $patch_line;
6416
6417                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
6418
6419                         print format_extended_diff_header_line($patch_line, $diffinfo,
6420                                                                \%from, \%to);
6421                 }
6422                 print "</div>\n"; # class="diff extended_header"
6423
6424                 # from-file/to-file diff header
6425                 if (! $patch_line) {
6426                         print "</div>\n"; # class="patch"
6427                         last PATCH;
6428                 }
6429                 next PATCH if ($patch_line =~ m/^diff /);
6430                 #assert($patch_line =~ m/^---/) if DEBUG;
6431
6432                 my $last_patch_line = $patch_line;
6433                 $patch_line = to_utf8(scalar <$fd>);
6434                 chomp $patch_line;
6435                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
6436
6437                 print format_diff_from_to_header($last_patch_line, $patch_line,
6438                                                  $diffinfo, \%from, \%to,
6439                                                  @hash_parents);
6440
6441                 # the patch itself
6442         LINE:
6443                 while ($patch_line = to_utf8(scalar <$fd>)) {
6444                         chomp $patch_line;
6445
6446                         next PATCH if ($patch_line =~ m/^diff /);
6447
6448                         my $class = diff_line_class($patch_line, \%from, \%to);
6449
6450                         if ($class eq 'chunk_header') {
6451                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6452                                 @chunk = ();
6453                         }
6454
6455                         push @chunk, [ $class, $patch_line ];
6456                 }
6457
6458         } continue {
6459                 if (@chunk) {
6460                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
6461                         @chunk = ();
6462                 }
6463                 print "</div>\n"; # class="patch"
6464         }
6465
6466         # for compact combined (--cc) format, with chunk and patch simplification
6467         # the patchset might be empty, but there might be unprocessed raw lines
6468         for (++$patch_idx if $patch_number > 0;
6469              $patch_idx < @$difftree;
6470              ++$patch_idx) {
6471                 # read and prepare patch information
6472                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
6473
6474                 # generate anchor for "patch" links in difftree / whatchanged part
6475                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
6476                       format_diff_cc_simplified($diffinfo, @hash_parents) .
6477                       "</div>\n";  # class="patch"
6478
6479                 $patch_number++;
6480         }
6481
6482         if ($patch_number == 0) {
6483                 if (@hash_parents > 1) {
6484                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
6485                 } else {
6486                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
6487                 }
6488         }
6489
6490         print "</div>\n"; # class="patchset"
6491 }
6492
6493 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6494
6495 sub git_project_search_form {
6496         my ($searchtext, $search_use_regexp) = @_;
6497
6498         my $limit = '';
6499         if ($project_filter) {
6500                 $limit = " in '$project_filter'";
6501         }
6502
6503         print "<div class=\"projsearch\">\n";
6504         print $cgi->start_form(-method => 'get', -action => $my_uri) .
6505               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
6506         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
6507                 if (defined $project_filter);
6508         print $cgi->textfield(-name => 's', -value => $searchtext,
6509                               -title => "Search project by name and description$limit",
6510                               -size => 60) . "\n" .
6511               "<span title=\"Extended regular expression\">" .
6512               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
6513                              -checked => $search_use_regexp) .
6514               "</span>\n" .
6515               $cgi->submit(-name => 'btnS', -value => 'Search') .
6516               $cgi->end_form() . "\n" .
6517               "<span class=\"projectlist_link\">" .
6518               $cgi->a({-href => href(project => undef, searchtext => undef,
6519                                      action => 'project_list',
6520                                      project_filter => $project_filter)},
6521                       esc_html("List all projects$limit")) . "</span><br />\n";
6522         print "<span class=\"projectlist_link\">" .
6523               $cgi->a({-href => href(project => undef, searchtext => undef,
6524                                      action => 'project_list',
6525                                      project_filter => undef)},
6526                       esc_html("List all projects")) . "</span>\n" if $project_filter;
6527         print "</div>\n";
6528 }
6529
6530 # entry for given @keys needs filling if at least one of keys in list
6531 # is not present in %$project_info
6532 sub project_info_needs_filling {
6533         my ($project_info, @keys) = @_;
6534
6535         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
6536         foreach my $key (@keys) {
6537                 if (!exists $project_info->{$key}) {
6538                         return 1;
6539                 }
6540         }
6541         return;
6542 }
6543
6544 sub git_cache_file_format {
6545         return GITWEB_CACHE_FORMAT .
6546                 (gitweb_check_feature('forks') ? " (forks)" : "");
6547 }
6548
6549 sub git_retrieve_cache_file {
6550         my $cache_file = shift;
6551
6552         use Storable qw(retrieve);
6553
6554         if ((my $dump = eval { retrieve($cache_file) })) {
6555                 return $$dump[1] if
6556                         ref($dump) eq 'ARRAY' &&
6557                         @$dump == 2 &&
6558                         ref($$dump[1]) eq 'ARRAY' &&
6559                         @{$$dump[1]} == 2 &&
6560                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
6561                         ref(${$$dump[1]}[1]) eq 'HASH' &&
6562                         $$dump[0] eq git_cache_file_format();
6563         }
6564
6565         return undef;
6566 }
6567
6568 sub git_store_cache_file {
6569         my ($cache_file, $cachedata) = @_;
6570
6571         use File::Basename qw(dirname);
6572         use File::stat;
6573         use POSIX qw(:fcntl_h);
6574         use Storable qw(store_fd);
6575
6576         my $result = undef;
6577         my $cache_d = dirname($cache_file);
6578         my $mask = umask();
6579         umask($mask & ~0070) if $cache_grpshared;
6580         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6581             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6582                 store_fd([git_cache_file_format(), $cachedata], $fd);
6583                 close $fd;
6584                 rename "$cache_file.lock", $cache_file;
6585                 $result = stat($cache_file)->mtime;
6586         }
6587         umask($mask) if $cache_grpshared;
6588         return $result;
6589 }
6590
6591 sub verify_cached_project {
6592         my ($hashref, $path) = @_;
6593         return undef unless $path;
6594         delete $$hashref{$path}, return undef unless is_valid_project($path);
6595         return $$hashref{$path} if exists $$hashref{$path};
6596
6597         # A valid project was requested but it's not yet in the cache
6598         # Manufacture a minimal project entry (path, name, description)
6599         # Also provide age, but only if it's available via $lastactivity_file
6600
6601         my %proj = ('path' => $path);
6602         my $val = git_get_project_description($path);
6603         defined $val or $val = '';
6604         $proj{'descr_long'} = $val;
6605         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6606         unless ($omit_owner) {
6607                 $val = git_get_project_owner($path);
6608                 defined $val or $val = '';
6609                 $proj{'owner'} = $val;
6610         }
6611         unless ($omit_age_column) {
6612                 ($val) = git_get_last_activity($path, 1);
6613                 $proj{'age_epoch'} = $val if defined $val;
6614         }
6615         $$hashref{$path} = \%proj;
6616         return \%proj;
6617 }
6618
6619 sub git_filter_cached_projects {
6620         my ($cache, $projlist, $verify) = @_;
6621         my $hashref = $$cache[1];
6622         my $sub = $verify ?
6623                 sub {verify_cached_project($hashref, $_[0])} :
6624                 sub {$$hashref{$_[0]}};
6625         return map {
6626                 my $c = &$sub($_->{'path'});
6627                 defined $c ? ($_ = $c) : ()
6628         } @$projlist;
6629 }
6630
6631 # fills project list info (age, description, owner, category, forks, etc.)
6632 # for each project in the list, removing invalid projects from
6633 # returned list, or fill only specified info.
6634 #
6635 # Invalid projects are removed from the returned list if and only if you
6636 # ask 'age_epoch' to be filled, because they are the only fields
6637 # that run unconditionally git command that requires repository, and
6638 # therefore do always check if project repository is invalid.
6639 #
6640 # USAGE:
6641 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6642 #   ensures that 'descr_long' and 'ctags' fields are filled
6643 # * @project_list = fill_project_list_info(\@project_list)
6644 #   ensures that all fields are filled (and invalid projects removed)
6645 #
6646 # NOTE: modifies $projlist, but does not remove entries from it
6647 sub fill_project_list_info {
6648         my ($projlist, @wanted_keys) = @_;
6649
6650         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6651         return fill_project_list_info_uncached($projlist, @wanted_keys)
6652                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6653
6654         use File::stat;
6655
6656         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6657         my $cache_file = "$cache_dir/$projlist_cache_name";
6658
6659         my @projects;
6660         my $stale = 0;
6661         my $now = time();
6662         my $cache_mtime;
6663         if ($cache_lifetime && -f $cache_file) {
6664                 $cache_mtime = stat($cache_file)->mtime;
6665                 $cache_dump = undef if $cache_mtime &&
6666                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6667         }
6668         if (defined $cache_mtime && # caching is on and $cache_file exists
6669             $cache_mtime + $cache_lifetime*60 > $now &&
6670             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6671                 # Cache hit.
6672                 $cache_dump_mtime = $cache_mtime;
6673                 $stale = $now - $cache_mtime;
6674                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6675                         gitweb_check_feature('forks');
6676                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6677
6678         } else { # Cache miss.
6679                 if (defined $cache_mtime) {
6680                         # Postpone timeout by two minutes so that we get
6681                         # enough time to do our job, or to be more exact
6682                         # make cache expire after two minutes from now.
6683                         my $time = $now - $cache_lifetime*60 + 120;
6684                         utime $time, $time, $cache_file;
6685                 }
6686                 my @all_projects = git_get_projects_list();
6687                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6688                         fill_project_list_info_uncached(\@all_projects);
6689                 map { $all_projects_filled{$_->{'path'}} = $_ }
6690                         filter_forks_from_projects_list([values(%all_projects_filled)])
6691                         if gitweb_check_feature('forks');
6692                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6693                                \%all_projects_filled];
6694                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6695                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6696         }
6697
6698         if ($cache_lifetime && $stale > 0) {
6699                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6700                         unless $shown_stale_message;
6701                 $shown_stale_message = 1;
6702         }
6703
6704         return @projects;
6705 }
6706
6707 sub fill_project_list_info_uncached {
6708         my ($projlist, @wanted_keys) = @_;
6709         my @projects;
6710         my $filter_set = sub { return @_; };
6711         if (@wanted_keys) {
6712                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6713                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6714         }
6715
6716         my $show_ctags = gitweb_check_feature('ctags');
6717  PROJECT:
6718         foreach my $pr (@$projlist) {
6719                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6720                         my (@activity) = git_get_last_activity($pr->{'path'});
6721                         unless (@activity) {
6722                                 next PROJECT;
6723                         }
6724                         ($pr->{'age_epoch'}) = @activity;
6725                 }
6726                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6727                         my $descr = git_get_project_description($pr->{'path'}) || "";
6728                         $descr = to_utf8($descr);
6729                         $pr->{'descr_long'} = $descr;
6730                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6731                 }
6732                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6733                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6734                 }
6735                 if ($show_ctags &&
6736                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6737                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6738                 }
6739                 if ($projects_list_group_categories &&
6740                     project_info_needs_filling($pr, $filter_set->('category'))) {
6741                         my $cat = git_get_project_category($pr->{'path'}) ||
6742                                                            $project_list_default_category;
6743                         $pr->{'category'} = to_utf8($cat);
6744                 }
6745
6746                 push @projects, $pr;
6747         }
6748
6749         return @projects;
6750 }
6751
6752 sub sort_projects_list {
6753         my ($projlist, $order) = @_;
6754
6755         sub order_str {
6756                 my $key = shift;
6757                 return sub { lc($a->{$key}) cmp lc($b->{$key}) };
6758         }
6759
6760         sub order_reverse_num_then_undef {
6761                 my $key = shift;
6762                 return sub {
6763                         defined $a->{$key} ?
6764                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6765                                 (defined $b->{$key} ? 1 : 0)
6766                 };
6767         }
6768
6769         my %orderings = (
6770                 project => order_str('path'),
6771                 descr => order_str('descr_long'),
6772                 owner => order_str('owner'),
6773                 age => order_reverse_num_then_undef('age_epoch'),
6774         );
6775
6776         my $ordering = $orderings{$order};
6777         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6778 }
6779
6780 # returns a hash of categories, containing the list of project
6781 # belonging to each category
6782 sub build_projlist_by_category {
6783         my ($projlist, $from, $to) = @_;
6784         my %categories;
6785
6786         $from = 0 unless defined $from;
6787         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6788
6789         for (my $i = $from; $i <= $to; $i++) {
6790                 my $pr = $projlist->[$i];
6791                 push @{$categories{ $pr->{'category'} }}, $pr;
6792         }
6793
6794         return wantarray ? %categories : \%categories;
6795 }
6796
6797 # print 'sort by' <th> element, generating 'sort by $name' replay link
6798 # if that order is not selected
6799 sub print_sort_th {
6800         print format_sort_th(@_);
6801 }
6802
6803 sub format_sort_th {
6804         my ($name, $order, $header) = @_;
6805         my $sort_th = "";
6806         $header ||= ucfirst($name);
6807
6808         if ($order eq $name) {
6809                 $sort_th .= "<th>$header</th>\n";
6810         } else {
6811                 $sort_th .= "<th>" .
6812                             $cgi->a({-href => href(-replay=>1, order=>$name),
6813                                      -class => "header"}, $header) .
6814                             "</th>\n";
6815         }
6816
6817         return $sort_th;
6818 }
6819
6820 sub git_project_list_rows {
6821         my ($projlist, $from, $to, $check_forks) = @_;
6822
6823         $from = 0 unless defined $from;
6824         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6825
6826         my $now = time;
6827         my $alternate = 1;
6828         for (my $i = $from; $i <= $to; $i++) {
6829                 my $pr = $projlist->[$i];
6830
6831                 if ($alternate) {
6832                         print "<tr class=\"dark\">\n";
6833                 } else {
6834                         print "<tr class=\"light\">\n";
6835                 }
6836                 $alternate ^= 1;
6837
6838                 if ($check_forks) {
6839                         print "<td>";
6840                         if ($pr->{'forks'}) {
6841                                 my $nforks = scalar @{$pr->{'forks'}};
6842                                 my $s = $nforks == 1 ? '' : 's';
6843                                 if ($nforks > 0) {
6844                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6845                                                        -title => "$nforks fork$s"}, "+");
6846                                 } else {
6847                                         print $cgi->span({-title => "$nforks fork$s"}, "+");
6848                                 }
6849                         }
6850                         print "</td>\n";
6851                 }
6852                 my $path = $pr->{'path'};
6853                 my $dotgit = $path =~ s/\.git$// ? '.git' : '';
6854                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6855                                         -class => "list"},
6856                                        esc_html_match_hl($path, $search_regexp).$dotgit) .
6857                       "</td>\n" .
6858                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6859                                         -class => "list",
6860                                         -title => $pr->{'descr_long'}},
6861                                         $search_regexp
6862                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6863                                                                     $pr->{'descr'}, $search_regexp)
6864                                         : esc_html($pr->{'descr'})) .
6865                       "</td>\n";
6866                 unless ($omit_owner) {
6867                         print "<td><i>" . ($owner_link_hook
6868                                           ? $cgi->a({-href => $owner_link_hook->($pr->{'owner'}), -class => "list"},
6869                                                     chop_and_escape_str($pr->{'owner'}, 15))
6870                                           : chop_and_escape_str($pr->{'owner'}, 15)) . "</i></td>\n";
6871                 }
6872                 unless ($omit_age_column) {
6873                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6874                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6875                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6876                 }
6877                 print"<td class=\"link\">" .
6878                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . $barsep .
6879                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "log") . $barsep .
6880                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6881                       ($pr->{'forks'} ? $barsep . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6882                       "</td>\n" .
6883                       "</tr>\n";
6884         }
6885 }
6886
6887 sub git_project_list_body {
6888         # actually uses global variable $project
6889         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action, $keep_top) = @_;
6890         my @projects = @$projlist;
6891
6892         my $check_forks = gitweb_check_feature('forks');
6893         my $show_ctags  = gitweb_check_feature('ctags');
6894         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6895         $check_forks = undef
6896                 if ($tagfilter || $search_regexp);
6897
6898         # filtering out forks before filling info allows us to do less work
6899         if ($check_forks) {
6900                 @projects = filter_forks_from_projects_list(\@projects);
6901                 push @projects, { 'path' => "$project_filter.git" }
6902                         if $project_filter && $keep_top && is_valid_project("$project_filter.git");
6903         }
6904         # search_projects_list pre-fills required info
6905         @projects = search_projects_list(\@projects,
6906                                          'search_regexp' => $search_regexp,
6907                                          'tagfilter'  => $tagfilter)
6908                 if ($tagfilter || $search_regexp);
6909         # fill the rest
6910         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6911         push @all_fields, 'age_epoch' unless($omit_age_column);
6912         push @all_fields, 'owner' unless($omit_owner);
6913         @projects = fill_project_list_info(\@projects, @all_fields);
6914
6915         $order ||= $default_projects_order;
6916         $from = 0 unless defined $from;
6917         $to = $#projects if (!defined $to || $#projects < $to);
6918
6919         # short circuit
6920         if ($from > $to) {
6921                 print "<center>\n".
6922                       "<b>No such projects found</b><br />\n".
6923                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
6924                       "</center>\n<br />\n";
6925                 return;
6926         }
6927
6928         @projects = sort_projects_list(\@projects, $order);
6929
6930         if ($show_ctags) {
6931                 my $ctags = git_gather_all_ctags(\@projects);
6932                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
6933                 print git_show_project_tagcloud($cloud, 64);
6934         }
6935
6936         print "<table class=\"project_list\">\n";
6937         unless ($no_header) {
6938                 print "<tr>\n";
6939                 if ($check_forks) {
6940                         print "<th></th>\n";
6941                 }
6942                 print_sort_th('project', $order, 'Project');
6943                 print_sort_th('descr', $order, 'Description');
6944                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
6945                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
6946                 print "<th></th>\n" . # for links
6947                       "</tr>\n";
6948         }
6949
6950         if ($projects_list_group_categories) {
6951                 # only display categories with projects in the $from-$to window
6952                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
6953                 my %categories = build_projlist_by_category(\@projects, $from, $to);
6954                 foreach my $cat (sort keys %categories) {
6955                         unless ($cat eq "") {
6956                                 print "<tr>\n";
6957                                 if ($check_forks) {
6958                                         print "<td></td>\n";
6959                                 }
6960                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
6961                                 print "</tr>\n";
6962                         }
6963
6964                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
6965                 }
6966         } else {
6967                 git_project_list_rows(\@projects, $from, $to, $check_forks);
6968         }
6969
6970         if (defined $extra) {
6971                 print "<tr class=\"extra\">\n";
6972                 if ($check_forks) {
6973                         print "<td></td>\n";
6974                 }
6975                 print "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
6976                       "</tr>\n";
6977         }
6978         print "</table>\n";
6979 }
6980
6981 sub git_log_body {
6982         # uses global variable $project
6983         my ($commitlist, $from, $to, $refs, $extra) = @_;
6984
6985         $from = 0 unless defined $from;
6986         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6987
6988         for (my $i = 0; $i <= $to; $i++) {
6989                 my %co = %{$commitlist->[$i]};
6990                 next if !%co;
6991                 my $commit = $co{'id'};
6992                 my $ref = format_ref_marker($refs, $commit);
6993                 git_print_header_div('commit',
6994                                "<span class=\"age\">$co{'age_string'}</span>" .
6995                                esc_html($co{'title'}),
6996                                $commit, undef, $ref);
6997                 print "<div class=\"title_text\">\n" .
6998                       "<div class=\"log_link\">\n" .
6999                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
7000                       $barsep .
7001                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
7002                       $barsep .
7003                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
7004                       "<br/>\n" .
7005                       "</div>\n";
7006                       git_print_authorship(\%co, -tag => 'span');
7007                       print "<br/>\n</div>\n";
7008
7009                 print "<div class=\"log_body\">\n";
7010                 git_print_log($co{'comment'}, -final_empty_line=> 1);
7011                 print "</div>\n";
7012         }
7013         if ($extra) {
7014                 print "<div class=\"page_nav_trailer\">\n";
7015                 print "$extra\n";
7016                 print "</div>\n";
7017         }
7018 }
7019
7020 sub git_shortlog_body {
7021         # uses global variable $project
7022         my ($commitlist, $from, $to, $refs, $extra) = @_;
7023
7024         $from = 0 unless defined $from;
7025         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7026
7027         print "<table class=\"shortlog\">\n";
7028         my $alternate = 1;
7029         for (my $i = $from; $i <= $to; $i++) {
7030                 my %co = %{$commitlist->[$i]};
7031                 my $commit = $co{'id'};
7032                 my $ref = format_ref_marker($refs, $commit);
7033                 if ($alternate) {
7034                         print "<tr class=\"dark\">\n";
7035                 } else {
7036                         print "<tr class=\"light\">\n";
7037                 }
7038                 $alternate ^= 1;
7039                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
7040                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7041                       format_author_html('td', \%co, 10) . "<td>";
7042                 print format_subject_html($co{'title'}, $co{'title_short'},
7043                                           href(action=>"commit", hash=>$commit), $ref);
7044                 print "</td>\n" .
7045                       "<td class=\"link\">" .
7046                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . $barsep .
7047                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . $barsep .
7048                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
7049                 my $snapshot_links = format_snapshot_links($commit);
7050                 if (defined $snapshot_links) {
7051                         print $barsep . $snapshot_links;
7052                 }
7053                 print "</td>\n" .
7054                       "</tr>\n";
7055         }
7056         if (defined $extra) {
7057                 print "<tr class=\"extra\">\n" .
7058                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7059                       "</tr>\n";
7060         }
7061         print "</table>\n";
7062 }
7063
7064 sub git_history_body {
7065         # Warning: assumes constant type (blob or tree) during history
7066         my ($commitlist, $from, $to, $refs, $extra,
7067             $file_name, $file_hash, $ftype) = @_;
7068
7069         $from = 0 unless defined $from;
7070         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
7071
7072         print "<table class=\"history\">\n";
7073         my $alternate = 1;
7074         for (my $i = $from; $i <= $to; $i++) {
7075                 my %co = %{$commitlist->[$i]};
7076                 if (!%co) {
7077                         next;
7078                 }
7079                 my $commit = $co{'id'};
7080
7081                 my $ref = format_ref_marker($refs, $commit);
7082
7083                 if ($alternate) {
7084                         print "<tr class=\"dark\">\n";
7085                 } else {
7086                         print "<tr class=\"light\">\n";
7087                 }
7088                 $alternate ^= 1;
7089                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7090         # shortlog:   format_author_html('td', \%co, 10)
7091                       format_author_html('td', \%co, 15, 3) . "<td>";
7092                 # originally git_history used chop_str($co{'title'}, 50)
7093                 print format_subject_html($co{'title'}, $co{'title_short'},
7094                                           href(action=>"commit", hash=>$commit), $ref);
7095                 print "</td>\n" .
7096                       "<td class=\"link\">" .
7097                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . $barsep .
7098                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
7099
7100                 if ($ftype eq 'blob') {
7101                         my $blob_current = $file_hash;
7102                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
7103                         if (defined $blob_current && defined $blob_parent &&
7104                                         $blob_current ne $blob_parent) {
7105                                 print $barsep .
7106                                         $cgi->a({-href => href(action=>"blobdiff",
7107                                                                hash=>$blob_current, hash_parent=>$blob_parent,
7108                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
7109                                                                file_name=>$file_name)},
7110                                                 "diff to current");
7111                         }
7112                 }
7113                 print "</td>\n" .
7114                       "</tr>\n";
7115         }
7116         if (defined $extra) {
7117                 print "<tr class=\"extra\">\n" .
7118                       "<td colspan=\"4\" class=\"extra\">$extra</td>\n" .
7119                       "</tr>\n";
7120         }
7121         print "</table>\n";
7122 }
7123
7124 sub git_tags_body {
7125         # uses global variable $project
7126         my ($taglist, $from, $to, $extra, $head_at, $full, $order) = @_;
7127         $from = 0 unless defined $from;
7128         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
7129         $order ||= $default_refs_order;
7130
7131         print "<table class=\"tags\">\n";
7132         if ($full) {
7133                 print "<tr class=\"tags_header\">\n";
7134                 print_sort_th('age', $order, 'Last Change');
7135                 print_sort_th('name', $order, 'Name');
7136                 print "<th></th>\n" . # for comment
7137                       "<th></th>\n" . # for tag
7138                       "<th></th>\n" . # for links
7139                       "</tr>\n";
7140         }
7141         my $alternate = 1;
7142         for (my $i = $from; $i <= $to; $i++) {
7143                 my $entry = $taglist->[$i];
7144                 my %tag = %$entry;
7145                 my $comment = $tag{'subject'};
7146                 my $comment_short;
7147                 if (defined $comment) {
7148                         $comment_short = chop_str($comment, 30, 5);
7149                 }
7150                 my $curr = defined $head_at && $tag{'id'} eq $head_at;
7151                 if ($alternate) {
7152                         print "<tr class=\"dark\">\n";
7153                 } else {
7154                         print "<tr class=\"light\">\n";
7155                 }
7156                 $alternate ^= 1;
7157                 if (defined $tag{'age'}) {
7158                         print "<td><i>$tag{'age'}</i></td>\n";
7159                 } else {
7160                         print "<td></td>\n";
7161                 }
7162                 print(($curr ? "<td class=\"current_head\">" : "<td>") .
7163                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
7164                                -class => "list name"}, esc_html($tag{'name'})) .
7165                       "</td>\n" .
7166                       "<td>");
7167                 if (defined $comment) {
7168                         print format_subject_html($comment, $comment_short,
7169                                                   href(action=>"tag", hash=>$tag{'id'}));
7170                 }
7171                 print "</td>\n" .
7172                       "<td class=\"selflink\">";
7173                 if ($tag{'type'} eq "tag") {
7174                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
7175                 } else {
7176                         print "&#160;";
7177                 }
7178                 print "</td>\n" .
7179                       "<td class=\"link\">" . $barsep .
7180                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
7181                 if ($tag{'reftype'} eq "commit") {
7182                         print $barsep . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "log");
7183                         print $barsep . $cgi->a({-href => href(action=>"tree", hash=>$tag{'fullname'})}, "tree") if $full;
7184                 } elsif ($tag{'reftype'} eq "blob") {
7185                         print $barsep . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
7186                 }
7187                 print "</td>\n" .
7188                       "</tr>";
7189         }
7190         if (defined $extra) {
7191                 print "<tr class=\"extra\">\n" .
7192                       "<td colspan=\"5\" class=\"extra\">$extra</td>\n" .
7193                       "</tr>\n";
7194         }
7195         print "</table>\n";
7196 }
7197
7198 sub git_heads_body {
7199         # uses global variable $project
7200         my ($headlist, $head_at, $from, $to, $extra) = @_;
7201         $from = 0 unless defined $from;
7202         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
7203
7204         print "<table class=\"heads\">\n";
7205         my $alternate = 1;
7206         for (my $i = $from; $i <= $to; $i++) {
7207                 my $entry = $headlist->[$i];
7208                 my %ref = %$entry;
7209                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
7210                 if ($alternate) {
7211                         print "<tr class=\"dark\">\n";
7212                 } else {
7213                         print "<tr class=\"light\">\n";
7214                 }
7215                 $alternate ^= 1;
7216                 print "<td><i>$ref{'age'}</i></td>\n" .
7217                       ($curr ? "<td class=\"current_head\">" : "<td>") .
7218                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
7219                                -class => "list name"},esc_html($ref{'name'})) .
7220                       "</td>\n" .
7221                       "<td class=\"link\">" .
7222                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "log") . $barsep .
7223                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
7224                       "</td>\n" .
7225                       "</tr>";
7226         }
7227         if (defined $extra) {
7228                 print "<tr class=\"extra\">\n" .
7229                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7230                       "</tr>\n";
7231         }
7232         print "</table>\n";
7233 }
7234
7235 # Display a single remote block
7236 sub git_remote_block {
7237         my ($remote, $rdata, $limit, $head) = @_;
7238
7239         my $heads = $rdata->{'heads'};
7240         my $fetch = $rdata->{'fetch'};
7241         my $push = $rdata->{'push'};
7242
7243         my $urls_table = "<table class=\"projects_list\">\n" ;
7244
7245         if (defined $fetch) {
7246                 if ($fetch eq $push) {
7247                         $urls_table .= format_repo_url("URL", $fetch);
7248                 } else {
7249                         $urls_table .= format_repo_url("Fetch&#160;URL", $fetch);
7250                         $urls_table .= format_repo_url("Push&#160;URL", $push) if defined $push;
7251                 }
7252         } elsif (defined $push) {
7253                 $urls_table .= format_repo_url("Push&#160;URL", $push);
7254         } else {
7255                 $urls_table .= format_repo_url("", "No remote URL");
7256         }
7257
7258         $urls_table .= "</table>\n";
7259
7260         my $dots;
7261         if (defined $limit && $limit < @$heads) {
7262                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
7263         }
7264
7265         print $urls_table;
7266         git_heads_body($heads, $head, 0, $limit, $dots);
7267 }
7268
7269 # Display a list of remote names with the respective fetch and push URLs
7270 sub git_remotes_list {
7271         my ($remotedata, $limit) = @_;
7272         print "<table class=\"heads\">\n";
7273         my $alternate = 1;
7274         my @remotes = sort keys %$remotedata;
7275
7276         my $limited = $limit && $limit < @remotes;
7277
7278         $#remotes = $limit - 1 if $limited;
7279
7280         while (my $remote = shift @remotes) {
7281                 my $rdata = $remotedata->{$remote};
7282                 my $fetch = $rdata->{'fetch'};
7283                 my $push = $rdata->{'push'};
7284                 if ($alternate) {
7285                         print "<tr class=\"dark\">\n";
7286                 } else {
7287                         print "<tr class=\"light\">\n";
7288                 }
7289                 $alternate ^= 1;
7290                 print "<td>" .
7291                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
7292                                -class=> "list name"},esc_html($remote)) .
7293                       "</td>";
7294                 print "<td class=\"link\">" .
7295                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
7296                       $barsep .
7297                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
7298                       "</td>";
7299
7300                 print "</tr>\n";
7301         }
7302
7303         if ($limited) {
7304                 print "<tr>\n" .
7305                       "<td colspan=\"3\">" .
7306                       $cgi->a({-href => href(action=>"remotes")}, "...") .
7307                       "</td>\n" . "</tr>\n";
7308         }
7309
7310         print "</table>";
7311 }
7312
7313 # Display remote heads grouped by remote, unless there are too many
7314 # remotes, in which case we only display the remote names
7315 sub git_remotes_body {
7316         my ($remotedata, $limit, $head) = @_;
7317         if ($limit and $limit < keys %$remotedata) {
7318                 git_remotes_list($remotedata, $limit);
7319         } else {
7320                 fill_remote_heads($remotedata);
7321                 while (my ($remote, $rdata) = each %$remotedata) {
7322                         git_print_section({-class=>"remote", -id=>$remote},
7323                                 ["remotes", $remote, $remote], sub {
7324                                         git_remote_block($remote, $rdata, $limit, $head);
7325                                 });
7326                 }
7327         }
7328 }
7329
7330 sub git_search_message {
7331         my %co = @_;
7332
7333         my $greptype;
7334         if ($searchtype eq 'commit') {
7335                 $greptype = "--grep=";
7336         } elsif ($searchtype eq 'author') {
7337                 $greptype = "--author=";
7338         } elsif ($searchtype eq 'committer') {
7339                 $greptype = "--committer=";
7340         }
7341         $greptype .= $searchtext;
7342         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
7343                                        $greptype, '--regexp-ignore-case',
7344                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
7345
7346         my $paging_nav = "<span class=\"paging_nav\">";
7347         if ($page > 0) {
7348                 $paging_nav .= tabspan(
7349                         $cgi->a({-href => href(-replay=>1, page=>undef)},
7350                                 "first")) .
7351                         $mdotsep . tabspan(
7352                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
7353                                  -accesskey => "p", -title => "Alt-p"}, "prev"));
7354         } else {
7355                 $paging_nav .= tabspan("first", 1, 0).${mdotsep}.tabspan("prev", 0, 1);
7356         }
7357         my $next_link = '';
7358         if ($#commitlist >= 100) {
7359                 $next_link = tabspan(
7360                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
7361                                  -accesskey => "n", -title => "Alt-n"}, "next"));
7362                 $paging_nav .= "${mdotsep}$next_link";
7363         } else {
7364                 $paging_nav .= ${mdotsep}.tabspan("next", 0, 1);
7365         }
7366
7367         git_header_html();
7368
7369         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav."</span>");
7370         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7371         if ($page == 0 && !@commitlist) {
7372                 print "<p>No match.</p>\n";
7373         } else {
7374                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
7375         }
7376
7377         git_footer_html();
7378 }
7379
7380 sub git_search_changes {
7381         my %co = @_;
7382
7383         local $/ = "\n";
7384         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
7385                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
7386                 ($search_use_regexp ? '--pickaxe-regex' : ()))
7387                         or die_error(500, "Open git-log failed");
7388
7389         git_header_html();
7390
7391         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7392         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7393
7394         print "<table class=\"pickaxe search\">\n";
7395         my $alternate = 1;
7396         undef %co;
7397         my @files;
7398         while (my $line = to_utf8(scalar <$fd>)) {
7399                 chomp $line;
7400                 next unless $line;
7401
7402                 my %set = parse_difftree_raw_line($line);
7403                 if (defined $set{'commit'}) {
7404                         # finish previous commit
7405                         if (%co) {
7406                                 print "</td>\n" .
7407                                       "<td class=\"link\">" .
7408                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7409                                               "commit") .
7410                                       $barsep .
7411                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7412                                                              hash_base=>$co{'id'})},
7413                                               "tree") .
7414                                       "</td>\n" .
7415                                       "</tr>\n";
7416                         }
7417
7418                         if ($alternate) {
7419                                 print "<tr class=\"dark\">\n";
7420                         } else {
7421                                 print "<tr class=\"light\">\n";
7422                         }
7423                         $alternate ^= 1;
7424                         %co = parse_commit($set{'commit'});
7425                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
7426                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7427                               "<td><i>$author</i></td>\n" .
7428                               "<td>" .
7429                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7430                                       -class => "list subject"},
7431                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
7432                 } elsif (defined $set{'to_id'}) {
7433                         next if ($set{'to_id'} =~ m/^0{40}$/);
7434
7435                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
7436                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
7437                                       -class => "list"},
7438                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
7439                               "<br/>\n";
7440                 }
7441         }
7442         close $fd;
7443
7444         # finish last commit (warning: repetition!)
7445         if (%co) {
7446                 print "</td>\n" .
7447                       "<td class=\"link\">" .
7448                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
7449                               "commit") .
7450                       $barsep .
7451                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
7452                                              hash_base=>$co{'id'})},
7453                               "tree") .
7454                       "</td>\n" .
7455                       "</tr>\n";
7456         }
7457
7458         print "</table>\n";
7459
7460         git_footer_html();
7461 }
7462
7463 sub git_search_files {
7464         my %co = @_;
7465
7466         local $/ = "\n";
7467         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
7468                 $search_use_regexp ? ('-E', '-i') : '-F',
7469                 $searchtext, $co{'tree'})
7470                         or die_error(500, "Open git-grep failed");
7471
7472         git_header_html();
7473
7474         git_print_page_nav('','', $hash,$co{'tree'},$hash);
7475         git_print_header_div('commit', esc_html($co{'title'}), $hash);
7476
7477         print "<table class=\"grep_search\">\n";
7478         my $alternate = 1;
7479         my $matches = 0;
7480         my $lastfile = '';
7481         my $file_href;
7482         while (my $line = to_utf8(scalar <$fd>)) {
7483                 chomp $line;
7484                 my ($file, $lno, $ltext, $binary);
7485                 last if ($matches++ > 1000);
7486                 if ($line =~ /^Binary file (.+) matches$/) {
7487                         $file = $1;
7488                         $binary = 1;
7489                 } else {
7490                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
7491                         $file =~ s/^$co{'tree'}://;
7492                 }
7493                 if ($file ne $lastfile) {
7494                         $lastfile and print "</td></tr>\n";
7495                         if ($alternate++) {
7496                                 print "<tr class=\"dark\">\n";
7497                         } else {
7498                                 print "<tr class=\"light\">\n";
7499                         }
7500                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
7501                                           file_name=>$file);
7502                         print "<td class=\"list\">".
7503                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
7504                         print "</td><td>\n";
7505                         $lastfile = $file;
7506                 }
7507                 if ($binary) {
7508                         print "<div class=\"binary\">Binary file</div>\n";
7509                 } else {
7510                         $ltext = untabify($ltext);
7511                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
7512                                 $ltext = esc_html($1, -nbsp=>1);
7513                                 $ltext .= '<span class="match">';
7514                                 $ltext .= esc_html($2, -nbsp=>1);
7515                                 $ltext .= '</span>';
7516                                 $ltext .= esc_html($3, -nbsp=>1);
7517                         } else {
7518                                 $ltext = esc_html($ltext, -nbsp=>1);
7519                         }
7520                         print "<div class=\"pre\">" .
7521                                 $cgi->a({-href => $file_href.'#l'.$lno,
7522                                         -class => "linenr"}, sprintf('%4i', $lno)) .
7523                                 ' ' .  $ltext . "</div>\n";
7524                 }
7525         }
7526         if ($lastfile) {
7527                 print "</td></tr>\n";
7528                 if ($matches > 1000) {
7529                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
7530                 }
7531         } else {
7532                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
7533         }
7534         close $fd;
7535
7536         print "</table>\n";
7537
7538         git_footer_html();
7539 }
7540
7541 sub git_search_grep_body {
7542         my ($commitlist, $from, $to, $extra) = @_;
7543         $from = 0 unless defined $from;
7544         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
7545
7546         print "<table class=\"commit_search\">\n";
7547         my $alternate = 1;
7548         for (my $i = $from; $i <= $to; $i++) {
7549                 my %co = %{$commitlist->[$i]};
7550                 if (!%co) {
7551                         next;
7552                 }
7553                 my $commit = $co{'id'};
7554                 if ($alternate) {
7555                         print "<tr class=\"dark\">\n";
7556                 } else {
7557                         print "<tr class=\"light\">\n";
7558                 }
7559                 $alternate ^= 1;
7560                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
7561                       format_author_html('td', \%co, 15, 5) .
7562                       "<td>" .
7563                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
7564                                -class => "list subject"},
7565                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
7566                 my $comment = $co{'comment'};
7567                 foreach my $line (@$comment) {
7568                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
7569                                 my ($lead, $match, $trail) = ($1, $2, $3);
7570                                 $match = chop_str($match, 70, 5, 'center');
7571                                 my $contextlen = int((80 - length($match))/2);
7572                                 $contextlen = 30 if ($contextlen > 30);
7573                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
7574                                 $trail = chop_str($trail, $contextlen, 10, 'right');
7575
7576                                 $lead  = esc_html($lead);
7577                                 $match = esc_html($match);
7578                                 $trail = esc_html($trail);
7579
7580                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
7581                         }
7582                 }
7583                 print "</td>\n" .
7584                       "<td class=\"link\">" .
7585                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7586                       $barsep .
7587                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7588                       $barsep .
7589                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7590                 print "</td>\n" .
7591                       "</tr>\n";
7592         }
7593         if (defined $extra) {
7594                 print "<tr class=\"extra\">\n" .
7595                       "<td colspan=\"3\" class=\"extra\">$extra</td>\n" .
7596                       "</tr>\n";
7597         }
7598         print "</table>\n";
7599 }
7600
7601 ## ======================================================================
7602 ## ======================================================================
7603 ## actions
7604
7605 sub git_project_list_load {
7606         my $empty_list_ok = shift;
7607         my $order = $input_params{'order'};
7608         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7609                 die_error(400, "Unknown order parameter");
7610         }
7611
7612         my @list = git_get_projects_list($project_filter, $strict_export);
7613         if ($project_filter && (!@list || !gitweb_check_feature('forks'))) {
7614                 push @list, { 'path' => "$project_filter.git" }
7615                         if is_valid_project("$project_filter.git");
7616         }
7617         if (!@list) {
7618                 die_error(404, "No projects found") unless $empty_list_ok;
7619         }
7620
7621         return (\@list, $order);
7622 }
7623
7624 sub git_frontpage {
7625         my ($projlist, $order);
7626
7627         if ($frontpage_no_project_list) {
7628                 $project = undef;
7629                 $project_filter = undef;
7630         } else {
7631                 ($projlist, $order) = git_project_list_load(1);
7632         }
7633         git_header_html();
7634         if (defined $home_text && -f $home_text) {
7635                 print "<div class=\"index_include\">\n";
7636                 insert_file($home_text);
7637                 print "</div>\n";
7638         }
7639         git_project_search_form($searchtext, $search_use_regexp);
7640         if ($frontpage_no_project_list) {
7641                 my $show_ctags = gitweb_check_feature('ctags');
7642                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7643                         my @projects = git_get_projects_list($project_filter, $strict_export);
7644                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7645                         @projects = fill_project_list_info(\@projects, 'ctags');
7646                         my $ctags = git_gather_all_ctags(\@projects);
7647                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7648                         print git_show_project_tagcloud($cloud, 64);
7649                 }
7650         } else {
7651                 git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7652         }
7653         git_footer_html();
7654 }
7655
7656 sub git_project_list {
7657         my ($projlist, $order) = git_project_list_load();
7658         git_header_html();
7659         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7660                 print "<div class=\"index_include\">\n";
7661                 insert_file($home_text);
7662                 print "</div>\n";
7663         }
7664         git_project_search_form();
7665         git_project_list_body($projlist, $order, undef, undef, undef, undef, undef, 1);
7666         git_footer_html();
7667 }
7668
7669 sub git_forks {
7670         my $order = $input_params{'order'};
7671         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7672                 die_error(400, "Unknown order parameter");
7673         }
7674
7675         my $filter = $project;
7676         $filter =~ s/\.git$//;
7677         my @list = git_get_projects_list($filter);
7678         if (!@list) {
7679                 die_error(404, "No forks found");
7680         }
7681
7682         git_header_html();
7683         git_print_page_nav('','');
7684         git_print_header_div('summary', "$project forks");
7685         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7686         git_footer_html();
7687 }
7688
7689 sub git_project_index {
7690         my @projects = git_get_projects_list($project_filter, $strict_export);
7691         if (!@projects) {
7692                 die_error(404, "No projects found");
7693         }
7694
7695         print $cgi->header(
7696                 -type => 'text/plain',
7697                 -charset => 'utf-8',
7698                 -content_disposition => 'inline; filename="index.aux"');
7699
7700         foreach my $pr (@projects) {
7701                 if (!exists $pr->{'owner'}) {
7702                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7703                 }
7704
7705                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7706                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7707                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7708                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7709                 $path  =~ s/ /\+/g;
7710                 $owner =~ s/ /\+/g;
7711
7712                 print "$path $owner\n";
7713         }
7714 }
7715
7716 sub git_summary {
7717         my $descr = git_get_project_description($project) || "none";
7718         my %co = parse_commit("HEAD");
7719         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7720         my $head = $co{'id'};
7721         my $remote_heads = gitweb_check_feature('remote_heads');
7722
7723         my $owner = git_get_project_owner($project);
7724         my $homepage = git_get_project_config('homepage');
7725         my $base_url = git_get_project_config('baseurl');
7726         my $last_refresh = git_get_project_config('lastrefresh');
7727
7728         my $refs = git_get_references();
7729         # These get_*_list functions return one more to allow us to see if
7730         # there are more ...
7731         my @taglist  = git_get_tags_list(16);
7732         my @headlist = git_get_heads_list(16);
7733         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7734         my @forklist;
7735         my $check_forks = gitweb_check_feature('forks');
7736
7737         if ($check_forks) {
7738                 # find forks of a project
7739                 my $filter = $project;
7740                 $filter =~ s/\.git$//;
7741                 @forklist = git_get_projects_list($filter);
7742                 # filter out forks of forks
7743                 @forklist = filter_forks_from_projects_list(\@forklist)
7744                         if (@forklist);
7745         }
7746
7747         git_header_html();
7748         git_print_page_nav('summary','', $head);
7749
7750         if ($check_forks and $project =~ m#/#) {
7751                 my $xproject = $project; $xproject =~ s#/[^/]+$#.git#; #
7752                 my $r = $cgi->a({-href=> href(project => $xproject, action => 'summary')}, $xproject);
7753                 print <<EOT;
7754 <div class="forkinfo">
7755 This project is a fork of the $r project. If you have that one
7756 already cloned locally, you can use
7757 <pre>git clone --reference /path/to/your/$xproject/incarnation mirror_URL</pre>
7758 to save bandwidth during cloning.
7759 </div>
7760 EOT
7761         }
7762
7763         print "<div class=\"title\">&#160;</div>\n";
7764         print "<table class=\"projects_list\">\n" .
7765               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7766         if ($homepage) {
7767                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7768         }
7769         if ($base_url) {
7770                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7771         }
7772         if ($owner and not $omit_owner) {
7773                 print "<tr id=\"metadata_owner\"><td>owner</td><td>" . ($owner_link_hook
7774                         ? $cgi->a({-href => $owner_link_hook->($owner)}, email_obfuscate($owner))
7775                         : email_obfuscate($owner)) . "</td></tr>\n";
7776         }
7777         if (defined $cd{'rfc2822'}) {
7778                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7779                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7780         }
7781         if (defined $last_refresh) {
7782                 my %rd = parse_date_rfc2822($last_refresh);
7783                 print "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
7784                       "<td>".format_timestamp_html(\%rd)."</td></tr>\n"
7785                 if defined $rd{'rfc2822'};
7786         }
7787
7788         # use per project git URL list in $projectroot/$project/cloneurl
7789         # or make project git URL from git base URL and project name
7790         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7791         my @url_list = git_get_project_url_list($project);
7792         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7793         foreach my $git_url (@url_list) {
7794                 next unless $git_url;
7795                 print format_repo_url($url_tag, $git_url);
7796                 $url_tag = "";
7797         }
7798         @url_list = map { "$_/$project" } @git_base_push_urls;
7799         if (-f "$projectroot/$project/.nofetch") {
7800                 $url_tag = "Push&#160;URL";
7801                 foreach my $git_push_url (@url_list) {
7802                         next unless $git_push_url;
7803                         my $hint = $https_hint_html && $git_push_url =~ /^https:/i ?
7804                                 "&#160;$https_hint_html" : '';
7805                         print "<tr class=\"metadata_pushurl\"><td>$url_tag</td><td>$git_push_url$hint</td></tr>\n";
7806                         $url_tag = "";
7807                 }
7808         }
7809
7810         # Tag cloud
7811         my $show_ctags = gitweb_check_feature('ctags');
7812         if ($show_ctags) {
7813                 my $ctags = git_get_project_ctags($project);
7814                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7815                         # without ability to add tags, don't show if there are none
7816                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7817                         print "<tr id=\"metadata_ctags\">" .
7818                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7819                         print "</td>\n<td>" unless %$ctags;
7820                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7821                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7822                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7823                               unless $show_ctags =~ /^\d+$/;
7824                         print "</td>\n<td>" if %$ctags;
7825                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7826                               "</tr>\n";
7827                 }
7828         }
7829
7830         print "</table>\n";
7831
7832         # If XSS prevention is on, we don't include README.html.
7833         # TODO: Allow a readme in some safe format.
7834         if (!$prevent_xss && -s "$projectroot/$project/README.html") {
7835                 print "<div class=\"title\">readme</div>\n" .
7836                       "<div id=\"readme\" class=\"readme\">\n";
7837                 insert_file("$projectroot/$project/README.html");
7838                 print "\n</div>\n"; # class="readme"
7839         }
7840
7841         # we need to request one more than 16 (0..15) to check if
7842         # those 16 are all
7843         my @commitlist = $head ? parse_commits($head, 17) : ();
7844         if (@commitlist) {
7845                 git_print_header_div('shortlog');
7846                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7847                                   $#commitlist <=  15 ? undef :
7848                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7849         }
7850
7851         if (@taglist) {
7852                 git_print_header_div('tags');
7853                 git_tags_body(\@taglist, 0, 15,
7854                               $#taglist <=  15 ? undef :
7855                               $cgi->a({-href => href(action=>"tags")}, "..."));
7856         }
7857
7858         if (@headlist) {
7859                 git_print_header_div('heads');
7860                 git_heads_body(\@headlist, $head, 0, 15,
7861                                $#headlist <= 15 ? undef :
7862                                $cgi->a({-href => href(action=>"heads")}, "..."));
7863         }
7864
7865         if (%remotedata) {
7866                 git_print_header_div('remotes');
7867                 git_remotes_body(\%remotedata, 15, $head);
7868         }
7869
7870         if (@forklist) {
7871                 git_print_header_div('forks');
7872                 git_project_list_body(\@forklist, 'age', 0, 15,
7873                                       $#forklist <= 15 ? undef :
7874                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7875                                       'no_header', 'forks');
7876         }
7877
7878         git_footer_html();
7879 }
7880
7881 sub git_tag {
7882         my %tag = parse_tag($hash);
7883
7884         if (! %tag) {
7885                 die_error(404, "Unknown tag object");
7886         }
7887
7888         my $fullhash;
7889         $fullhash = $hash if $hash =~ m/^[0-9a-fA-F]{40}$/;
7890         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
7891
7892         my $head = git_get_head_hash($project);
7893         git_header_html();
7894         git_print_page_nav('','', $head,undef,$head);
7895         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
7896         print "<div class=\"title_text\">\n" .
7897               "<table class=\"object_header\">\n" .
7898               "<tr><td>tag</td><td class=\"sha1\">$fullhash</td></tr>\n" .
7899               "<tr>\n" .
7900               "<td>object</td>\n" .
7901               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7902                                $tag{'object'}) . "</td>\n" .
7903               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7904                                               $tag{'type'}) . "</td>\n" .
7905               "</tr>\n";
7906         if (defined($tag{'author'})) {
7907                 git_print_authorship_rows(\%tag, 'author');
7908         }
7909         print "</table>\n\n" .
7910               "</div>\n";
7911         print "<div class=\"page_body\">";
7912         my $comment = $tag{'comment'};
7913         foreach my $line (@$comment) {
7914                 chomp $line;
7915                 print esc_html($line, -nbsp=>1) . "<br/>\n";
7916         }
7917         print "</div>\n";
7918         git_footer_html();
7919 }
7920
7921 sub git_blame_common {
7922         my $format = shift || 'porcelain';
7923         if ($format eq 'porcelain' && $input_params{'javascript'}) {
7924                 $format = 'incremental';
7925                 $action = 'blame_incremental'; # for page title etc
7926         }
7927
7928         # permissions
7929         gitweb_check_feature('blame')
7930                 or die_error(403, "Blame view not allowed");
7931
7932         # error checking
7933         die_error(400, "No file name given") unless $file_name;
7934         $hash_base ||= git_get_head_hash($project);
7935         die_error(404, "Couldn't find base commit") unless $hash_base;
7936         my %co = parse_commit($hash_base)
7937                 or die_error(404, "Commit not found");
7938         my $ftype = "blob";
7939         if (!defined $hash) {
7940                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
7941                         or die_error(404, "Error looking up file");
7942         } else {
7943                 $ftype = git_get_type($hash);
7944                 if ($ftype !~ "blob") {
7945                         die_error(400, "Object is not a blob");
7946                 }
7947         }
7948
7949         my $fd;
7950         if ($format eq 'incremental') {
7951                 # get file contents (as base)
7952                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
7953                         or die_error(500, "Open git-cat-file failed");
7954         } elsif ($format eq 'data') {
7955                 # run git-blame --incremental
7956                 defined($fd = git_cmd_pipe "blame", "--incremental",
7957                         $hash_base, "--", $file_name)
7958                         or die_error(500, "Open git-blame --incremental failed");
7959         } else {
7960                 # run git-blame --porcelain
7961                 defined($fd = git_cmd_pipe "blame", '-p',
7962                         $hash_base, '--', $file_name)
7963                         or die_error(500, "Open git-blame --porcelain failed");
7964         }
7965
7966         # incremental blame data returns early
7967         if ($format eq 'data') {
7968                 print $cgi->header(
7969                         -type=>"text/plain", -charset => "utf-8",
7970                         -status=> "200 OK");
7971                 local $| = 1; # output autoflush
7972                 while (<$fd>) {
7973                         print to_utf8($_);
7974                 }
7975                 close $fd
7976                         or print "ERROR $!\n";
7977
7978                 print 'END';
7979                 if (defined $t0 && gitweb_check_feature('timed')) {
7980                         print ' '.
7981                               tv_interval($t0, [ gettimeofday() ]).
7982                               ' '.$number_of_git_cmds;
7983                 }
7984                 print "\n";
7985
7986                 return;
7987         }
7988
7989         # page header
7990         git_header_html();
7991         my $formats_nav = tabspan(
7992                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
7993                         "blob"));
7994         $formats_nav .=
7995                 $barsep . tabspan(
7996                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7997                         "history")) .
7998                 $barsep . tabspan(
7999                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
8000                         "HEAD"));
8001         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8002         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8003         git_print_page_path($file_name, $ftype, $hash_base);
8004
8005         # page body
8006         if ($format eq 'incremental') {
8007                 print "<noscript>\n<div class=\"error\"><center><b>\n".
8008                       "This page requires JavaScript to run.\n Use ".
8009                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
8010                               'this page').
8011                       " instead.\n".
8012                       "</b></center></div>\n</noscript>\n";
8013
8014                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
8015         }
8016
8017         print qq!<div class="page_body">\n!;
8018         print qq!<div id="progress_info">... / ...</div>\n!
8019                 if ($format eq 'incremental');
8020         print qq!<table id="blame_table" class="blame" width="100%">\n!.
8021               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
8022               qq!<thead>\n!.
8023               qq!<tr><th nowrap="nowrap" style="white-space:nowrap">!.
8024               qq!Commit&#160;<a href="javascript:extra_blame_columns()" id="columns_expander" !.
8025               qq!title="toggles blame author information display">[+]</a></th>!.
8026               qq!<th class="extra_column">Author</th><th class="extra_column">Date</th>!.
8027               qq!<th>Line</th><th width="100%">Data</th></tr>\n!.
8028               qq!</thead>\n!.
8029               qq!<tbody>\n!;
8030
8031         my @rev_color = qw(light dark);
8032         my $num_colors = scalar(@rev_color);
8033         my $current_color = 0;
8034
8035         if ($format eq 'incremental') {
8036                 my $color_class = $rev_color[$current_color];
8037
8038                 #contents of a file
8039                 my $linenr = 0;
8040         LINE:
8041                 while (my $line = to_utf8(scalar <$fd>)) {
8042                         chomp $line;
8043                         $linenr++;
8044
8045                         print qq!<tr id="l$linenr" class="$color_class">!.
8046                               qq!<td class="sha1"><a href=""> </a></td>!.
8047                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8048                               qq!<td class="extra_column" nowrap="nowrap"></td>!.
8049                               qq!<td class="linenr">!.
8050                               qq!<a class="linenr" href="">$linenr</a></td>!;
8051                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
8052                         print qq!</tr>\n!;
8053                 }
8054
8055         } else { # porcelain, i.e. ordinary blame
8056                 my %metainfo = (); # saves information about commits
8057
8058                 # blame data
8059         LINE:
8060                 while (my $line = to_utf8(scalar <$fd>)) {
8061                         chomp $line;
8062                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
8063                         # no <lines in group> for subsequent lines in group of lines
8064                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
8065                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
8066                         if (!exists $metainfo{$full_rev}) {
8067                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
8068                         }
8069                         my $meta = $metainfo{$full_rev};
8070                         my $data;
8071                         while ($data = to_utf8(scalar <$fd>)) {
8072                                 chomp $data;
8073                                 last if ($data =~ s/^\t//); # contents of line
8074                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
8075                                         $meta->{$1} = $2 unless exists $meta->{$1};
8076                                 }
8077                                 if ($data =~ /^previous /) {
8078                                         $meta->{'nprevious'}++;
8079                                 }
8080                         }
8081                         my $short_rev = substr($full_rev, 0, 8);
8082                         my $author = $meta->{'author'};
8083                         my %date =
8084                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
8085                         my $date = $date{'iso-tz'};
8086                         if ($group_size) {
8087                                 $current_color = ($current_color + 1) % $num_colors;
8088                         }
8089                         my $tr_class = $rev_color[$current_color];
8090                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
8091                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
8092                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
8093                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
8094                         if ($group_size) {
8095                                 my $rowspan = $group_size > 1 ? " rowspan=\"$group_size\"" : "";
8096                                 print "<td class=\"sha1\"";
8097                                 print " title=\"". esc_html($author) . ", $date\"";
8098                                 print "$rowspan>";
8099                                 print $cgi->a({-href => href(action=>"commit",
8100                                                              hash=>$full_rev,
8101                                                              file_name=>$file_name)},
8102                                               esc_html($short_rev));
8103                                 if ($group_size >= 2) {
8104                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
8105                                         if (@author_initials) {
8106                                                 print "<br />" .
8107                                                       esc_html(join('', @author_initials));
8108                                                 #           or join('.', ...)
8109                                         }
8110                                 }
8111                                 print "</td>\n";
8112                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". esc_html($author) . "</td>";
8113                                 print "<td class=\"extra_column\" nowrap=\"nowrap\"$rowspan>". $date . "</td>";
8114                         }
8115                         # 'previous' <sha1 of parent commit> <filename at commit>
8116                         if (exists $meta->{'previous'} &&
8117                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
8118                                 $meta->{'parent'} = $1;
8119                                 $meta->{'file_parent'} = unquote($2);
8120                         }
8121                         my $linenr_commit =
8122                                 exists($meta->{'parent'}) ?
8123                                 $meta->{'parent'} : $full_rev;
8124                         my $linenr_filename =
8125                                 exists($meta->{'file_parent'}) ?
8126                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
8127                         my $blamed = href(action => 'blame',
8128                                           file_name => $linenr_filename,
8129                                           hash_base => $linenr_commit);
8130                         print "<td class=\"linenr\">";
8131                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
8132                                         -class => "linenr" },
8133                                       esc_html($lineno));
8134                         print "</td>";
8135                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
8136                         print "</tr>\n";
8137                 } # end while
8138
8139         }
8140
8141         # footer
8142         print "</tbody>\n".
8143               "</table>\n"; # class="blame"
8144         print "</div>\n";   # class="blame_body"
8145         close $fd
8146                 or print "Reading blob failed\n";
8147
8148         git_footer_html();
8149 }
8150
8151 sub git_blame {
8152         git_blame_common();
8153 }
8154
8155 sub git_blame_incremental {
8156         git_blame_common('incremental');
8157 }
8158
8159 sub git_blame_data {
8160         git_blame_common('data');
8161 }
8162
8163 sub git_tags {
8164         my $head = git_get_head_hash($project);
8165         git_header_html();
8166         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
8167         git_print_header_div('summary', $project);
8168
8169         my @tagslist = git_get_tags_list();
8170         if (@tagslist) {
8171                 git_tags_body(\@tagslist);
8172         }
8173         git_footer_html();
8174 }
8175
8176 sub git_refs {
8177         my $order = $input_params{'order'};
8178         if (defined $order && $order !~ m/age|name/) {
8179                 die_error(400, "Unknown order parameter");
8180         }
8181
8182         my $head = git_get_head_hash($project);
8183         git_header_html();
8184         git_print_page_nav('','', $head,undef,$head,format_ref_views('refs'));
8185         git_print_header_div('summary', $project);
8186
8187         my @refslist = git_get_tags_list(undef, 1, $order);
8188         if (@refslist) {
8189                 git_tags_body(\@refslist, undef, undef, undef, $head, 1, $order);
8190         }
8191         git_footer_html();
8192 }
8193
8194 sub git_heads {
8195         my $head = git_get_head_hash($project);
8196         git_header_html();
8197         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
8198         git_print_header_div('summary', $project);
8199
8200         my @headslist = git_get_heads_list();
8201         if (@headslist) {
8202                 git_heads_body(\@headslist, $head);
8203         }
8204         git_footer_html();
8205 }
8206
8207 # used both for single remote view and for list of all the remotes
8208 sub git_remotes {
8209         gitweb_check_feature('remote_heads')
8210                 or die_error(403, "Remote heads view is disabled");
8211
8212         my $head = git_get_head_hash($project);
8213         my $remote = $input_params{'hash'};
8214
8215         my $remotedata = git_get_remotes_list($remote);
8216         die_error(500, "Unable to get remote information") unless defined $remotedata;
8217
8218         unless (%$remotedata) {
8219                 die_error(404, defined $remote ?
8220                         "Remote $remote not found" :
8221                         "No remotes found");
8222         }
8223
8224         git_header_html(undef, undef, -action_extra => $remote);
8225         git_print_page_nav('', '',  $head, undef, $head,
8226                 format_ref_views($remote ? '' : 'remotes'));
8227
8228         fill_remote_heads($remotedata);
8229         if (defined $remote) {
8230                 git_print_header_div('remotes', "$remote remote for $project");
8231                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
8232         } else {
8233                 git_print_header_div('summary', "$project remotes");
8234                 git_remotes_body($remotedata, undef, $head);
8235         }
8236
8237         git_footer_html();
8238 }
8239
8240 sub git_blob_plain {
8241         my $type = shift;
8242         my $expires;
8243
8244         if (!defined $hash) {
8245                 if (defined $file_name) {
8246                         my $base = $hash_base || git_get_head_hash($project);
8247                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8248                                 or die_error(404, "Cannot find file");
8249                 } else {
8250                         die_error(400, "No file name defined");
8251                 }
8252         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8253                 # blobs defined by non-textual hash id's can be cached
8254                 $expires = "+1d";
8255         }
8256
8257         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8258                 or die_error(500, "Open git-cat-file blob '$hash' failed");
8259         binmode($fd);
8260
8261         # content-type (can include charset)
8262         my $leader;
8263         ($type, $leader) = blob_contenttype($fd, $file_name, $type);
8264
8265         # "save as" filename, even when no $file_name is given
8266         my $save_as = "$hash";
8267         if (defined $file_name) {
8268                 $save_as = $file_name;
8269         } elsif ($type =~ m/^text\//) {
8270                 $save_as .= '.txt';
8271         }
8272
8273         # With XSS prevention on, blobs of all types except a few known safe
8274         # ones are served with "Content-Disposition: attachment" to make sure
8275         # they don't run in our security domain.  For certain image types,
8276         # blob view writes an <img> tag referring to blob_plain view, and we
8277         # want to be sure not to break that by serving the image as an
8278         # attachment (though Firefox 3 doesn't seem to care).
8279         my $sandbox = $prevent_xss &&
8280                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
8281
8282         # serve text/* as text/plain
8283         if ($prevent_xss &&
8284             ($type =~ m!^text/[a-z]+\b(.*)$! ||
8285              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
8286                 my $rest = $1;
8287                 $rest = defined $rest ? $rest : '';
8288                 $type = "text/plain$rest";
8289         }
8290
8291         print $cgi->header(
8292                 -type => $type,
8293                 -expires => $expires,
8294                 -content_disposition =>
8295                         ($sandbox ? 'attachment' : 'inline')
8296                         . '; filename="' . $save_as . '"');
8297         binmode STDOUT, ':raw';
8298         $fcgi_raw_mode = 1;
8299         print $leader if defined $leader;
8300         my $buf;
8301         while (read($fd, $buf, 32768)) {
8302                 print $buf;
8303         }
8304         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8305         $fcgi_raw_mode = 0;
8306         close $fd;
8307 }
8308
8309 sub git_blob {
8310         my $expires;
8311
8312         my $fullhash;
8313         if (!defined $hash) {
8314                 if (defined $file_name) {
8315                         my $base = $hash_base || git_get_head_hash($project);
8316                         $hash = git_get_hash_by_path($base, $file_name, "blob")
8317                                 or die_error(404, "Cannot find file");
8318                         $fullhash = $hash;
8319                 } else {
8320                         die_error(400, "No file name defined");
8321                 }
8322         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8323                 # blobs defined by non-textual hash id's can be cached
8324                 $expires = "+1d";
8325                 $fullhash = $hash;
8326         }
8327         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8328
8329         my $have_blame = gitweb_check_feature('blame');
8330         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
8331                 or die_error(500, "Couldn't cat $file_name, $hash");
8332         binmode($fd);
8333         my $mimetype = blob_mimetype($fd, $file_name);
8334         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
8335         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
8336                 close $fd;
8337                 return git_blob_plain($mimetype);
8338         }
8339         # we can have blame only for text/* mimetype
8340         $have_blame &&= ($mimetype =~ m!^text/!);
8341
8342         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
8343         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
8344         my $highlight_mode_active;
8345         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
8346
8347         git_header_html(undef, $expires);
8348         my $formats_nav = '';
8349         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8350                 if (defined $file_name) {
8351                         if ($have_blame) {
8352                                 $formats_nav .= tabspan(
8353                                         $cgi->a({-href => href(action=>"blame", -replay=>1),
8354                                                 -class => "blamelink"},
8355                                                 "blame")) .
8356                                         $barsep;
8357                         }
8358                         $formats_nav .= tabspan(
8359                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
8360                                         "history")) .
8361                                 $barsep . tabspan(
8362                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8363                                         "raw")) .
8364                                 $barsep . tabspan(
8365                                 $cgi->a({-href => href(action=>"blob",
8366                                                        hash_base=>"HEAD", file_name=>$file_name)},
8367                                         "HEAD"));
8368                 } else {
8369                         $formats_nav .= tabspan(
8370                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
8371                                         "raw"));
8372                 }
8373                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8374                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8375         } else {
8376                 print "<div class=\"page_nav\">\n" .
8377                       "<br/><br/></div>\n" .
8378                       "<div class=\"title\">".esc_html($hash)."</div>\n";
8379         }
8380         git_print_page_path($file_name, "blob", $hash_base);
8381         print "<div class=\"title_text\">\n" .
8382               "<table class=\"object_header\">\n";
8383         print "<tr><td>blob</td><td class=\"sha1\">$fullhash</td></tr>\n";
8384         print "</table>".
8385               "</div>\n";
8386         print "<div class=\"page_body\">\n";
8387         if ($mimetype =~ m!^image/!) {
8388                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
8389                 if ($file_name) {
8390                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
8391                 }
8392                 print qq! src="! .
8393                       href(action=>"blob_plain", hash=>$hash,
8394                            hash_base=>$hash_base, file_name=>$file_name) .
8395                       qq!" />\n!;
8396         } else {
8397                 my $nr;
8398                 while (my $line = to_utf8(scalar <$fd>)) {
8399                         chomp $line;
8400                         $nr++;
8401                         $line = untabify($line);
8402                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
8403                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
8404                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
8405                 }
8406         }
8407         close $fd
8408                 or print "Reading blob failed.\n";
8409         print "</div>";
8410         git_footer_html();
8411 }
8412
8413 sub git_tree {
8414         my $fullhash;
8415         if (!defined $hash_base) {
8416                 $hash_base = "HEAD";
8417         }
8418         if (!defined $hash) {
8419                 if (defined $file_name) {
8420                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
8421                         $fullhash = $hash;
8422                 } else {
8423                         $hash = $hash_base;
8424                 }
8425         }
8426         die_error(404, "No such tree") unless defined($hash);
8427         $fullhash = $hash if !$fullhash && $hash =~ m/^[0-9a-fA-F]{40}$/;
8428         $fullhash = git_get_full_hash($project, $hash) unless $fullhash;
8429
8430         my $show_sizes = gitweb_check_feature('show-sizes');
8431         my $have_blame = gitweb_check_feature('blame');
8432
8433         my @entries = ();
8434         {
8435                 local $/ = "\0";
8436                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
8437                         ($show_sizes ? '-l' : ()), @extra_options, $hash)
8438                         or die_error(500, "Open git-ls-tree failed");
8439                 @entries = map { chomp; to_utf8($_) } <$fd>;
8440                 close $fd
8441                         or die_error(404, "Reading tree failed");
8442         }
8443
8444         git_header_html();
8445         my $basedir = '';
8446         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8447                 my $refs = git_get_references();
8448                 my $ref = format_ref_marker($refs, $co{'id'});
8449                 my @views_nav = ();
8450                 if (defined $file_name) {
8451                         push @views_nav,
8452                                 tabspan($cgi->a({-href => href(action=>"history", -replay=>1)},
8453                                                 "history")),
8454                                 tabspan($cgi->a({-href => href(action=>"tree",
8455                                                                hash_base=>"HEAD", file_name=>$file_name)},
8456                                                  "HEAD")),
8457                 }
8458                 my $snapshot_links = format_snapshot_links($hash);
8459                 if (defined $snapshot_links) {
8460                         # FIXME: Should be available when we have no hash base as well.
8461                         push @views_nav, $snapshot_links;
8462                 }
8463                 git_print_page_nav('tree','', $hash_base, undef, undef,
8464                                    join($barsep, @views_nav));
8465                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base, undef, $ref);
8466         } else {
8467                 undef $hash_base;
8468                 print "<div class=\"page_nav\">\n";
8469                 print "<br/><br/></div>\n";
8470                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
8471         }
8472         if (defined $file_name) {
8473                 $basedir = $file_name;
8474                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
8475                         $basedir .= '/';
8476                 }
8477                 git_print_page_path($file_name, 'tree', $hash_base);
8478         }
8479         print "<div class=\"title_text\">\n" .
8480               "<table class=\"object_header\">\n";
8481         print "<tr><td>tree</td><td class=\"sha1\">$fullhash</td></tr>\n";
8482         print "</table>".
8483               "</div>\n";
8484         print "<div class=\"page_body\">\n";
8485         print "<table class=\"tree\">\n";
8486         my $alternate = 1;
8487         # '..' (top directory) link if possible
8488         if (defined $hash_base &&
8489             defined $file_name && $file_name =~ m![^/]+$!) {
8490                 if ($alternate) {
8491                         print "<tr class=\"dark\">\n";
8492                 } else {
8493                         print "<tr class=\"light\">\n";
8494                 }
8495                 $alternate ^= 1;
8496
8497                 my $up = $file_name;
8498                 $up =~ s!/?[^/]+$!!;
8499                 undef $up unless $up;
8500                 # based on git_print_tree_entry
8501                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
8502                 print '<td class="size">&#160;</td>'."\n" if $show_sizes;
8503                 print '<td class="list">';
8504                 print $cgi->a({-href => href(action=>"tree",
8505                                              hash_base=>$hash_base,
8506                                              file_name=>$up)},
8507                               "..");
8508                 print "</td>\n";
8509                 print "<td class=\"link\"></td>\n";
8510
8511                 print "</tr>\n";
8512         }
8513         foreach my $line (@entries) {
8514                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
8515
8516                 if ($alternate) {
8517                         print "<tr class=\"dark\">\n";
8518                 } else {
8519                         print "<tr class=\"light\">\n";
8520                 }
8521                 $alternate ^= 1;
8522
8523                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
8524
8525                 print "</tr>\n";
8526         }
8527         print "</table>\n" .
8528               "</div>";
8529         git_footer_html();
8530 }
8531
8532 sub sanitize_for_filename {
8533     my $name = shift;
8534
8535     $name =~ s!/!-!g;
8536     $name =~ s/[^[:alnum:]_.-]//g;
8537
8538     return $name;
8539 }
8540
8541 sub snapshot_name {
8542         my ($project, $hash) = @_;
8543
8544         # path/to/project.git  -> project
8545         # path/to/project/.git -> project
8546         my $name = to_utf8($project);
8547         $name =~ s,([^/])/*\.git$,$1,;
8548         $name = sanitize_for_filename(basename($name));
8549
8550         my $ver = $hash;
8551         if ($hash =~ /^[0-9a-fA-F]+$/) {
8552                 # shorten SHA-1 hash
8553                 my $full_hash = git_get_full_hash($project, $hash);
8554                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
8555                         $ver = git_get_short_hash($project, $hash);
8556                 }
8557         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
8558                 # tags don't need shortened SHA-1 hash
8559                 $ver = $1;
8560         } else {
8561                 # branches and other need shortened SHA-1 hash
8562                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
8563                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
8564                         my $ref_dir = (defined $1) ? $1 : '';
8565                         $ver = $2;
8566
8567                         $ref_dir = sanitize_for_filename($ref_dir);
8568                         # for refs neither in heads nor remotes we want to
8569                         # add a ref dir to archive name
8570                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
8571                                 $ver = $ref_dir . '-' . $ver;
8572                         }
8573                 }
8574                 $ver .= '-' . git_get_short_hash($project, $hash);
8575         }
8576         # special case of sanitization for filename - we change
8577         # slashes to dots instead of dashes
8578         # in case of hierarchical branch names
8579         $ver =~ s!/!.!g;
8580         $ver =~ s/[^[:alnum:]_.-]//g;
8581
8582         # name = project-version_string
8583         $name = "$name-$ver";
8584
8585         return wantarray ? ($name, $name) : $name;
8586 }
8587
8588 sub exit_if_unmodified_since {
8589         my ($latest_epoch) = @_;
8590         our $cgi;
8591
8592         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
8593         if (defined $if_modified) {
8594                 my $since;
8595                 if (eval { require HTTP::Date; 1; }) {
8596                         $since = HTTP::Date::str2time($if_modified);
8597                 } elsif (eval { require Time::ParseDate; 1; }) {
8598                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
8599                 }
8600                 if (defined $since && $latest_epoch <= $since) {
8601                         my %latest_date = parse_date($latest_epoch);
8602                         print $cgi->header(
8603                                 -last_modified => $latest_date{'rfc2822'},
8604                                 -status => '304 Not Modified');
8605                         goto DONE_GITWEB;
8606                 }
8607         }
8608 }
8609
8610 sub git_snapshot {
8611         my $format = $input_params{'snapshot_format'};
8612         if (!@snapshot_fmts) {
8613                 die_error(403, "Snapshots not allowed");
8614         }
8615         # default to first supported snapshot format
8616         $format ||= $snapshot_fmts[0];
8617         if ($format !~ m/^[a-z0-9]+$/) {
8618                 die_error(400, "Invalid snapshot format parameter");
8619         } elsif (!exists($known_snapshot_formats{$format})) {
8620                 die_error(400, "Unknown snapshot format");
8621         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
8622                 die_error(403, "Snapshot format not allowed");
8623         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
8624                 die_error(403, "Unsupported snapshot format");
8625         }
8626
8627         my $type = git_get_type("$hash^{}");
8628         if (!$type) {
8629                 die_error(404, 'Object does not exist');
8630         }  elsif ($type eq 'blob') {
8631                 die_error(400, 'Object is not a tree-ish');
8632         }
8633
8634         my ($name, $prefix) = snapshot_name($project, $hash);
8635         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
8636
8637         my %co = parse_commit($hash);
8638         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
8639
8640         my @cmd = (
8641                 git_cmd(), 'archive',
8642                 "--format=$known_snapshot_formats{$format}{'format'}",
8643                 "--prefix=$prefix/", $hash);
8644         if (exists $known_snapshot_formats{$format}{'compressor'}) {
8645                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
8646                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
8647         }
8648
8649         $filename =~ s/(["\\])/\\$1/g;
8650         my %latest_date;
8651         if (%co) {
8652                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
8653         }
8654
8655         print $cgi->header(
8656                 -type => $known_snapshot_formats{$format}{'type'},
8657                 -content_disposition => 'inline; filename="' . $filename . '"',
8658                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8659                 -status => '200 OK');
8660
8661         defined(my $fd = cmd_pipe @cmd)
8662                 or die_error(500, "Execute git-archive failed");
8663         binmode($fd);
8664         binmode STDOUT, ':raw';
8665         $fcgi_raw_mode = 1;
8666         my $buf;
8667         while (read($fd, $buf, 32768)) {
8668                 print $buf;
8669         }
8670         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8671         $fcgi_raw_mode = 0;
8672         close $fd;
8673 }
8674
8675 sub git_log_generic {
8676         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8677
8678         my $head = git_get_head_hash($project);
8679         if (!defined $base) {
8680                 $base = $head;
8681         }
8682         if (!defined $page) {
8683                 $page = 0;
8684         }
8685         my $refs = git_get_references();
8686
8687         my $commit_hash = $base;
8688         if (defined $parent) {
8689                 $commit_hash = "$parent..$base";
8690         }
8691         my @commitlist =
8692                 parse_commits($commit_hash, 101, (100 * $page),
8693                               defined $file_name ? ($file_name, "--full-history") : ());
8694
8695         my $ftype;
8696         if (!defined $file_hash && defined $file_name) {
8697                 # some commits could have deleted file in question,
8698                 # and not have it in tree, but one of them has to have it
8699                 for (my $i = 0; $i < @commitlist; $i++) {
8700                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8701                         last if defined $file_hash;
8702                 }
8703         }
8704         if (defined $file_hash) {
8705                 $ftype = git_get_type($file_hash);
8706         }
8707         if (defined $file_name && !defined $ftype) {
8708                 die_error(500, "Unknown type of object");
8709         }
8710         my %co;
8711         if (defined $file_name) {
8712                 %co = parse_commit($base)
8713                         or die_error(404, "Unknown commit object");
8714         }
8715
8716
8717         my $next_link = '';
8718         if ($#commitlist >= 100) {
8719                 $next_link =
8720                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8721                                  -accesskey => "n", -title => "Alt-n"}, "next");
8722         }
8723         my $extra = '';
8724         my ($patch_max) = gitweb_get_feature('patches');
8725         if ($patch_max && !defined $file_name) {
8726                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8727                         $extra = $cgi->a({-href => href(action=>"patches", -replay=>1)},
8728                                         "patches");
8729                 }
8730         }
8731         my $paging_nav = format_log_nav($fmt_name, $page, $#commitlist >= 100, $extra);
8732
8733         {
8734                 local $action = 'fulllog';
8735                 git_header_html();
8736         }
8737         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8738         if (defined $file_name) {
8739                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8740         } else {
8741                 git_print_header_div('summary', $project)
8742         }
8743         git_print_page_path($file_name, $ftype, $hash_base)
8744                 if (defined $file_name);
8745
8746         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8747                      $file_name, $file_hash, $ftype);
8748
8749         git_footer_html();
8750 }
8751
8752 sub git_log {
8753         git_log_generic('log', \&git_log_body,
8754                         $hash, $hash_parent);
8755 }
8756
8757 sub git_commit {
8758         $hash ||= $hash_base || "HEAD";
8759         my %co = parse_commit($hash)
8760             or die_error(404, "Unknown commit object");
8761
8762         my $parent  = $co{'parent'};
8763         my $parents = $co{'parents'}; # listref
8764
8765         # we need to prepare $formats_nav before any parameter munging
8766         my $formats_nav;
8767         if (!defined $parent) {
8768                 # --root commitdiff
8769                 $formats_nav .= '<span class="parents none">(initial)</span>';
8770         } elsif (@$parents == 1) {
8771                 # single parent commit
8772                 $formats_nav .=
8773                         '<span class="parents single">(parent:&#160;' .
8774                         $cgi->a({-href => href(action=>"commit",
8775                                                hash=>$parent)},
8776                                 esc_html(substr($parent, 0, 7))) .
8777                         ')</span>';
8778         } else {
8779                 # merge commit
8780                 $formats_nav .=
8781                         '<span class="parents multiple">(merge:&#160;' .
8782                         join(' ', map {
8783                                 $cgi->a({-href => href(action=>"commit",
8784                                                        hash=>$_)},
8785                                         esc_html(substr($_, 0, 7)));
8786                         } @$parents ) .
8787                         ')</span>';
8788         }
8789         if (gitweb_check_feature('patches') && @$parents <= 1) {
8790                 $formats_nav .= $barsep . tabspan(
8791                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8792                                 "patch"));
8793         }
8794
8795         if (!defined $parent) {
8796                 $parent = "--root";
8797         }
8798         my @difftree;
8799         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8800                 @diff_opts,
8801                 (@$parents <= 1 ? $parent : '-c'),
8802                 $hash, "--")
8803                 or die_error(500, "Open git-diff-tree failed");
8804         @difftree = map { chomp; to_utf8($_) } <$fd>;
8805         close $fd or die_error(404, "Reading git-diff-tree failed");
8806
8807         # non-textual hash id's can be cached
8808         my $expires;
8809         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8810                 $expires = "+1d";
8811         }
8812         my $refs = git_get_references();
8813         my $ref = format_ref_marker($refs, $co{'id'});
8814
8815         git_header_html(undef, $expires);
8816         git_print_page_nav('commit', '',
8817                            $hash, $co{'tree'}, $hash,
8818                            $formats_nav);
8819
8820         if (defined $co{'parent'}) {
8821                 git_print_header_div('commitdiff', esc_html($co{'title'}), $hash, undef, $ref);
8822         } else {
8823                 git_print_header_div('tree', esc_html($co{'title'}), $co{'tree'}, $hash, $ref);
8824         }
8825         print "<div class=\"title_text\">\n" .
8826               "<table class=\"object_header\">\n";
8827         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8828         git_print_authorship_rows(\%co);
8829         print "<tr>" .
8830               "<td>tree</td>" .
8831               "<td class=\"sha1\">" .
8832               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8833                        class => "list"}, $co{'tree'}) .
8834               "</td>" .
8835               "<td class=\"link\">" .
8836               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8837                       "tree");
8838         my $snapshot_links = format_snapshot_links($hash);
8839         if (defined $snapshot_links) {
8840                 print $barsep . $snapshot_links;
8841         }
8842         print "</td>" .
8843               "</tr>\n";
8844
8845         foreach my $par (@$parents) {
8846                 print "<tr>" .
8847                       "<td>parent</td>" .
8848                       "<td class=\"sha1\">" .
8849                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8850                                class => "list"}, $par) .
8851                       "</td>" .
8852                       "<td class=\"link\">" .
8853                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8854                       $barsep .
8855                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8856                       "</td>" .
8857                       "</tr>\n";
8858         }
8859         print "</table>".
8860               "</div>\n";
8861
8862         print "<div class=\"page_body\">\n";
8863         git_print_log($co{'comment'});
8864         print "</div>\n";
8865
8866         git_difftree_body(\@difftree, $hash, @$parents);
8867
8868         git_footer_html();
8869 }
8870
8871 sub git_object {
8872         # object is defined by:
8873         # - hash or hash_base alone
8874         # - hash_base and file_name
8875         my $type;
8876
8877         # - hash or hash_base alone
8878         if ($hash || ($hash_base && !defined $file_name)) {
8879                 my $object_id = $hash || $hash_base;
8880
8881                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8882                         or die_error(404, "Object does not exist");
8883                 $type = <$fd>;
8884                 chomp $type;
8885                 close $fd
8886                         or die_error(404, "Object does not exist");
8887
8888         # - hash_base and file_name
8889         } elsif ($hash_base && defined $file_name) {
8890                 $file_name =~ s,/+$,,;
8891
8892                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
8893                         or die_error(404, "Base object does not exist");
8894
8895                 # here errors should not happen
8896                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
8897                         or die_error(500, "Open git-ls-tree failed");
8898                 my $line = to_utf8(scalar <$fd>);
8899                 close $fd;
8900
8901                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
8902                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
8903                         die_error(404, "File or directory for given base does not exist");
8904                 }
8905                 $type = $2;
8906                 $hash = $3;
8907         } else {
8908                 die_error(400, "Not enough information to find object");
8909         }
8910
8911         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
8912                                           hash=>$hash, hash_base=>$hash_base,
8913                                           file_name=>$file_name),
8914                              -status => '302 Found');
8915 }
8916
8917 sub git_blobdiff {
8918         my $format = shift || 'html';
8919         my $diff_style = $input_params{'diff_style'} || 'inline';
8920
8921         my $fd;
8922         my @difftree;
8923         my %diffinfo;
8924         my $expires;
8925
8926         # preparing $fd and %diffinfo for git_patchset_body
8927         # new style URI
8928         if (defined $hash_base && defined $hash_parent_base) {
8929                 if (defined $file_name) {
8930                         # read raw output
8931                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8932                                 $hash_parent_base, $hash_base,
8933                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
8934                                 or die_error(500, "Open git-diff-tree failed");
8935                         @difftree = map { chomp; to_utf8($_) } <$fd>;
8936                         close $fd
8937                                 or die_error(404, "Reading git-diff-tree failed");
8938                         @difftree
8939                                 or die_error(404, "Blob diff not found");
8940
8941                 } elsif (defined $hash &&
8942                          $hash =~ /[0-9a-fA-F]{40}/) {
8943                         # try to find filename from $hash
8944
8945                         # read filtered raw output
8946                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8947                                 $hash_parent_base, $hash_base, "--")
8948                                 or die_error(500, "Open git-diff-tree failed");
8949                         @difftree =
8950                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
8951                                 # $hash == to_id
8952                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
8953                                 map { chomp; to_utf8($_) } <$fd>;
8954                         close $fd
8955                                 or die_error(404, "Reading git-diff-tree failed");
8956                         @difftree
8957                                 or die_error(404, "Blob diff not found");
8958
8959                 } else {
8960                         die_error(400, "Missing one of the blob diff parameters");
8961                 }
8962
8963                 if (@difftree > 1) {
8964                         die_error(400, "Ambiguous blob diff specification");
8965                 }
8966
8967                 %diffinfo = parse_difftree_raw_line($difftree[0]);
8968                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
8969                 $file_name   ||= $diffinfo{'to_file'};
8970
8971                 $hash_parent ||= $diffinfo{'from_id'};
8972                 $hash        ||= $diffinfo{'to_id'};
8973
8974                 # non-textual hash id's can be cached
8975                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
8976                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
8977                         $expires = '+1d';
8978                 }
8979
8980                 # open patch output
8981                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8982                         '-p', ($format eq 'html' ? "--full-index" : ()),
8983                         $hash_parent_base, $hash_base,
8984                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
8985                         or die_error(500, "Open git-diff-tree failed");
8986         }
8987
8988         # old/legacy style URI -- not generated anymore since 1.4.3.
8989         if (!%diffinfo) {
8990                 die_error('404 Not Found', "Missing one of the blob diff parameters")
8991         }
8992
8993         # header
8994         if ($format eq 'html') {
8995                 my $formats_nav =
8996                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
8997                                 "raw");
8998                 $formats_nav .= diff_style_nav($diff_style);
8999                 git_header_html(undef, $expires);
9000                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
9001                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
9002                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
9003                 } else {
9004                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
9005                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
9006                 }
9007                 if (defined $file_name) {
9008                         git_print_page_path($file_name, "blob", $hash_base);
9009                 } else {
9010                         print "<div class=\"page_path\"></div>\n";
9011                 }
9012
9013         } elsif ($format eq 'plain') {
9014                 print $cgi->header(
9015                         -type => 'text/plain',
9016                         -charset => 'utf-8',
9017                         -expires => $expires,
9018                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
9019
9020                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9021
9022         } else {
9023                 die_error(400, "Unknown blobdiff format");
9024         }
9025
9026         # patch
9027         if ($format eq 'html') {
9028                 print "<div class=\"page_body\">\n";
9029
9030                 git_patchset_body($fd, $diff_style,
9031                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
9032                 close $fd;
9033
9034                 print "</div>\n"; # class="page_body"
9035                 git_footer_html();
9036
9037         } else {
9038                 while (my $line = to_utf8(scalar <$fd>)) {
9039                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
9040                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
9041
9042                         print $line;
9043
9044                         last if $line =~ m!^\+\+\+!;
9045                 }
9046                 while (<$fd>) {
9047                         print to_utf8($_);
9048                 }
9049                 close $fd;
9050         }
9051 }
9052
9053 sub git_blobdiff_plain {
9054         git_blobdiff('plain');
9055 }
9056
9057 # assumes that it is added as later part of already existing navigation,
9058 # so it returns "| foo | bar" rather than just "foo | bar"
9059 sub diff_style_nav {
9060         my ($diff_style, $is_combined) = @_;
9061         $diff_style ||= 'inline';
9062
9063         return "" if ($is_combined);
9064
9065         my @styles = (inline => 'inline', 'sidebyside' => 'side&#160;by&#160;side');
9066         my %styles = @styles;
9067         @styles =
9068                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
9069
9070         return $barsep . '<span class="diffstyles">' . join($barsep,
9071                 map {
9072                         $_ eq $diff_style ?
9073                         '<span class="diffstyle selected">' . $styles{$_} . '</span>' :
9074                         '<span class="diffstyle">' .
9075                                 $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_}) .
9076                                 '</span>'
9077                 } @styles) . '</span>';
9078 }
9079
9080 sub git_commitdiff {
9081         my %params = @_;
9082         my $format = $params{-format} || 'html';
9083         my $diff_style = $input_params{'diff_style'} || 'inline';
9084
9085         my ($patch_max) = gitweb_get_feature('patches');
9086         if ($format eq 'patch') {
9087                 die_error(403, "Patch view not allowed") unless $patch_max;
9088         }
9089
9090         $hash ||= $hash_base || "HEAD";
9091         my %co = parse_commit($hash)
9092             or die_error(404, "Unknown commit object");
9093
9094         # choose format for commitdiff for merge
9095         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
9096                 $hash_parent = '--cc';
9097         }
9098         # we need to prepare $formats_nav before almost any parameter munging
9099         my $formats_nav;
9100         if ($format eq 'html') {
9101                 $formats_nav = tabspan(
9102                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
9103                                 "raw"));
9104                 if ($patch_max && @{$co{'parents'}} <= 1) {
9105                         $formats_nav .= $barsep . tabspan(
9106                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
9107                                         "patch"));
9108                 }
9109                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
9110
9111                 if (defined $hash_parent &&
9112                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
9113                         # commitdiff with two commits given
9114                         my $hash_parent_short = $hash_parent;
9115                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
9116                                 $hash_parent_short = substr($hash_parent, 0, 7);
9117                         }
9118                         $formats_nav .= $spcsep . '<span class="parents multiple">' .
9119                                 '(from';
9120                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
9121                                 if ($co{'parents'}[$i] eq $hash_parent) {
9122                                         $formats_nav .= '&#160;parent&#160;' . ($i+1);
9123                                         last;
9124                                 }
9125                         }
9126                         $formats_nav .= ':&#160;' .
9127                                 $cgi->a({-href => href(-replay=>1,
9128                                                        hash=>$hash_parent, hash_base=>undef)},
9129                                         esc_html($hash_parent_short)) .
9130                                 ')</span>';
9131                 } elsif (!$co{'parent'}) {
9132                         # --root commitdiff
9133                         $formats_nav .= $spcsep . '<span class="parents none">(initial)</span>';
9134                 } elsif (scalar @{$co{'parents'}} == 1) {
9135                         # single parent commit
9136                         $formats_nav .= $spcsep .
9137                                 '<span class="parents single">(parent:&#160;' .
9138                                 $cgi->a({-href => href(-replay=>1,
9139                                                        hash=>$co{'parent'}, hash_base=>undef)},
9140                                         esc_html(substr($co{'parent'}, 0, 7))) .
9141                                 ')</span>';
9142                 } else {
9143                         # merge commit
9144                         if ($hash_parent eq '--cc') {
9145                                 $formats_nav .= $barsep . tabspan(
9146                                         $cgi->a({-href => href(-replay=>1,
9147                                                                hash=>$hash, hash_parent=>'-c')},
9148                                                 'combined'));
9149                         } else { # $hash_parent eq '-c'
9150                                 $formats_nav .= $barsep . tabspan(
9151                                         $cgi->a({-href => href(-replay=>1,
9152                                                                hash=>$hash, hash_parent=>'--cc')},
9153                                                 'compact'));
9154                         }
9155                         $formats_nav .= $spcsep .
9156                                 '<span class="parents multiple">(merge:&#160;' .
9157                                 join(' ', map {
9158                                         $cgi->a({-href => href(-replay=>1,
9159                                                                hash=>$_, hash_base=>undef)},
9160                                                 esc_html(substr($_, 0, 7)));
9161                                 } @{$co{'parents'}} ) .
9162                                 ')</span>';
9163                 }
9164         }
9165
9166         my $hash_parent_param = $hash_parent;
9167         if (!defined $hash_parent_param) {
9168                 # --cc for multiple parents, --root for parentless
9169                 $hash_parent_param =
9170                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
9171         }
9172
9173         # read commitdiff
9174         my $fd;
9175         my @difftree;
9176         if ($format eq 'html') {
9177                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9178                         "--no-commit-id", "--patch-with-raw", "--full-index",
9179                         $hash_parent_param, $hash, "--")
9180                         or die_error(500, "Open git-diff-tree failed");
9181
9182                 while (my $line = to_utf8(scalar <$fd>)) {
9183                         chomp $line;
9184                         # empty line ends raw part of diff-tree output
9185                         last unless $line;
9186                         push @difftree, scalar parse_difftree_raw_line($line);
9187                 }
9188
9189         } elsif ($format eq 'plain') {
9190                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9191                         '-p', $hash_parent_param, $hash, "--")
9192                         or die_error(500, "Open git-diff-tree failed");
9193         } elsif ($format eq 'patch') {
9194                 # For commit ranges, we limit the output to the number of
9195                 # patches specified in the 'patches' feature.
9196                 # For single commits, we limit the output to a single patch,
9197                 # diverging from the git-format-patch default.
9198                 my @commit_spec = ();
9199                 if ($hash_parent) {
9200                         if ($patch_max > 0) {
9201                                 push @commit_spec, "-$patch_max";
9202                         }
9203                         push @commit_spec, '-n', "$hash_parent..$hash";
9204                 } else {
9205                         if ($params{-single}) {
9206                                 push @commit_spec, '-1';
9207                         } else {
9208                                 if ($patch_max > 0) {
9209                                         push @commit_spec, "-$patch_max";
9210                                 }
9211                                 push @commit_spec, "-n";
9212                         }
9213                         push @commit_spec, '--root', $hash;
9214                 }
9215                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
9216                         '--encoding=utf8', '--stdout', @commit_spec)
9217                         or die_error(500, "Open git-format-patch failed");
9218         } else {
9219                 die_error(400, "Unknown commitdiff format");
9220         }
9221
9222         # non-textual hash id's can be cached
9223         my $expires;
9224         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
9225                 $expires = "+1d";
9226         }
9227
9228         # write commit message
9229         if ($format eq 'html') {
9230                 my $refs = git_get_references();
9231                 my $ref = format_ref_marker($refs, $co{'id'});
9232
9233                 git_header_html(undef, $expires);
9234                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
9235                 git_print_header_div('commit', esc_html($co{'title'}), $hash, undef, $ref);
9236                 print "<div class=\"title_text\">\n" .
9237                       "<table class=\"object_header\">\n";
9238                 git_print_authorship_rows(\%co);
9239                 print "</table>".
9240                       "</div>\n";
9241                 print "<div class=\"page_body\">\n";
9242                 if (@{$co{'comment'}} > 1) {
9243                         print "<div class=\"log\">\n";
9244                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
9245                         print "</div>\n"; # class="log"
9246                 }
9247
9248         } elsif ($format eq 'plain') {
9249                 my $refs = git_get_references("tags");
9250                 my $tagname = git_get_rev_name_tags($hash);
9251                 my $filename = basename($project) . "-$hash.patch";
9252
9253                 print $cgi->header(
9254                         -type => 'text/plain',
9255                         -charset => 'utf-8',
9256                         -expires => $expires,
9257                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9258                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
9259                 print "From: " . to_utf8($co{'author'}) . "\n";
9260                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
9261                 print "Subject: " . to_utf8($co{'title'}) . "\n";
9262
9263                 print "X-Git-Tag: $tagname\n" if $tagname;
9264                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
9265
9266                 foreach my $line (@{$co{'comment'}}) {
9267                         print to_utf8($line) . "\n";
9268                 }
9269                 print "---\n\n";
9270         } elsif ($format eq 'patch') {
9271                 my $filename = basename($project) . "-$hash.patch";
9272
9273                 print $cgi->header(
9274                         -type => 'text/plain',
9275                         -charset => 'utf-8',
9276                         -expires => $expires,
9277                         -content_disposition => 'inline; filename="' . "$filename" . '"');
9278         }
9279
9280         # write patch
9281         if ($format eq 'html') {
9282                 my $use_parents = !defined $hash_parent ||
9283                         $hash_parent eq '-c' || $hash_parent eq '--cc';
9284                 git_difftree_body(\@difftree, $hash,
9285                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9286                 print "<br/>\n";
9287
9288                 git_patchset_body($fd, $diff_style,
9289                                   \@difftree, $hash,
9290                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
9291                 close $fd;
9292                 print "</div>\n"; # class="page_body"
9293                 git_footer_html();
9294
9295         } elsif ($format eq 'plain') {
9296                 while (<$fd>) {
9297                         print to_utf8($_);
9298                 }
9299                 close $fd
9300                         or print "Reading git-diff-tree failed\n";
9301         } elsif ($format eq 'patch') {
9302                 while (<$fd>) {
9303                         print to_utf8($_);
9304                 }
9305                 close $fd
9306                         or print "Reading git-format-patch failed\n";
9307         }
9308 }
9309
9310 sub git_commitdiff_plain {
9311         git_commitdiff(-format => 'plain');
9312 }
9313
9314 # format-patch-style patches
9315 sub git_patch {
9316         git_commitdiff(-format => 'patch', -single => 1);
9317 }
9318
9319 sub git_patches {
9320         git_commitdiff(-format => 'patch');
9321 }
9322
9323 sub git_history {
9324         git_log_generic('history', \&git_history_body,
9325                         $hash_base, $hash_parent_base,
9326                         $file_name, $hash);
9327 }
9328
9329 sub git_search {
9330         $searchtype ||= 'commit';
9331
9332         # check if appropriate features are enabled
9333         gitweb_check_feature('search')
9334                 or die_error(403, "Search is disabled");
9335         if ($searchtype eq 'pickaxe') {
9336                 # pickaxe may take all resources of your box and run for several minutes
9337                 # with every query - so decide by yourself how public you make this feature
9338                 gitweb_check_feature('pickaxe')
9339                         or die_error(403, "Pickaxe search is disabled");
9340         }
9341         if ($searchtype eq 'grep') {
9342                 # grep search might be potentially CPU-intensive, too
9343                 gitweb_check_feature('grep')
9344                         or die_error(403, "Grep search is disabled");
9345         }
9346
9347         if (!defined $searchtext) {
9348                 die_error(400, "Text field is empty");
9349         }
9350         if (!defined $hash) {
9351                 $hash = git_get_head_hash($project);
9352         }
9353         my %co = parse_commit($hash);
9354         if (!%co) {
9355                 die_error(404, "Unknown commit object");
9356         }
9357         if (!defined $page) {
9358                 $page = 0;
9359         }
9360
9361         if ($searchtype eq 'commit' ||
9362             $searchtype eq 'author' ||
9363             $searchtype eq 'committer') {
9364                 git_search_message(%co);
9365         } elsif ($searchtype eq 'pickaxe') {
9366                 git_search_changes(%co);
9367         } elsif ($searchtype eq 'grep') {
9368                 git_search_files(%co);
9369         } else {
9370                 die_error(400, "Unknown search type");
9371         }
9372 }
9373
9374 sub git_search_help {
9375         git_header_html();
9376         git_print_page_nav('','', $hash,$hash,$hash);
9377         print <<EOT;
9378 <div class="search_help">
9379 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
9380 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
9381 the pattern entered is recognized as the POSIX extended
9382 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
9383 insensitive).</p>
9384 <dl>
9385 <dt><b>commit</b></dt>
9386 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
9387 EOT
9388         my $have_grep = gitweb_check_feature('grep');
9389         if ($have_grep) {
9390                 print <<EOT;
9391 <dt><b>grep</b></dt>
9392 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
9393     a different one) are searched for the given pattern. On large trees, this search can take
9394 a while and put some strain on the server, so please use it with some consideration. Note that
9395 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
9396 case-sensitive.</dd>
9397 EOT
9398         }
9399         print <<EOT;
9400 <dt><b>author</b></dt>
9401 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
9402 <dt><b>committer</b></dt>
9403 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
9404 EOT
9405         my $have_pickaxe = gitweb_check_feature('pickaxe');
9406         if ($have_pickaxe) {
9407                 print <<EOT;
9408 <dt><b>pickaxe</b></dt>
9409 <dd>All commits that caused the string to appear or disappear from any file (changes that
9410 added, removed or "modified" the string) will be listed. This search can take a while and
9411 takes a lot of strain on the server, so please use it wisely. Note that since you may be
9412 interested even in changes just changing the case as well, this search is case sensitive.</dd>
9413 EOT
9414         }
9415         print "</dl>\n</div>\n";
9416         git_footer_html();
9417 }
9418
9419 sub git_shortlog {
9420         git_log_generic('shortlog', \&git_shortlog_body,
9421                         $hash, $hash_parent);
9422 }
9423
9424 ## ......................................................................
9425 ## feeds (RSS, Atom; OPML)
9426
9427 sub git_feed {
9428         my $format = shift || 'atom';
9429         my $have_blame = gitweb_check_feature('blame');
9430
9431         # Atom: http://www.atomenabled.org/developers/syndication/
9432         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
9433         if ($format ne 'rss' && $format ne 'atom') {
9434                 die_error(400, "Unknown web feed format");
9435         }
9436
9437         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
9438         my $head = $hash || 'HEAD';
9439         my @commitlist = parse_commits($head, 150, 0, $file_name);
9440
9441         my %latest_commit;
9442         my %latest_date;
9443         my $content_type = "application/$format+xml";
9444         if (defined $cgi->http('HTTP_ACCEPT') &&
9445                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
9446                 # browser (feed reader) prefers text/xml
9447                 $content_type = 'text/xml';
9448         }
9449         if (defined($commitlist[0])) {
9450                 %latest_commit = %{$commitlist[0]};
9451                 my $latest_epoch = $latest_commit{'committer_epoch'};
9452                 exit_if_unmodified_since($latest_epoch);
9453                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
9454         }
9455         print $cgi->header(
9456                 -type => $content_type,
9457                 -charset => 'utf-8',
9458                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
9459                 -status => '200 OK');
9460
9461         # Optimization: skip generating the body if client asks only
9462         # for Last-Modified date.
9463         return if ($cgi->request_method() eq 'HEAD');
9464
9465         # header variables
9466         my $title = "$site_name - $project/$action";
9467         my $feed_type = 'log';
9468         if (defined $hash) {
9469                 $title .= " - '$hash'";
9470                 $feed_type = 'branch log';
9471                 if (defined $file_name) {
9472                         $title .= " :: $file_name";
9473                         $feed_type = 'history';
9474                 }
9475         } elsif (defined $file_name) {
9476                 $title .= " - $file_name";
9477                 $feed_type = 'history';
9478         }
9479         $title .= " $feed_type";
9480         $title = esc_html($title);
9481         my $descr = git_get_project_description($project);
9482         if (defined $descr) {
9483                 $descr = esc_html($descr);
9484         } else {
9485                 $descr = "$project " .
9486                          ($format eq 'rss' ? 'RSS' : 'Atom') .
9487                          " feed";
9488         }
9489         my $owner = git_get_project_owner($project);
9490         $owner = esc_html($owner);
9491
9492         #header
9493         my $alt_url;
9494         if (defined $file_name) {
9495                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
9496         } elsif (defined $hash) {
9497                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
9498         } else {
9499                 $alt_url = href(-full=>1, action=>"summary");
9500         }
9501         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
9502         if ($format eq 'rss') {
9503                 print <<XML;
9504 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
9505 <channel>
9506 XML
9507                 print "<title>$title</title>\n" .
9508                       "<link>$alt_url</link>\n" .
9509                       "<description>$descr</description>\n" .
9510                       "<language>en</language>\n" .
9511                       # project owner is responsible for 'editorial' content
9512                       "<managingEditor>$owner</managingEditor>\n";
9513                 if (defined $logo || defined $favicon) {
9514                         # prefer the logo to the favicon, since RSS
9515                         # doesn't allow both
9516                         my $img = esc_url($logo || $favicon);
9517                         print "<image>\n" .
9518                               "<url>$img</url>\n" .
9519                               "<title>$title</title>\n" .
9520                               "<link>$alt_url</link>\n" .
9521                               "</image>\n";
9522                 }
9523                 if (%latest_date) {
9524                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
9525                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
9526                 }
9527                 print "<generator>gitweb v.$version/$git_version</generator>\n";
9528         } elsif ($format eq 'atom') {
9529                 print <<XML;
9530 <feed xmlns="http://www.w3.org/2005/Atom">
9531 XML
9532                 print "<title>$title</title>\n" .
9533                       "<subtitle>$descr</subtitle>\n" .
9534                       '<link rel="alternate" type="text/html" href="' .
9535                       $alt_url . '" />' . "\n" .
9536                       '<link rel="self" type="' . $content_type . '" href="' .
9537                       $cgi->self_url() . '" />' . "\n" .
9538                       "<id>" . href(-full=>1) . "</id>\n" .
9539                       # use project owner for feed author
9540                       '<author><name>'. email_obfuscate($owner) . '</name></author>\n';
9541                 if (defined $favicon) {
9542                         print "<icon>" . esc_url($favicon) . "</icon>\n";
9543                 }
9544                 if (defined $logo) {
9545                         # not twice as wide as tall: 72 x 27 pixels
9546                         print "<logo>" . esc_url($logo) . "</logo>\n";
9547                 }
9548                 if (! %latest_date) {
9549                         # dummy date to keep the feed valid until commits trickle in:
9550                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
9551                 } else {
9552                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
9553                 }
9554                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
9555         }
9556
9557         # contents
9558         for (my $i = 0; $i <= $#commitlist; $i++) {
9559                 my %co = %{$commitlist[$i]};
9560                 my $commit = $co{'id'};
9561                 # we read 150, we always show 30 and the ones more recent than 48 hours
9562                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
9563                         last;
9564                 }
9565                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
9566
9567                 # get list of changed files
9568                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
9569                         $co{'parent'} || "--root",
9570                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
9571                         or next;
9572                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
9573                 close $fd
9574                         or next;
9575
9576                 # print element (entry, item)
9577                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
9578                 if ($format eq 'rss') {
9579                         print "<item>\n" .
9580                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
9581                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
9582                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
9583                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
9584                               "<link>$co_url</link>\n" .
9585                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
9586                               "<content:encoded>" .
9587                               "<![CDATA[\n";
9588                 } elsif ($format eq 'atom') {
9589                         print "<entry>\n" .
9590                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
9591                               "<updated>$cd{'iso-8601'}</updated>\n" .
9592                               "<author>\n" .
9593                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
9594                         if ($co{'author_email'}) {
9595                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
9596                         }
9597                         print "</author>\n" .
9598                               # use committer for contributor
9599                               "<contributor>\n" .
9600                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
9601                         if ($co{'committer_email'}) {
9602                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
9603                         }
9604                         print "</contributor>\n" .
9605                               "<published>$cd{'iso-8601'}</published>\n" .
9606                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
9607                               "<id>$co_url</id>\n" .
9608                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
9609                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
9610                 }
9611                 my $comment = $co{'comment'};
9612                 print "<pre>\n";
9613                 foreach my $line (@$comment) {
9614                         $line = esc_html($line);
9615                         print "$line\n";
9616                 }
9617                 print "</pre><ul>\n";
9618                 foreach my $difftree_line (@difftree) {
9619                         my %difftree = parse_difftree_raw_line($difftree_line);
9620                         next if !$difftree{'from_id'};
9621
9622                         my $file = $difftree{'file'} || $difftree{'to_file'};
9623
9624                         print "<li>" .
9625                               "[" .
9626                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
9627                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
9628                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
9629                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
9630                                       -title => "diff"}, 'D');
9631                         if ($have_blame) {
9632                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
9633                                                              file_name=>$file, hash_base=>$commit),
9634                                               -class => "blamelink",
9635                                               -title => "blame"}, 'B');
9636                         }
9637                         # if this is not a feed of a file history
9638                         if (!defined $file_name || $file_name ne $file) {
9639                                 print $cgi->a({-href => href(-full=>1, action=>"history",
9640                                                              file_name=>$file, hash=>$commit),
9641                                               -title => "history"}, 'H');
9642                         }
9643                         $file = esc_path($file);
9644                         print "] ".
9645                               "$file</li>\n";
9646                 }
9647                 if ($format eq 'rss') {
9648                         print "</ul>]]>\n" .
9649                               "</content:encoded>\n" .
9650                               "</item>\n";
9651                 } elsif ($format eq 'atom') {
9652                         print "</ul>\n</div>\n" .
9653                               "</content>\n" .
9654                               "</entry>\n";
9655                 }
9656         }
9657
9658         # end of feed
9659         if ($format eq 'rss') {
9660                 print "</channel>\n</rss>\n";
9661         } elsif ($format eq 'atom') {
9662                 print "</feed>\n";
9663         }
9664 }
9665
9666 sub git_rss {
9667         git_feed('rss');
9668 }
9669
9670 sub git_atom {
9671         git_feed('atom');
9672 }
9673
9674 sub git_opml {
9675         my @list = git_get_projects_list($project_filter, $strict_export);
9676         if (!@list) {
9677                 die_error(404, "No projects found");
9678         }
9679
9680         print $cgi->header(
9681                 -type => 'text/xml',
9682                 -charset => 'utf-8',
9683                 -content_disposition => 'inline; filename="opml.xml"');
9684
9685         my $title = esc_html($site_name);
9686         my $filter = " within subdirectory ";
9687         if (defined $project_filter) {
9688                 $filter .= esc_html($project_filter);
9689         } else {
9690                 $filter = "";
9691         }
9692         print <<XML;
9693 <?xml version="1.0" encoding="utf-8"?>
9694 <opml version="1.0">
9695 <head>
9696   <title>$title OPML Export$filter</title>
9697 </head>
9698 <body>
9699 <outline text="git RSS feeds">
9700 XML
9701
9702         foreach my $pr (@list) {
9703                 my %proj = %$pr;
9704                 my $head = git_get_head_hash($proj{'path'});
9705                 if (!defined $head) {
9706                         next;
9707                 }
9708                 $git_dir = "$projectroot/$proj{'path'}";
9709                 my %co = parse_commit($head);
9710                 if (!%co) {
9711                         next;
9712                 }
9713
9714                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9715                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9716                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9717                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9718         }
9719         print <<XML;
9720 </outline>
9721 </body>
9722 </opml>
9723 XML
9724 }