gitweb/gitweb.perl

   1 #!/usr/bin/perl
   2
   3 # gitweb - simple web interface to track changes in git repositories
   4 #
   5 # (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
   6 # (C) 2005, Christian Gierke
   7 #
   8 # This program is licensed under the GPLv2
   9
  10 use 5.008;
  11 use strict;
  12 use warnings;
  13 use CGI qw(:standard :escapeHTML -nosticky);
  14 use CGI::Util qw(unescape);
  15 use CGI::Carp qw(fatalsToBrowser set_message);
  16 use Encode;
  17 use Fcntl ':mode';
  18 use File::Find qw();
  19 use File::Basename qw(basename);
  20 use File::Spec;
  21 use Time::HiRes qw(gettimeofday tv_interval);
  22 use Time::Local;
  23 use constant GITWEB_CACHE_FORMAT => "Gitweb Cache Format 3";
  24 binmode STDOUT, ':utf8';
  25
  26 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
  27         eval 'sub CGI::multi_param { CGI::param(@_) }'
  28 }
  29
  30 our $t0 = [ gettimeofday() ];
  31 our $number_of_git_cmds = 0;
  32
  33 BEGIN {
  34         CGI->compile() if $ENV{'MOD_PERL'};
  35 }
  36
  37 our $version = "++GIT_VERSION++";
  38
  39 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
  40 sub evaluate_uri {
  41         our $cgi;
  42
  43         our $my_url = $cgi->url();
  44         our $my_uri = $cgi->url(-absolute => 1);
  45
  46         # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
  47         # needed and used only for URLs with nonempty PATH_INFO
  48         our $base_url = $my_url;
  49
  50         # When the script is used as DirectoryIndex, the URL does not contain the name
  51         # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
  52         # have to do it ourselves. We make $path_info global because it's also used
  53         # later on.
  54         #
  55         # Another issue with the script being the DirectoryIndex is that the resulting
  56         # $my_url data is not the full script URL: this is good, because we want
  57         # generated links to keep implying the script name if it wasn't explicitly
  58         # indicated in the URL we're handling, but it means that $my_url cannot be used
  59         # as base URL.
  60         # Therefore, if we needed to strip PATH_INFO, then we know that we have
  61         # to build the base URL ourselves:
  62         our $path_info = decode_utf8($ENV{"PATH_INFO"});
  63         if ($path_info) {
  64                 # $path_info has already been URL-decoded by the web server, but
  65                 # $my_url and $my_uri have not. URL-decode them so we can properly
  66                 # strip $path_info.
  67                 $my_url = unescape($my_url);
  68                 $my_uri = unescape($my_uri);
  69                 if ($my_url =~ s,\Q$path_info\E$,, &&
  70                     $my_uri =~ s,\Q$path_info\E$,, &&
  71                     defined $ENV{'SCRIPT_NAME'}) {
  72                         $base_url = $cgi->url(-base => 1) . $ENV{'SCRIPT_NAME'};
  73                 }
  74         }
  75
  76         # target of the home link on top of all pages
  77         our $home_link = $my_uri || "/";
  78 }
  79
  80 # core git executable to use
  81 # this can just be "git" if your webserver has a sensible PATH
  82 our $GIT = "++GIT_BINDIR++/git";
  83
  84 # absolute fs-path which will be prepended to the project path
  85 #our $projectroot = "/pub/scm";
  86 our $projectroot = "++GITWEB_PROJECTROOT++";
  87
  88 # fs traversing limit for getting project list
  89 # the number is relative to the projectroot
  90 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
  91
  92 # string of the home link on top of all pages
  93 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
  94
  95 # extra breadcrumbs preceding the home link
  96 our @extra_breadcrumbs = ();
  97
  98 # name of your site or organization to appear in page titles
  99 # replace this with something more descriptive for clearer bookmarks
 100 our $site_name = "++GITWEB_SITENAME++"
 101                  || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
 102
 103 # html snippet to include in the <head> section of each page
 104 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
 105 # filename of html text to include at top of each page
 106 our $site_header = "++GITWEB_SITE_HEADER++";
 107 # html text to include at home page
 108 our $home_text = "++GITWEB_HOMETEXT++";
 109 # filename of html text to include at bottom of each page
 110 our $site_footer = "++GITWEB_SITE_FOOTER++";
 111
 112 # URI of stylesheets
 113 our @stylesheets = ("++GITWEB_CSS++");
 114 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
 115 our $stylesheet = undef;
 116 # URI of GIT logo (72x27 size)
 117 our $logo = "++GITWEB_LOGO++";
 118 # URI of GIT favicon, assumed to be image/png type
 119 our $favicon = "++GITWEB_FAVICON++";
 120 # URI of gitweb.js (JavaScript code for gitweb)
 121 our $javascript = "++GITWEB_JS++";
 122
 123 # URI and label (title) of GIT logo link
 124 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
 125 #our $logo_label = "git documentation";
 126 our $logo_url = "http://git-scm.com/";
 127 our $logo_label = "git homepage";
 128
 129 # source of projects list
 130 our $projects_list = "++GITWEB_LIST++";
 131
 132 # the width (in characters) of the projects list "Description" column
 133 our $projects_list_description_width = 25;
 134
 135 # group projects by category on the projects list
 136 # (enabled if this variable evaluates to true)
 137 our $projects_list_group_categories = 0;
 138
 139 # default category if none specified
 140 # (leave the empty string for no category)
 141 our $project_list_default_category = "";
 142
 143 # default order of projects list
 144 # valid values are none, project, descr, owner, and age
 145 our $default_projects_order = "project";
 146
 147 # show repository only if this file exists
 148 # (only effective if this variable evaluates to true)
 149 our $export_ok = "++GITWEB_EXPORT_OK++";
 150
 151 # don't generate age column on the projects list page
 152 our $omit_age_column = 0;
 153
 154 # use contents of this file (in iso, iso-strict or raw format) as
 155 # the last activity data if it exists and is a valid date
 156 our $lastactivity_file = undef;
 157
 158 # don't generate information about owners of repositories
 159 our $omit_owner=0;
 160
 161 # show repository only if this subroutine returns true
 162 # when given the path to the project, for example:
 163 #    sub { return -e "$_[0]/git-daemon-export-ok"; }
 164 our $export_auth_hook = undef;
 165
 166 # only allow viewing of repositories also shown on the overview page
 167 our $strict_export = "++GITWEB_STRICT_EXPORT++";
 168
 169 # list of git base URLs used for URL to where fetch project from,
 170 # i.e. full URL is "$git_base_url/$project"
 171 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
 172
 173 # default blob_plain mimetype and default charset for text/plain blob
 174 our $default_blob_plain_mimetype = 'text/plain';
 175 our $default_text_plain_charset  = undef;
 176
 177 # file to use for guessing MIME types before trying /etc/mime.types
 178 # (relative to the current git repository)
 179 our $mimetypes_file = undef;
 180
 181 # assume this charset if line contains non-UTF-8 characters;
 182 # it should be valid encoding (see Encoding::Supported(3pm) for list),
 183 # for which encoding all byte sequences are valid, for example
 184 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
 185 # could be even 'utf-8' for the old behavior)
 186 our $fallback_encoding = 'latin1';
 187
 188 # rename detection options for git-diff and git-diff-tree
 189 # - default is '-M', with the cost proportional to
 190 #   (number of removed files) * (number of new files).
 191 # - more costly is '-C' (which implies '-M'), with the cost proportional to
 192 #   (number of changed files + number of removed files) * (number of new files)
 193 # - even more costly is '-C', '--find-copies-harder' with cost
 194 #   (number of files in the original tree) * (number of new files)
 195 # - one might want to include '-B' option, e.g. '-B', '-M'
 196 our @diff_opts = ('-M'); # taken from git_commit
 197
 198 # Disables features that would allow repository owners to inject script into
 199 # the gitweb domain.
 200 our $prevent_xss = 0;
 201
 202 # Path to a POSIX shell.  Needed to run $highlight_bin and a snapshot compressor.
 203 # Only used when highlight is enabled or snapshots with compressors are enabled.
 204 our $posix_shell_bin = "++POSIX_SHELL_BIN++";
 205
 206 # Path to the highlight executable to use (must be the one from
 207 # http://www.andre-simon.de due to assumptions about parameters and output).
 208 # Useful if highlight is not installed on your webserver's PATH.
 209 # [Default: highlight]
 210 our $highlight_bin = "++HIGHLIGHT_BIN++";
 211
 212 # Whether to include project list on the gitweb front page; 0 means yes,
 213 # 1 means no list but show tag cloud if enabled (all projects still need
 214 # to be scanned, unless the info is cached), 2 means no list and no tag cloud
 215 # (very fast)
 216 our $frontpage_no_project_list = 0;
 217
 218 # projects list cache for busy sites with many projects;
 219 # if you set this to non-zero, it will be used as the cached
 220 # index lifetime in minutes
 221 #
 222 # the cached list version is stored in $cache_dir/$cache_name and can
 223 # be tweaked by other scripts running with the same uid as gitweb -
 224 # use this ONLY at secure installations; only single gitweb project
 225 # root per system is supported, unless you tweak configuration!
 226 our $projlist_cache_lifetime = 0; # in minutes
 227 # FHS compliant $cache_dir would be "/var/cache/gitweb"
 228 our $cache_dir =
 229         (defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : '/tmp').'/gitweb';
 230 our $projlist_cache_name = 'gitweb.index.cache';
 231 our $cache_grpshared = 0;
 232
 233 # information about snapshot formats that gitweb is capable of serving
 234 our %known_snapshot_formats = (
 235         # name => {
 236         #       'display' => display name,
 237         #       'type' => mime type,
 238         #       'suffix' => filename suffix,
 239         #       'format' => --format for git-archive,
 240         #       'compressor' => [compressor command and arguments]
 241         #                       (array reference, optional)
 242         #       'disabled' => boolean (optional)}
 243         #
 244         'tgz' => {
 245                 'display' => 'tar.gz',
 246                 'type' => 'application/x-gzip',
 247                 'suffix' => '.tar.gz',
 248                 'format' => 'tar',
 249                 'compressor' => ['gzip', '-n']},
 250
 251         'tbz2' => {
 252                 'display' => 'tar.bz2',
 253                 'type' => 'application/x-bzip2',
 254                 'suffix' => '.tar.bz2',
 255                 'format' => 'tar',
 256                 'compressor' => ['bzip2']},
 257
 258         'txz' => {
 259                 'display' => 'tar.xz',
 260                 'type' => 'application/x-xz',
 261                 'suffix' => '.tar.xz',
 262                 'format' => 'tar',
 263                 'compressor' => ['xz'],
 264                 'disabled' => 1},
 265
 266         'zip' => {
 267                 'display' => 'zip',
 268                 'type' => 'application/x-zip',
 269                 'suffix' => '.zip',
 270                 'format' => 'zip'},
 271 );
 272
 273 # Aliases so we understand old gitweb.snapshot values in repository
 274 # configuration.
 275 our %known_snapshot_format_aliases = (
 276         'gzip'  => 'tgz',
 277         'bzip2' => 'tbz2',
 278         'xz'    => 'txz',
 279
 280         # backward compatibility: legacy gitweb config support
 281         'x-gzip' => undef, 'gz' => undef,
 282         'x-bzip2' => undef, 'bz2' => undef,
 283         'x-zip' => undef, '' => undef,
 284 );
 285
 286 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
 287 # are changed, it may be appropriate to change these values too via
 288 # $GITWEB_CONFIG.
 289 our %avatar_size = (
 290         'default' => 16,
 291         'double'  => 32
 292 );
 293
 294 # Used to set the maximum load that we will still respond to gitweb queries.
 295 # If server load exceed this value then return "503 server busy" error.
 296 # If gitweb cannot determined server load, it is taken to be 0.
 297 # Leave it undefined (or set to 'undef') to turn off load checking.
 298 our $maxload = 300;
 299
 300 # configuration for 'highlight' (http://www.andre-simon.de/)
 301 # match by basename
 302 our %highlight_basename = (
 303         #'Program' => 'py',
 304         #'Library' => 'py',
 305         'SConstruct' => 'py', # SCons equivalent of Makefile
 306         'Makefile' => 'make',
 307         'makefile' => 'make',
 308         'GNUmakefile' => 'make',
 309         'BSDmakefile' => 'make',
 310 );
 311 # match by shebang regex
 312 our %highlight_shebang = (
 313         # Each entry has a key which is the syntax to use and
 314         # a value which is either a qr regex or an array of qr regexs to match
 315         # against the first 128 (less if the blob is shorter) BYTES of the blob.
 316         # We match /usr/bin/env items separately to require "/usr/bin/env" and
 317         # allow a limited subset of NAME=value items to appear.
 318         'awk'    => [ qr,^#!\s*/(?:\w+/)*(?:[gnm]?awk)(?:\s|$),mo,
 319                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[gnm]?awk)(?:\s|$),mo ],
 320         'make'   => [ qr,^#!\s*/(?:\w+/)*(?:g?make)(?:\s|$),mo,
 321                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:g?make)(?:\s|$),mo ],
 322         'php'    => [ qr,^#!\s*/(?:\w+/)*(?:php)(?:\s|$),mo,
 323                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:php)(?:\s|$),mo ],
 324         'pl'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 325                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 326         'py'     => [ qr,^#!\s*/(?:\w+/)*(?:python)(?:\s|$),mo,
 327                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:python)(?:\s|$),mo ],
 328         'sh'     => [ qr,^#!\s*/(?:\w+/)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo,
 329                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:[bd]ash|t?csh|[akz]?sh)(?:\s|$),mo ],
 330         'rb'     => [ qr,^#!\s*/(?:\w+/)*(?:perl)(?:\s|$),mo,
 331                       qr,^#!\s*/usr/bin/env\s+(?:\w+=\w*\s+)*(?:perl)(?:\s|$),mo ],
 332 );
 333 # match by extension
 334 our %highlight_ext = (
 335         # main extensions, defining name of syntax;
 336         # see files in /usr/share/highlight/langDefs/ directory
 337         (map { $_ => $_ } qw(
 338                 4gl a4c abnf abp ada agda ahk ampl amtrix applescript arc
 339                 arm as asm asp aspect ats au3 avenue awk bat bb bbcode bib
 340                 bms bnf boo c cb cfc chl clipper clojure clp cob cs css d
 341                 diff dot dylan e ebnf erl euphoria exp f90 flx for frink fs
 342                 go haskell hcl html httpd hx icl icn idl idlang ili
 343                 inc_luatex ini inp io iss j java js jsp lbn ldif lgt lhs
 344                 lisp lotos ls lsl lua ly make mel mercury mib miranda ml mo
 345                 mod2 mod3 mpl ms mssql n nas nbc nice nrx nsi nut nxc oberon
 346                 objc octave oorexx os oz pas php pike pl pl1 pov pro
 347                 progress ps ps1 psl pure py pyx q qmake qu r rb rebol rexx
 348                 rnc s sas sc scala scilab sh sma smalltalk sml sno spec spn
 349                 sql sybase tcl tcsh tex ttcn3 vala vb verilog vhd xml xpp y
 350                 yaiff znn)),
 351         # alternate extensions, see /etc/highlight/filetypes.conf
 352         (map { $_ => '4gl' } qw(informix)),
 353         (map { $_ => 'a4c' } qw(ascend)),
 354         (map { $_ => 'abp' } qw(abp4)),
 355         (map { $_ => 'ada' } qw(a adb ads gnad)),
 356         (map { $_ => 'ahk' } qw(autohotkey)),
 357         (map { $_ => 'ampl' } qw(dat run)),
 358         (map { $_ => 'amtrix' } qw(hnd s4 s4h s4t t4)),
 359         (map { $_ => 'as' } qw(actionscript)),
 360         (map { $_ => 'asm' } qw(29k 68s 68x a51 assembler x68 x86)),
 361         (map { $_ => 'asp' } qw(asa)),
 362         (map { $_ => 'aspect' } qw(was wud)),
 363         (map { $_ => 'ats' } qw(dats)),
 364         (map { $_ => 'au3' } qw(autoit)),
 365         (map { $_ => 'bat' } qw(cmd)),
 366         (map { $_ => 'bb' } qw(blitzbasic)),
 367         (map { $_ => 'bib' } qw(bibtex)),
 368         (map { $_ => 'c' } qw(c++ cc cpp cu cxx h hh hpp hxx)),
 369         (map { $_ => 'cb' } qw(clearbasic)),
 370         (map { $_ => 'cfc' } qw(cfm coldfusion)),
 371         (map { $_ => 'chl' } qw(chill)),
 372         (map { $_ => 'cob' } qw(cbl cobol)),
 373         (map { $_ => 'cs' } qw(csharp)),
 374         (map { $_ => 'diff' } qw(patch)),
 375         (map { $_ => 'dot' } qw(graphviz)),
 376         (map { $_ => 'e' } qw(eiffel se)),
 377         (map { $_ => 'erl' } qw(erlang hrl)),
 378         (map { $_ => 'euphoria' } qw(eu ew ex exu exw wxu)),
 379         (map { $_ => 'exp' } qw(express)),
 380         (map { $_ => 'f90' } qw(f95)),
 381         (map { $_ => 'flx' } qw(felix)),
 382         (map { $_ => 'for' } qw(f f77 ftn)),
 383         (map { $_ => 'fs' } qw(fsharp fsx)),
 384         (map { $_ => 'haskell' } qw(hs)),
 385         (map { $_ => 'html' } qw(htm xhtml)),
 386         (map { $_ => 'hx' } qw(haxe)),
 387         (map { $_ => 'icl' } qw(clean)),
 388         (map { $_ => 'icn' } qw(icon)),
 389         (map { $_ => 'ili' } qw(interlis)),
 390         (map { $_ => 'inp' } qw(fame)),
 391         (map { $_ => 'iss' } qw(innosetup)),
 392         (map { $_ => 'j' } qw(jasmin)),
 393         (map { $_ => 'java' } qw(groovy grv)),
 394         (map { $_ => 'lbn' } qw(luban)),
 395         (map { $_ => 'lgt' } qw(logtalk)),
 396         (map { $_ => 'lisp' } qw(cl clisp el lsp sbcl scom)),
 397         (map { $_ => 'ls' } qw(lotus)),
 398         (map { $_ => 'lsl' } qw(lindenscript)),
 399         (map { $_ => 'ly' } qw(lilypond)),
 400         (map { $_ => 'make' } qw(mak mk kmk)),
 401         (map { $_ => 'mel' } qw(maya)),
 402         (map { $_ => 'mib' } qw(smi snmp)),
 403         (map { $_ => 'ml' } qw(mli ocaml)),
 404         (map { $_ => 'mo' } qw(modelica)),
 405         (map { $_ => 'mod2' } qw(def mod)),
 406         (map { $_ => 'mod3' } qw(i3 m3)),
 407         (map { $_ => 'mpl' } qw(maple)),
 408         (map { $_ => 'n' } qw(nemerle)),
 409         (map { $_ => 'nas' } qw(nasal)),
 410         (map { $_ => 'nrx' } qw(netrexx)),
 411         (map { $_ => 'nsi' } qw(nsis)),
 412         (map { $_ => 'nut' } qw(squirrel)),
 413         (map { $_ => 'oberon' } qw(ooc)),
 414         (map { $_ => 'objc' } qw(M m mm)),
 415         (map { $_ => 'php' } qw(php3 php4 php5 php6)),
 416         (map { $_ => 'pike' } qw(pmod)),
 417         (map { $_ => 'pl' } qw(perl plex plx pm)),
 418         (map { $_ => 'pl1' } qw(bdy ff fp fpp rpp sf sp spb spe spp sps wf wp wpb wpp wps)),
 419         (map { $_ => 'progress' } qw(i p w)),
 420         (map { $_ => 'py' } qw(python)),
 421         (map { $_ => 'pyx' } qw(pyrex)),
 422         (map { $_ => 'rb' } qw(pp rjs ruby)),
 423         (map { $_ => 'rexx' } qw(rex rx the)),
 424         (map { $_ => 'sc' } qw(paradox)),
 425         (map { $_ => 'scilab' } qw(sce sci)),
 426         (map { $_ => 'sh' } qw(bash ebuild eclass ksh zsh)),
 427         (map { $_ => 'sma' } qw(small)),
 428         (map { $_ => 'smalltalk' } qw(gst sq st)),
 429         (map { $_ => 'sno' } qw(snobal)),
 430         (map { $_ => 'sybase' } qw(sp)),
 431         (map { $_ => 'tcl' } qw(itcl wish)),
 432         (map { $_ => 'tex' } qw(cls sty)),
 433         (map { $_ => 'vb' } qw(bas basic bi vbs)),
 434         (map { $_ => 'verilog' } qw(v)),
 435         (map { $_ => 'xml' } qw(dtd ecf ent hdr hub jnlp nrm plist resx sgm sgml svg tld vxml wml xsd xsl)),
 436         (map { $_ => 'y' } qw(bison)),
 437 );
 438
 439 # You define site-wide feature defaults here; override them with
 440 # $GITWEB_CONFIG as necessary.
 441 our %feature = (
 442         # feature => {
 443         #       'sub' => feature-sub (subroutine),
 444         #       'override' => allow-override (boolean),
 445         #       'default' => [ default options...] (array reference)}
 446         #
 447         # if feature is overridable (it means that allow-override has true value),
 448         # then feature-sub will be called with default options as parameters;
 449         # return value of feature-sub indicates if to enable specified feature
 450         #
 451         # if there is no 'sub' key (no feature-sub), then feature cannot be
 452         # overridden
 453         #
 454         # use gitweb_get_feature(<feature>) to retrieve the <feature> value
 455         # (an array) or gitweb_check_feature(<feature>) to check if <feature>
 456         # is enabled
 457
 458         # Enable the 'blame' blob view, showing the last commit that modified
 459         # each line in the file. This can be very CPU-intensive.
 460
 461         # To enable system wide have in $GITWEB_CONFIG
 462         # $feature{'blame'}{'default'} = [1];
 463         # To have project specific config enable override in $GITWEB_CONFIG
 464         # $feature{'blame'}{'override'} = 1;
 465         # and in project config gitweb.blame = 0|1;
 466         'blame' => {
 467                 'sub' => sub { feature_bool('blame', @_) },
 468                 'override' => 0,
 469                 'default' => [0]},
 470
 471         # Enable the 'snapshot' link, providing a compressed archive of any
 472         # tree. This can potentially generate high traffic if you have large
 473         # project.
 474
 475         # Value is a list of formats defined in %known_snapshot_formats that
 476         # you wish to offer.
 477         # To disable system wide have in $GITWEB_CONFIG
 478         # $feature{'snapshot'}{'default'} = [];
 479         # To have project specific config enable override in $GITWEB_CONFIG
 480         # $feature{'snapshot'}{'override'} = 1;
 481         # and in project config, a comma-separated list of formats or "none"
 482         # to disable.  Example: gitweb.snapshot = tbz2,zip;
 483         'snapshot' => {
 484                 'sub' => \&feature_snapshot,
 485                 'override' => 0,
 486                 'default' => ['tgz']},
 487
 488         # Enable text search, which will list the commits which match author,
 489         # committer or commit text to a given string.  Enabled by default.
 490         # Project specific override is not supported.
 491         #
 492         # Note that this controls all search features, which means that if
 493         # it is disabled, then 'grep' and 'pickaxe' search would also be
 494         # disabled.
 495         'search' => {
 496                 'override' => 0,
 497                 'default' => [1]},
 498
 499         # Enable grep search, which will list the files in currently selected
 500         # tree containing the given string. Enabled by default. This can be
 501         # potentially CPU-intensive, of course.
 502         # Note that you need to have 'search' feature enabled too.
 503
 504         # To enable system wide have in $GITWEB_CONFIG
 505         # $feature{'grep'}{'default'} = [1];
 506         # To have project specific config enable override in $GITWEB_CONFIG
 507         # $feature{'grep'}{'override'} = 1;
 508         # and in project config gitweb.grep = 0|1;
 509         'grep' => {
 510                 'sub' => sub { feature_bool('grep', @_) },
 511                 'override' => 0,
 512                 'default' => [1]},
 513
 514         # Enable the pickaxe search, which will list the commits that modified
 515         # a given string in a file. This can be practical and quite faster
 516         # alternative to 'blame', but still potentially CPU-intensive.
 517         # Note that you need to have 'search' feature enabled too.
 518
 519         # To enable system wide have in $GITWEB_CONFIG
 520         # $feature{'pickaxe'}{'default'} = [1];
 521         # To have project specific config enable override in $GITWEB_CONFIG
 522         # $feature{'pickaxe'}{'override'} = 1;
 523         # and in project config gitweb.pickaxe = 0|1;
 524         'pickaxe' => {
 525                 'sub' => sub { feature_bool('pickaxe', @_) },
 526                 'override' => 0,
 527                 'default' => [1]},
 528
 529         # Enable showing size of blobs in a 'tree' view, in a separate
 530         # column, similar to what 'ls -l' does.  This cost a bit of IO.
 531
 532         # To disable system wide have in $GITWEB_CONFIG
 533         # $feature{'show-sizes'}{'default'} = [0];
 534         # To have project specific config enable override in $GITWEB_CONFIG
 535         # $feature{'show-sizes'}{'override'} = 1;
 536         # and in project config gitweb.showsizes = 0|1;
 537         'show-sizes' => {
 538                 'sub' => sub { feature_bool('showsizes', @_) },
 539                 'override' => 0,
 540                 'default' => [1]},
 541
 542         # Make gitweb use an alternative format of the URLs which can be
 543         # more readable and natural-looking: project name is embedded
 544         # directly in the path and the query string contains other
 545         # auxiliary information. All gitweb installations recognize
 546         # URL in either format; this configures in which formats gitweb
 547         # generates links.
 548
 549         # To enable system wide have in $GITWEB_CONFIG
 550         # $feature{'pathinfo'}{'default'} = [1];
 551         # Project specific override is not supported.
 552
 553         # Note that you will need to change the default location of CSS,
 554         # favicon, logo and possibly other files to an absolute URL. Also,
 555         # if gitweb.cgi serves as your indexfile, you will need to force
 556         # $my_uri to contain the script name in your $GITWEB_CONFIG (and you
 557         # will also likely want to set $home_link if you're setting $my_uri).
 558         'pathinfo' => {
 559                 'override' => 0,
 560                 'default' => [0]},
 561
 562         # Make gitweb consider projects in project root subdirectories
 563         # to be forks of existing projects. Given project $projname.git,
 564         # projects matching $projname/*.git will not be shown in the main
 565         # projects list, instead a '+' mark will be added to $projname
 566         # there and a 'forks' view will be enabled for the project, listing
 567         # all the forks. If project list is taken from a file, forks have
 568         # to be listed after the main project.
 569
 570         # To enable system wide have in $GITWEB_CONFIG
 571         # $feature{'forks'}{'default'} = [1];
 572         # Project specific override is not supported.
 573         'forks' => {
 574                 'override' => 0,
 575                 'default' => [0]},
 576
 577         # Insert custom links to the action bar of all project pages.
 578         # This enables you mainly to link to third-party scripts integrating
 579         # into gitweb; e.g. git-browser for graphical history representation
 580         # or custom web-based repository administration interface.
 581
 582         # The 'default' value consists of a list of triplets in the form
 583         # (label, link, position) where position is the label after which
 584         # to insert the link and link is a format string where %n expands
 585         # to the project name, %f to the project path within the filesystem,
 586         # %h to the current hash (h gitweb parameter) and %b to the current
 587         # hash base (hb gitweb parameter); %% expands to %.
 588
 589         # To enable system wide have in $GITWEB_CONFIG e.g.
 590         # $feature{'actions'}{'default'} = [('graphiclog',
 591         #       '/git-browser/by-commit.html?r=%n', 'summary')];
 592         # Project specific override is not supported.
 593         'actions' => {
 594                 'override' => 0,
 595                 'default' => []},
 596
 597         # Allow gitweb scan project content tags of project repository,
 598         # and display the popular Web 2.0-ish "tag cloud" near the projects
 599         # list.  Note that this is something COMPLETELY different from the
 600         # normal Git tags.
 601
 602         # gitweb by itself can show existing tags, but it does not handle
 603         # tagging itself; you need to do it externally, outside gitweb.
 604         # The format is described in git_get_project_ctags() subroutine.
 605         # You may want to install the HTML::TagCloud Perl module to get
 606         # a pretty tag cloud instead of just a list of tags.
 607
 608         # To enable system wide have in $GITWEB_CONFIG
 609         # $feature{'ctags'}{'default'} = [1];
 610         # Project specific override is not supported.
 611
 612         # A value of 0 means no ctags display or editing.  A value of
 613         # 1 enables ctags display but never editing.  A non-empty value
 614         # that is not a string of digits enables ctags display AND the
 615         # ability to add tags using a form that uses method POST and
 616         # an action value set to the configured 'ctags' value.
 617         'ctags' => {
 618                 'override' => 0,
 619                 'default' => [0]},
 620
 621         # The maximum number of patches in a patchset generated in patch
 622         # view. Set this to 0 or undef to disable patch view, or to a
 623         # negative number to remove any limit.
 624
 625         # To disable system wide have in $GITWEB_CONFIG
 626         # $feature{'patches'}{'default'} = [0];
 627         # To have project specific config enable override in $GITWEB_CONFIG
 628         # $feature{'patches'}{'override'} = 1;
 629         # and in project config gitweb.patches = 0|n;
 630         # where n is the maximum number of patches allowed in a patchset.
 631         'patches' => {
 632                 'sub' => \&feature_patches,
 633                 'override' => 0,
 634                 'default' => [16]},
 635
 636         # Avatar support. When this feature is enabled, views such as
 637         # shortlog or commit will display an avatar associated with
 638         # the email of the committer(s) and/or author(s).
 639
 640         # Currently available providers are gravatar and picon.
 641         # If an unknown provider is specified, the feature is disabled.
 642
 643         # Gravatar depends on Digest::MD5.
 644         # Picon currently relies on the indiana.edu database.
 645
 646         # To enable system wide have in $GITWEB_CONFIG
 647         # $feature{'avatar'}{'default'} = ['<provider>'];
 648         # where <provider> is either gravatar or picon.
 649         # To have project specific config enable override in $GITWEB_CONFIG
 650         # $feature{'avatar'}{'override'} = 1;
 651         # and in project config gitweb.avatar = <provider>;
 652         'avatar' => {
 653                 'sub' => \&feature_avatar,
 654                 'override' => 0,
 655                 'default' => ['']},
 656
 657         # Enable displaying how much time and how many git commands
 658         # it took to generate and display page.  Disabled by default.
 659         # Project specific override is not supported.
 660         'timed' => {
 661                 'override' => 0,
 662                 'default' => [0]},
 663
 664         # Enable turning some links into links to actions which require
 665         # JavaScript to run (like 'blame_incremental').  Not enabled by
 666         # default.  Project specific override is currently not supported.
 667         'javascript-actions' => {
 668                 'override' => 0,
 669                 'default' => [0]},
 670
 671         # Enable and configure ability to change common timezone for dates
 672         # in gitweb output via JavaScript.  Enabled by default.
 673         # Project specific override is not supported.
 674         'javascript-timezone' => {
 675                 'override' => 0,
 676                 'default' => [
 677                         'local',     # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
 678                                      # or undef to turn off this feature
 679                         'gitweb_tz', # name of cookie where to store selected timezone
 680                         'datetime',  # CSS class used to mark up dates for manipulation
 681                 ]},
 682
 683         # Syntax highlighting support. This is based on Daniel Svensson's
 684         # and Sham Chukoury's work in gitweb-xmms2.git.
 685         # It requires the 'highlight' program present in $PATH,
 686         # and therefore is disabled by default.
 687
 688         # To enable system wide have in $GITWEB_CONFIG
 689         # $feature{'highlight'}{'default'} = [1];
 690
 691         'highlight' => {
 692                 'sub' => sub { feature_bool('highlight', @_) },
 693                 'override' => 0,
 694                 'default' => [0]},
 695
 696         # Enable displaying of remote heads in the heads list
 697
 698         # To enable system wide have in $GITWEB_CONFIG
 699         # $feature{'remote_heads'}{'default'} = [1];
 700         # To have project specific config enable override in $GITWEB_CONFIG
 701         # $feature{'remote_heads'}{'override'} = 1;
 702         # and in project config gitweb.remoteheads = 0|1;
 703         'remote_heads' => {
 704                 'sub' => sub { feature_bool('remote_heads', @_) },
 705                 'override' => 0,
 706                 'default' => [0]},
 707
 708         # Enable showing branches under other refs in addition to heads
 709
 710         # To set system wide extra branch refs have in $GITWEB_CONFIG
 711         # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
 712         # To have project specific config enable override in $GITWEB_CONFIG
 713         # $feature{'extra-branch-refs'}{'override'} = 1;
 714         # and in project config gitweb.extrabranchrefs = dirs of choice
 715         # Every directory is separated with whitespace.
 716
 717         'extra-branch-refs' => {
 718                 'sub' => \&feature_extra_branch_refs,
 719                 'override' => 0,
 720                 'default' => []},
 721 );
 722
 723 sub gitweb_get_feature {
 724         my ($name) = @_;
 725         return unless exists $feature{$name};
 726         my ($sub, $override, @defaults) = (
 727                 $feature{$name}{'sub'},
 728                 $feature{$name}{'override'},
 729                 @{$feature{$name}{'default'}});
 730         # project specific override is possible only if we have project
 731         our $git_dir; # global variable, declared later
 732         if (!$override || !defined $git_dir) {
 733                 return @defaults;
 734         }
 735         if (!defined $sub) {
 736                 warn "feature $name is not overridable";
 737                 return @defaults;
 738         }
 739         return $sub->(@defaults);
 740 }
 741
 742 # A wrapper to check if a given feature is enabled.
 743 # With this, you can say
 744 #
 745 #   my $bool_feat = gitweb_check_feature('bool_feat');
 746 #   gitweb_check_feature('bool_feat') or somecode;
 747 #
 748 # instead of
 749 #
 750 #   my ($bool_feat) = gitweb_get_feature('bool_feat');
 751 #   (gitweb_get_feature('bool_feat'))[0] or somecode;
 752 #
 753 sub gitweb_check_feature {
 754         return (gitweb_get_feature(@_))[0];
 755 }
 756
 757
 758 sub feature_bool {
 759         my $key = shift;
 760         my ($val) = git_get_project_config($key, '--bool');
 761
 762         if (!defined $val) {
 763                 return ($_[0]);
 764         } elsif ($val eq 'true') {
 765                 return (1);
 766         } elsif ($val eq 'false') {
 767                 return (0);
 768         }
 769 }
 770
 771 sub feature_snapshot {
 772         my (@fmts) = @_;
 773
 774         my ($val) = git_get_project_config('snapshot');
 775
 776         if ($val) {
 777                 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
 778         }
 779
 780         return @fmts;
 781 }
 782
 783 sub feature_patches {
 784         my @val = (git_get_project_config('patches', '--int'));
 785
 786         if (@val) {
 787                 return @val;
 788         }
 789
 790         return ($_[0]);
 791 }
 792
 793 sub feature_avatar {
 794         my @val = (git_get_project_config('avatar'));
 795
 796         return @val ? @val : @_;
 797 }
 798
 799 sub feature_extra_branch_refs {
 800         my (@branch_refs) = @_;
 801         my $values = git_get_project_config('extrabranchrefs');
 802
 803         if ($values) {
 804                 $values = config_to_multi ($values);
 805                 @branch_refs = ();
 806                 foreach my $value (@{$values}) {
 807                         push @branch_refs, split /\s+/, $value;
 808                 }
 809         }
 810
 811         return @branch_refs;
 812 }
 813
 814 # checking HEAD file with -e is fragile if the repository was
 815 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
 816 # and then pruned.
 817 sub check_head_link {
 818         my ($dir) = @_;
 819         my $headfile = "$dir/HEAD";
 820         return ((-e $headfile) ||
 821                 (-l $headfile && readlink($headfile) =~ /^refs\/heads\//));
 822 }
 823
 824 sub check_export_ok {
 825         my ($dir) = @_;
 826         return (check_head_link($dir) &&
 827                 (!$export_ok || -e "$dir/$export_ok") &&
 828                 (!$export_auth_hook || $export_auth_hook->($dir)));
 829 }
 830
 831 # process alternate names for backward compatibility
 832 # filter out unsupported (unknown) snapshot formats
 833 sub filter_snapshot_fmts {
 834         my @fmts = @_;
 835
 836         @fmts = map {
 837                 exists $known_snapshot_format_aliases{$_} ?
 838                        $known_snapshot_format_aliases{$_} : $_} @fmts;
 839         @fmts = grep {
 840                 exists $known_snapshot_formats{$_} &&
 841                 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
 842 }
 843
 844 sub filter_and_validate_refs {
 845         my @refs = @_;
 846         my %unique_refs = ();
 847
 848         foreach my $ref (@refs) {
 849                 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
 850                 # 'heads' are added implicitly in get_branch_refs().
 851                 $unique_refs{$ref} = 1 if ($ref ne 'heads');
 852         }
 853         return sort keys %unique_refs;
 854 }
 855
 856 # If it is set to code reference, it is code that it is to be run once per
 857 # request, allowing updating configurations that change with each request,
 858 # while running other code in config file only once.
 859 #
 860 # Otherwise, if it is false then gitweb would process config file only once;
 861 # if it is true then gitweb config would be run for each request.
 862 our $per_request_config = 1;
 863
 864 # If true and fileno STDIN is 0 and getsockname succeeds and getpeername fails
 865 # with ENOTCONN, then FCGI mode will be activated automatically in just the
 866 # same way as though the --fcgi option had been given instead.
 867 our $auto_fcgi = 0;
 868
 869 # read and parse gitweb config file given by its parameter.
 870 # returns true on success, false on recoverable error, allowing
 871 # to chain this subroutine, using first file that exists.
 872 # dies on errors during parsing config file, as it is unrecoverable.
 873 sub read_config_file {
 874         my $filename = shift;
 875         return unless defined $filename;
 876         # die if there are errors parsing config file
 877         if (-e $filename) {
 878                 do $filename;
 879                 die $@ if $@;
 880                 return 1;
 881         }
 882         return;
 883 }
 884
 885 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
 886 sub evaluate_gitweb_config {
 887         our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
 888         our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
 889         our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
 890
 891         # Protect against duplications of file names, to not read config twice.
 892         # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
 893         # there possibility of duplication of filename there doesn't matter.
 894         $GITWEB_CONFIG = ""        if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
 895         $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
 896
 897         # Common system-wide settings for convenience.
 898         # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
 899         read_config_file($GITWEB_CONFIG_COMMON);
 900
 901         # Use first config file that exists.  This means use the per-instance
 902         # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
 903         read_config_file($GITWEB_CONFIG) and return;
 904         read_config_file($GITWEB_CONFIG_SYSTEM);
 905 }
 906
 907 # Get loadavg of system, to compare against $maxload.
 908 # Currently it requires '/proc/loadavg' present to get loadavg;
 909 # if it is not present it returns 0, which means no load checking.
 910 sub get_loadavg {
 911         if( -e '/proc/loadavg' ){
 912                 open my $fd, '<', '/proc/loadavg'
 913                         or return 0;
 914                 my @load = split(/\s+/, scalar <$fd>);
 915                 close $fd;
 916
 917                 # The first three columns measure CPU and IO utilization of the last one,
 918                 # five, and 10 minute periods.  The fourth column shows the number of
 919                 # currently running processes and the total number of processes in the m/n
 920                 # format.  The last column displays the last process ID used.
 921                 return $load[0] || 0;
 922         }
 923         # additional checks for load average should go here for things that don't export
 924         # /proc/loadavg
 925
 926         return 0;
 927 }
 928
 929 # version of the core git binary
 930 our $git_version;
 931 sub evaluate_git_version {
 932         our $git_version = qx("$GIT" --version) =~ m/git version (.*)$/ ? $1 : "unknown";
 933         $number_of_git_cmds++;
 934 }
 935
 936 sub check_loadavg {
 937         if (defined $maxload && get_loadavg() > $maxload) {
 938                 die_error(503, "The load average on the server is too high");
 939         }
 940 }
 941
 942 # ======================================================================
 943 # input validation and dispatch
 944
 945 # input parameters can be collected from a variety of sources (presently, CGI
 946 # and PATH_INFO), so we define an %input_params hash that collects them all
 947 # together during validation: this allows subsequent uses (e.g. href()) to be
 948 # agnostic of the parameter origin
 949
 950 our %input_params = ();
 951
 952 # input parameters are stored with the long parameter name as key. This will
 953 # also be used in the href subroutine to convert parameters to their CGI
 954 # equivalent, and since the href() usage is the most frequent one, we store
 955 # the name -> CGI key mapping here, instead of the reverse.
 956 #
 957 # XXX: Warning: If you touch this, check the search form for updating,
 958 # too.
 959
 960 our @cgi_param_mapping = (
 961         project => "p",
 962         action => "a",
 963         file_name => "f",
 964         file_parent => "fp",
 965         hash => "h",
 966         hash_parent => "hp",
 967         hash_base => "hb",
 968         hash_parent_base => "hpb",
 969         page => "pg",
 970         order => "o",
 971         searchtext => "s",
 972         searchtype => "st",
 973         snapshot_format => "sf",
 974         ctag_filter => 't',
 975         extra_options => "opt",
 976         search_use_regexp => "sr",
 977         ctag => "by_tag",
 978         diff_style => "ds",
 979         project_filter => "pf",
 980         # this must be last entry (for manipulation from JavaScript)
 981         javascript => "js"
 982 );
 983 our %cgi_param_mapping = @cgi_param_mapping;
 984
 985 # we will also need to know the possible actions, for validation
 986 our %actions = (
 987         "blame" => \&git_blame,
 988         "blame_incremental" => \&git_blame_incremental,
 989         "blame_data" => \&git_blame_data,
 990         "blobdiff" => \&git_blobdiff,
 991         "blobdiff_plain" => \&git_blobdiff_plain,
 992         "blob" => \&git_blob,
 993         "blob_plain" => \&git_blob_plain,
 994         "commitdiff" => \&git_commitdiff,
 995         "commitdiff_plain" => \&git_commitdiff_plain,
 996         "commit" => \&git_commit,
 997         "forks" => \&git_forks,
 998         "heads" => \&git_heads,
 999         "history" => \&git_history,
1000         "log" => \&git_log,
1001         "patch" => \&git_patch,
1002         "patches" => \&git_patches,
1003         "remotes" => \&git_remotes,
1004         "rss" => \&git_rss,
1005         "atom" => \&git_atom,
1006         "search" => \&git_search,
1007         "search_help" => \&git_search_help,
1008         "shortlog" => \&git_shortlog,
1009         "summary" => \&git_summary,
1010         "tag" => \&git_tag,
1011         "tags" => \&git_tags,
1012         "tree" => \&git_tree,
1013         "snapshot" => \&git_snapshot,
1014         "object" => \&git_object,
1015         # those below don't need $project
1016         "opml" => \&git_opml,
1017         "frontpage" => \&git_frontpage,
1018         "project_list" => \&git_project_list,
1019         "project_index" => \&git_project_index,
1020 );
1021
1022 # finally, we have the hash of allowed extra_options for the commands that
1023 # allow them
1024 our %allowed_options = (
1025         "--no-merges" => [ qw(rss atom log shortlog history) ],
1026 );
1027
1028 # fill %input_params with the CGI parameters. All values except for 'opt'
1029 # should be single values, but opt can be an array. We should probably
1030 # build an array of parameters that can be multi-valued, but since for the time
1031 # being it's only this one, we just single it out
1032 sub evaluate_query_params {
1033         our $cgi;
1034
1035         while (my ($name, $symbol) = each %cgi_param_mapping) {
1036                 if ($symbol eq 'opt') {
1037                         $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
1038                 } else {
1039                         $input_params{$name} = decode_utf8($cgi->param($symbol));
1040                 }
1041         }
1042
1043         # Backwards compatibility - by_tag= <=> t=
1044         if ($input_params{'ctag'}) {
1045                 $input_params{'ctag_filter'} = $input_params{'ctag'};
1046         }
1047 }
1048
1049 # now read PATH_INFO and update the parameter list for missing parameters
1050 sub evaluate_path_info {
1051         return if defined $input_params{'project'};
1052         return if !$path_info;
1053         $path_info =~ s,^/+,,;
1054         return if !$path_info;
1055
1056         # find which part of PATH_INFO is project
1057         my $project = $path_info;
1058         $project =~ s,/+$,,;
1059         while ($project && !check_head_link("$projectroot/$project")) {
1060                 $project =~ s,/*[^/]*$,,;
1061         }
1062         return unless $project;
1063         $input_params{'project'} = $project;
1064
1065         # do not change any parameters if an action is given using the query string
1066         return if $input_params{'action'};
1067         $path_info =~ s,^\Q$project\E/*,,;
1068
1069         # next, check if we have an action
1070         my $action = $path_info;
1071         $action =~ s,/.*$,,;
1072         if (exists $actions{$action}) {
1073                 $path_info =~ s,^$action/*,,;
1074                 $input_params{'action'} = $action;
1075         }
1076
1077         # list of actions that want hash_base instead of hash, but can have no
1078         # pathname (f) parameter
1079         my @wants_base = (
1080                 'tree',
1081                 'history',
1082         );
1083
1084         # we want to catch, among others
1085         # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
1086         my ($parentrefname, $parentpathname, $refname, $pathname) =
1087                 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
1088
1089         # first, analyze the 'current' part
1090         if (defined $pathname) {
1091                 # we got "branch:filename" or "branch:dir/"
1092                 # we could use git_get_type(branch:pathname), but:
1093                 # - it needs $git_dir
1094                 # - it does a git() call
1095                 # - the convention of terminating directories with a slash
1096                 #   makes it superfluous
1097                 # - embedding the action in the PATH_INFO would make it even
1098                 #   more superfluous
1099                 $pathname =~ s,^/+,,;
1100                 if (!$pathname || substr($pathname, -1) eq "/") {
1101                         $input_params{'action'} ||= "tree";
1102                         $pathname =~ s,/$,,;
1103                 } else {
1104                         # the default action depends on whether we had parent info
1105                         # or not
1106                         if ($parentrefname) {
1107                                 $input_params{'action'} ||= "blobdiff_plain";
1108                         } else {
1109                                 $input_params{'action'} ||= "blob_plain";
1110                         }
1111                 }
1112                 $input_params{'hash_base'} ||= $refname;
1113                 $input_params{'file_name'} ||= $pathname;
1114         } elsif (defined $refname) {
1115                 # we got "branch". In this case we have to choose if we have to
1116                 # set hash or hash_base.
1117                 #
1118                 # Most of the actions without a pathname only want hash to be
1119                 # set, except for the ones specified in @wants_base that want
1120                 # hash_base instead. It should also be noted that hand-crafted
1121                 # links having 'history' as an action and no pathname or hash
1122                 # set will fail, but that happens regardless of PATH_INFO.
1123                 if (defined $parentrefname) {
1124                         # if there is parent let the default be 'shortlog' action
1125                         # (for http://git.example.com/repo.git/A..B links); if there
1126                         # is no parent, dispatch will detect type of object and set
1127                         # action appropriately if required (if action is not set)
1128                         $input_params{'action'} ||= "shortlog";
1129                 }
1130                 if ($input_params{'action'} &&
1131                     grep { $_ eq $input_params{'action'} } @wants_base) {
1132                         $input_params{'hash_base'} ||= $refname;
1133                 } else {
1134                         $input_params{'hash'} ||= $refname;
1135                 }
1136         }
1137
1138         # next, handle the 'parent' part, if present
1139         if (defined $parentrefname) {
1140                 # a missing pathspec defaults to the 'current' filename, allowing e.g.
1141                 # someproject/blobdiff/oldrev..newrev:/filename
1142                 if ($parentpathname) {
1143                         $parentpathname =~ s,^/+,,;
1144                         $parentpathname =~ s,/$,,;
1145                         $input_params{'file_parent'} ||= $parentpathname;
1146                 } else {
1147                         $input_params{'file_parent'} ||= $input_params{'file_name'};
1148                 }
1149                 # we assume that hash_parent_base is wanted if a path was specified,
1150                 # or if the action wants hash_base instead of hash
1151                 if (defined $input_params{'file_parent'} ||
1152                         grep { $_ eq $input_params{'action'} } @wants_base) {
1153                         $input_params{'hash_parent_base'} ||= $parentrefname;
1154                 } else {
1155                         $input_params{'hash_parent'} ||= $parentrefname;
1156                 }
1157         }
1158
1159         # for the snapshot action, we allow URLs in the form
1160         # $project/snapshot/$hash.ext
1161         # where .ext determines the snapshot and gets removed from the
1162         # passed $refname to provide the $hash.
1163         #
1164         # To be able to tell that $refname includes the format extension, we
1165         # require the following two conditions to be satisfied:
1166         # - the hash input parameter MUST have been set from the $refname part
1167         #   of the URL (i.e. they must be equal)
1168         # - the snapshot format MUST NOT have been defined already (e.g. from
1169         #   CGI parameter sf)
1170         # It's also useless to try any matching unless $refname has a dot,
1171         # so we check for that too
1172         if (defined $input_params{'action'} &&
1173                 $input_params{'action'} eq 'snapshot' &&
1174                 defined $refname && index($refname, '.') != -1 &&
1175                 $refname eq $input_params{'hash'} &&
1176                 !defined $input_params{'snapshot_format'}) {
1177                 # We loop over the known snapshot formats, checking for
1178                 # extensions. Allowed extensions are both the defined suffix
1179                 # (which includes the initial dot already) and the snapshot
1180                 # format key itself, with a prepended dot
1181                 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1182                         my $hash = $refname;
1183                         unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1184                                 next;
1185                         }
1186                         my $sfx = $1;
1187                         # a valid suffix was found, so set the snapshot format
1188                         # and reset the hash parameter
1189                         $input_params{'snapshot_format'} = $fmt;
1190                         $input_params{'hash'} = $hash;
1191                         # we also set the format suffix to the one requested
1192                         # in the URL: this way a request for e.g. .tgz returns
1193                         # a .tgz instead of a .tar.gz
1194                         $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1195                         last;
1196                 }
1197         }
1198 }
1199
1200 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1201      $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1202      $searchtext, $search_regexp, $project_filter);
1203 sub evaluate_and_validate_params {
1204         our $action = $input_params{'action'};
1205         if (defined $action) {
1206                 if (!is_valid_action($action)) {
1207                         die_error(400, "Invalid action parameter");
1208                 }
1209         }
1210
1211         # parameters which are pathnames
1212         our $project = $input_params{'project'};
1213         if (defined $project) {
1214                 if (!is_valid_project($project)) {
1215                         undef $project;
1216                         die_error(404, "No such project");
1217                 }
1218         }
1219
1220         our $project_filter = $input_params{'project_filter'};
1221         if (defined $project_filter) {
1222                 if (!is_valid_pathname($project_filter)) {
1223                         die_error(404, "Invalid project_filter parameter");
1224                 }
1225         }
1226
1227         our $file_name = $input_params{'file_name'};
1228         if (defined $file_name) {
1229                 if (!is_valid_pathname($file_name)) {
1230                         die_error(400, "Invalid file parameter");
1231                 }
1232         }
1233
1234         our $file_parent = $input_params{'file_parent'};
1235         if (defined $file_parent) {
1236                 if (!is_valid_pathname($file_parent)) {
1237                         die_error(400, "Invalid file parent parameter");
1238                 }
1239         }
1240
1241         # parameters which are refnames
1242         our $hash = $input_params{'hash'};
1243         if (defined $hash) {
1244                 if (!is_valid_refname($hash)) {
1245                         die_error(400, "Invalid hash parameter");
1246                 }
1247         }
1248
1249         our $hash_parent = $input_params{'hash_parent'};
1250         if (defined $hash_parent) {
1251                 if (!is_valid_refname($hash_parent)) {
1252                         die_error(400, "Invalid hash parent parameter");
1253                 }
1254         }
1255
1256         our $hash_base = $input_params{'hash_base'};
1257         if (defined $hash_base) {
1258                 if (!is_valid_refname($hash_base)) {
1259                         die_error(400, "Invalid hash base parameter");
1260                 }
1261         }
1262
1263         our @extra_options = @{$input_params{'extra_options'}};
1264         # @extra_options is always defined, since it can only be (currently) set from
1265         # CGI, and $cgi->param() returns the empty array in array context if the param
1266         # is not set
1267         foreach my $opt (@extra_options) {
1268                 if (not exists $allowed_options{$opt}) {
1269                         die_error(400, "Invalid option parameter");
1270                 }
1271                 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1272                         die_error(400, "Invalid option parameter for this action");
1273                 }
1274         }
1275
1276         our $hash_parent_base = $input_params{'hash_parent_base'};
1277         if (defined $hash_parent_base) {
1278                 if (!is_valid_refname($hash_parent_base)) {
1279                         die_error(400, "Invalid hash parent base parameter");
1280                 }
1281         }
1282
1283         # other parameters
1284         our $page = $input_params{'page'};
1285         if (defined $page) {
1286                 if ($page =~ m/[^0-9]/) {
1287                         die_error(400, "Invalid page parameter");
1288                 }
1289         }
1290
1291         our $searchtype = $input_params{'searchtype'};
1292         if (defined $searchtype) {
1293                 if ($searchtype =~ m/[^a-z]/) {
1294                         die_error(400, "Invalid searchtype parameter");
1295                 }
1296         }
1297
1298         our $search_use_regexp = $input_params{'search_use_regexp'};
1299
1300         our $searchtext = $input_params{'searchtext'};
1301         our $search_regexp = undef;
1302         if (defined $searchtext) {
1303                 if (length($searchtext) < 2) {
1304                         die_error(403, "At least two characters are required for search parameter");
1305                 }
1306                 if ($search_use_regexp) {
1307                         $search_regexp = $searchtext;
1308                         if (!eval { qr/$search_regexp/; 1; }) {
1309                                 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1310                                 die_error(400, "Invalid search regexp '$search_regexp'",
1311                                           esc_html($error));
1312                         }
1313                 } else {
1314                         $search_regexp = quotemeta $searchtext;
1315                 }
1316         }
1317 }
1318
1319 # path to the current git repository
1320 our $git_dir;
1321 sub evaluate_git_dir {
1322         our $git_dir = "$projectroot/$project" if $project;
1323 }
1324
1325 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1326 sub configure_gitweb_features {
1327         # list of supported snapshot formats
1328         our @snapshot_fmts = gitweb_get_feature('snapshot');
1329         @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1330
1331         # check that the avatar feature is set to a known provider name,
1332         # and for each provider check if the dependencies are satisfied.
1333         # if the provider name is invalid or the dependencies are not met,
1334         # reset $git_avatar to the empty string.
1335         our ($git_avatar) = gitweb_get_feature('avatar');
1336         if ($git_avatar eq 'gravatar') {
1337                 $git_avatar = '' unless (eval { require Digest::MD5; 1; });
1338         } elsif ($git_avatar eq 'picon') {
1339                 # no dependencies
1340         } else {
1341                 $git_avatar = '';
1342         }
1343
1344         our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1345         @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1346 }
1347
1348 sub get_branch_refs {
1349         return ('heads', @extra_branch_refs);
1350 }
1351
1352 # custom error handler: 'die <message>' is Internal Server Error
1353 sub handle_errors_html {
1354         my $msg = shift; # it is already HTML escaped
1355
1356         # to avoid infinite loop where error occurs in die_error,
1357         # change handler to default handler, disabling handle_errors_html
1358         set_message("Error occurred when inside die_error:\n$msg");
1359
1360         # you cannot jump out of die_error when called as error handler;
1361         # the subroutine set via CGI::Carp::set_message is called _after_
1362         # HTTP headers are already written, so it cannot write them itself
1363         die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1364 }
1365 set_message(\&handle_errors_html);
1366
1367 our $shown_stale_message = 0;
1368 our $cache_dump = undef;
1369 our $cache_dump_mtime = undef;
1370
1371 # dispatch
1372 sub dispatch {
1373         $shown_stale_message = 0;
1374         if (!defined $action) {
1375                 if (defined $hash) {
1376                         $action = git_get_type($hash);
1377                         $action or die_error(404, "Object does not exist");
1378                 } elsif (defined $hash_base && defined $file_name) {
1379                         $action = git_get_type("$hash_base:$file_name");
1380                         $action or die_error(404, "File or directory does not exist");
1381                 } elsif (defined $project) {
1382                         $action = 'summary';
1383                 } else {
1384                         $action = 'frontpage';
1385                 }
1386         }
1387         if (!defined($actions{$action})) {
1388                 die_error(400, "Unknown action");
1389         }
1390         if ($action !~ m/^(?:opml|frontpage|project_list|project_index)$/ &&
1391             !$project) {
1392                 die_error(400, "Project needed");
1393         }
1394         $actions{$action}->();
1395 }
1396
1397 sub reset_timer {
1398         our $t0 = [ gettimeofday() ]
1399                 if defined $t0;
1400         our $number_of_git_cmds = 0;
1401 }
1402
1403 our $first_request = 1;
1404 our $evaluate_uri_force = undef;
1405 sub run_request {
1406         reset_timer();
1407
1408         # Only allow GET and HEAD methods
1409         if (!$ENV{'REQUEST_METHOD'} || ($ENV{'REQUEST_METHOD'} ne 'GET' && $ENV{'REQUEST_METHOD'} ne 'HEAD')) {
1410                 print <<EOT;
1411 Status: 405 Method Not Allowed
1412 Content-Type: text/plain
1413 Allow: GET,HEAD
1414
1415 405 Method Not Allowed
1416 EOT
1417                 return;
1418         }
1419
1420         evaluate_uri();
1421         &$evaluate_uri_force() if $evaluate_uri_force;
1422         if ($per_request_config) {
1423                 if (ref($per_request_config) eq 'CODE') {
1424                         $per_request_config->();
1425                 } elsif (!$first_request) {
1426                         evaluate_gitweb_config();
1427                 }
1428         }
1429         check_loadavg();
1430
1431         # $projectroot and $projects_list might be set in gitweb config file
1432         $projects_list ||= $projectroot;
1433
1434         evaluate_query_params();
1435         evaluate_path_info();
1436         evaluate_and_validate_params();
1437         evaluate_git_dir();
1438
1439         configure_gitweb_features();
1440
1441         dispatch();
1442 }
1443
1444 our $is_last_request = sub { 1 };
1445 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1446 our $CGI = 'CGI';
1447 our $cgi;
1448 our $fcgi_mode = 0;
1449 our $fcgi_nproc_active = 0;
1450 our $fcgi_raw_mode = 0;
1451 sub is_fcgi {
1452         use Errno;
1453         my $stdinfno = fileno STDIN;
1454         return 0 unless defined $stdinfno && $stdinfno == 0;
1455         return 0 unless getsockname STDIN;
1456         return 0 if getpeername STDIN;
1457         return $!{ENOTCONN}?1:0;
1458 }
1459 sub configure_as_fcgi {
1460         return if $fcgi_mode;
1461
1462         require FCGI;
1463         require CGI::Fast;
1464
1465         # We have gone to great effort to make sure that all incoming data has
1466         # been converted from whatever format it was in into UTF-8.  We have
1467         # even taken care to make sure the output handle is in ':utf8' mode.
1468         # Now along comes FCGI and blows it with:
1469         #
1470         #     Use of wide characters in FCGI::Stream::PRINT is deprecated
1471         #      and will stop wprking[sic] in a future version of FCGI
1472         #
1473         # To fix this we replace FCGI::Stream::PRINT with our own routine that
1474         # first encodes everything and then calls the original routine, but
1475         # not if $fcgi_raw_mode is true (then we just call the original routine).
1476         #
1477         # Note that we could do this by using utf8::is_utf8 to check instead
1478         # of having a $fcgi_raw_mode global, but that would be slower to run
1479         # the test on each element and much slower than skipping the conversion
1480         # entirely when we know we're outputting raw bytes.
1481         my $orig = \&FCGI::Stream::PRINT;
1482         undef *FCGI::Stream::PRINT;
1483         *FCGI::Stream::PRINT = sub {
1484                 @_ = (shift, map {my $x=$_; utf8::encode($x); $x} @_)
1485                         unless $fcgi_raw_mode;
1486                 goto $orig;
1487         };
1488
1489         our $CGI = 'CGI::Fast';
1490
1491         $fcgi_mode = 1;
1492         $first_request = 0;
1493         my $request_number = 0;
1494         # let each child service 100 requests
1495         our $is_last_request = sub { ++$request_number > 100 };
1496 }
1497 sub evaluate_argv {
1498         my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1499         configure_as_fcgi()
1500                 if $script_name =~ /\.fcgi$/ || ($auto_fcgi && is_fcgi());
1501
1502         my $nproc_sub = sub {
1503                 my ($arg, $val) = @_;
1504                 return unless eval { require FCGI::ProcManager; 1; };
1505                 $fcgi_nproc_active = 1;
1506                 my $proc_manager = FCGI::ProcManager->new({
1507                         n_processes => $val,
1508                 });
1509                 our $pre_listen_hook    = sub { $proc_manager->pm_manage()        };
1510                 our $pre_dispatch_hook  = sub { $proc_manager->pm_pre_dispatch()  };
1511                 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1512         };
1513         if (@ARGV) {
1514                 require Getopt::Long;
1515                 Getopt::Long::GetOptions(
1516                         'fastcgi|fcgi|f' => \&configure_as_fcgi,
1517                         'nproc|n=i' => $nproc_sub,
1518                 );
1519         };
1520         if (!$fcgi_nproc_active && defined $ENV{'GITWEB_FCGI_NPROC'} && $ENV{'GITWEB_FCGI_NPROC'} =~ /^\d+$/) {
1521                 &$nproc_sub('nproc', $ENV{'GITWEB_FCGI_NPROC'});
1522         }
1523 }
1524
1525 sub run {
1526         evaluate_gitweb_config();
1527         evaluate_git_version();
1528         my ($mu, $hl, $subroutine) = ($my_uri, $home_link, '');
1529         $subroutine .= '$my_uri = $mu;' if defined $my_uri && $my_uri ne '';
1530         $subroutine .= '$home_link = $hl;' if defined $home_link && $home_link ne '';
1531         $evaluate_uri_force = eval "sub {$subroutine}" if $subroutine;
1532         $first_request = 1;
1533         evaluate_argv();
1534
1535         $pre_listen_hook->()
1536                 if $pre_listen_hook;
1537
1538  REQUEST:
1539         while ($cgi = $CGI->new()) {
1540                 $pre_dispatch_hook->()
1541                         if $pre_dispatch_hook;
1542
1543                 run_request();
1544
1545                 $post_dispatch_hook->()
1546                         if $post_dispatch_hook;
1547                 $first_request = 0;
1548
1549                 last REQUEST if ($is_last_request->());
1550         }
1551
1552  DONE_GITWEB:
1553         1;
1554 }
1555
1556 run();
1557
1558 if (defined caller) {
1559         # wrapped in a subroutine processing requests,
1560         # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1561         return;
1562 } else {
1563         # pure CGI script, serving single request
1564         exit;
1565 }
1566
1567 ## ======================================================================
1568 ## action links
1569
1570 # possible values of extra options
1571 # -full => 0|1      - use absolute/full URL ($my_uri/$my_url as base)
1572 # -replay => 1      - start from a current view (replay with modifications)
1573 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1574 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1575 sub href {
1576         my %params = @_;
1577         # default is to use -absolute url() i.e. $my_uri
1578         my $href = $params{-full} ? $my_url : $my_uri;
1579
1580         # implicit -replay, must be first of implicit params
1581         $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1582
1583         $params{'project'} = $project unless exists $params{'project'};
1584
1585         if ($params{-replay}) {
1586                 while (my ($name, $symbol) = each %cgi_param_mapping) {
1587                         if (!exists $params{$name}) {
1588                                 $params{$name} = $input_params{$name};
1589                         }
1590                 }
1591         }
1592
1593         my $use_pathinfo = gitweb_check_feature('pathinfo');
1594         if (defined $params{'project'} &&
1595             (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1596                 # try to put as many parameters as possible in PATH_INFO:
1597                 #   - project name
1598                 #   - action
1599                 #   - hash_parent or hash_parent_base:/file_parent
1600                 #   - hash or hash_base:/filename
1601                 #   - the snapshot_format as an appropriate suffix
1602
1603                 # When the script is the root DirectoryIndex for the domain,
1604                 # $href here would be something like http://gitweb.example.com/
1605                 # Thus, we strip any trailing / from $href, to spare us double
1606                 # slashes in the final URL
1607                 $href =~ s,/$,,;
1608
1609                 # Then add the project name, if present
1610                 $href .= "/".esc_path_info($params{'project'});
1611                 delete $params{'project'};
1612
1613                 # since we destructively absorb parameters, we keep this
1614                 # boolean that remembers if we're handling a snapshot
1615                 my $is_snapshot = $params{'action'} eq 'snapshot';
1616
1617                 # Summary just uses the project path URL, any other action is
1618                 # added to the URL
1619                 if (defined $params{'action'}) {
1620                         $href .= "/".esc_path_info($params{'action'})
1621                                 unless $params{'action'} eq 'summary';
1622                         delete $params{'action'};
1623                 }
1624
1625                 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1626                 # stripping nonexistent or useless pieces
1627                 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1628                         || $params{'hash_parent'} || $params{'hash'});
1629                 if (defined $params{'hash_base'}) {
1630                         if (defined $params{'hash_parent_base'}) {
1631                                 $href .= esc_path_info($params{'hash_parent_base'});
1632                                 # skip the file_parent if it's the same as the file_name
1633                                 if (defined $params{'file_parent'}) {
1634                                         if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1635                                                 delete $params{'file_parent'};
1636                                         } elsif ($params{'file_parent'} !~ /\.\./) {
1637                                                 $href .= ":/".esc_path_info($params{'file_parent'});
1638                                                 delete $params{'file_parent'};
1639                                         }
1640                                 }
1641                                 $href .= "..";
1642                                 delete $params{'hash_parent'};
1643                                 delete $params{'hash_parent_base'};
1644                         } elsif (defined $params{'hash_parent'}) {
1645                                 $href .= esc_path_info($params{'hash_parent'}). "..";
1646                                 delete $params{'hash_parent'};
1647                         }
1648
1649                         $href .= esc_path_info($params{'hash_base'});
1650                         if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1651                                 $href .= ":/".esc_path_info($params{'file_name'});
1652                                 delete $params{'file_name'};
1653                         }
1654                         delete $params{'hash'};
1655                         delete $params{'hash_base'};
1656                 } elsif (defined $params{'hash'}) {
1657                         $href .= esc_path_info($params{'hash'});
1658                         delete $params{'hash'};
1659                 }
1660
1661                 # If the action was a snapshot, we can absorb the
1662                 # snapshot_format parameter too
1663                 if ($is_snapshot) {
1664                         my $fmt = $params{'snapshot_format'};
1665                         # snapshot_format should always be defined when href()
1666                         # is called, but just in case some code forgets, we
1667                         # fall back to the default
1668                         $fmt ||= $snapshot_fmts[0];
1669                         $href .= $known_snapshot_formats{$fmt}{'suffix'};
1670                         delete $params{'snapshot_format'};
1671                 }
1672         }
1673
1674         # now encode the parameters explicitly
1675         my @result = ();
1676         for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1677                 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1678                 if (defined $params{$name}) {
1679                         if (ref($params{$name}) eq "ARRAY") {
1680                                 foreach my $par (@{$params{$name}}) {
1681                                         push @result, $symbol . "=" . esc_param($par);
1682                                 }
1683                         } else {
1684                                 push @result, $symbol . "=" . esc_param($params{$name});
1685                         }
1686                 }
1687         }
1688         $href .= "?" . join(';', @result) if scalar @result;
1689
1690         # final transformation: trailing spaces must be escaped (URI-encoded)
1691         $href =~ s/(\s+)$/CGI::escape($1)/e;
1692
1693         if ($params{-anchor}) {
1694                 $href .= "#".esc_param($params{-anchor});
1695         }
1696
1697         return $href;
1698 }
1699
1700
1701 ## ======================================================================
1702 ## validation, quoting/unquoting and escaping
1703
1704 sub is_valid_action {
1705         my $input = shift;
1706         return undef unless exists $actions{$input};
1707         return 1;
1708 }
1709
1710 sub is_valid_project {
1711         my $input = shift;
1712
1713         return unless defined $input;
1714         if (!is_valid_pathname($input) ||
1715                 !(-d "$projectroot/$input") ||
1716                 !check_export_ok("$projectroot/$input") ||
1717                 ($strict_export && !project_in_list($input))) {
1718                 return undef;
1719         } else {
1720                 return 1;
1721         }
1722 }
1723
1724 sub is_valid_pathname {
1725         my $input = shift;
1726
1727         return undef unless defined $input;
1728         # no '.' or '..' as elements of path, i.e. no '.' or '..'
1729         # at the beginning, at the end, and between slashes.
1730         # also this catches doubled slashes
1731         if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1732                 return undef;
1733         }
1734         # no null characters
1735         if ($input =~ m!\0!) {
1736                 return undef;
1737         }
1738         return 1;
1739 }
1740
1741 sub is_valid_ref_format {
1742         my $input = shift;
1743
1744         return undef unless defined $input;
1745         # restrictions on ref name according to git-check-ref-format
1746         if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1747                 return undef;
1748         }
1749         return 1;
1750 }
1751
1752 sub is_valid_refname {
1753         my $input = shift;
1754
1755         return undef unless defined $input;
1756         # textual hashes are O.K.
1757         if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1758                 return 1;
1759         }
1760         # it must be correct pathname
1761         is_valid_pathname($input) or return undef;
1762         # check git-check-ref-format restrictions
1763         is_valid_ref_format($input) or return undef;
1764         return 1;
1765 }
1766
1767 # decode sequences of octets in utf8 into Perl's internal form,
1768 # which is utf-8 with utf8 flag set if needed.  gitweb writes out
1769 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1770 sub to_utf8 {
1771         my $str = shift;
1772         return undef unless defined $str;
1773
1774         if (utf8::is_utf8($str) || utf8::decode($str)) {
1775                 return $str;
1776         } else {
1777                 return decode($fallback_encoding, $str, Encode::FB_DEFAULT);
1778         }
1779 }
1780
1781 # quote unsafe chars, but keep the slash, even when it's not
1782 # correct, but quoted slashes look too horrible in bookmarks
1783 sub esc_param {
1784         my $str = shift;
1785         return undef unless defined $str;
1786         $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1787         $str =~ s/ /\+/g;
1788         return $str;
1789 }
1790
1791 # the quoting rules for path_info fragment are slightly different
1792 sub esc_path_info {
1793         my $str = shift;
1794         return undef unless defined $str;
1795
1796         # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1797         $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1798
1799         return $str;
1800 }
1801
1802 # quote unsafe chars in whole URL, so some characters cannot be quoted
1803 sub esc_url {
1804         my $str = shift;
1805         return undef unless defined $str;
1806         $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1807         $str =~ s/ /\+/g;
1808         return $str;
1809 }
1810
1811 # quote unsafe characters in HTML attributes
1812 sub esc_attr {
1813
1814         # for XHTML conformance escaping '"' to '&quot;' is not enough
1815         return esc_html(@_);
1816 }
1817
1818 # replace invalid utf8 character with SUBSTITUTION sequence
1819 sub esc_html {
1820         my $str = shift;
1821         my %opts = @_;
1822
1823         return undef unless defined $str;
1824
1825         $str = to_utf8($str);
1826         $str = $cgi->escapeHTML($str);
1827         if ($opts{'-nbsp'}) {
1828                 $str =~ s/ /&nbsp;/g;
1829         }
1830         $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
1831         return $str;
1832 }
1833
1834 # quote control characters and escape filename to HTML
1835 sub esc_path {
1836         my $str = shift;
1837         my %opts = @_;
1838
1839         return undef unless defined $str;
1840
1841         $str = to_utf8($str);
1842         $str = $cgi->escapeHTML($str);
1843         if ($opts{'-nbsp'}) {
1844                 $str =~ s/ /&nbsp;/g;
1845         }
1846         $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
1847         return $str;
1848 }
1849
1850 # Sanitize for use in XHTML + application/xml+xhtm (valid XML 1.0)
1851 sub sanitize {
1852         my $str = shift;
1853
1854         return undef unless defined $str;
1855
1856         $str = to_utf8($str);
1857         $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
1858         return $str;
1859 }
1860
1861 # Make control characters "printable", using character escape codes (CEC)
1862 sub quot_cec {
1863         my $cntrl = shift;
1864         my %opts = @_;
1865         my %es = ( # character escape codes, aka escape sequences
1866                 "\t" => '\t',   # tab            (HT)
1867                 "\n" => '\n',   # line feed      (LF)
1868                 "\r" => '\r',   # carrige return (CR)
1869                 "\f" => '\f',   # form feed      (FF)
1870                 "\b" => '\b',   # backspace      (BS)
1871                 "\a" => '\a',   # alarm (bell)   (BEL)
1872                 "\e" => '\e',   # escape         (ESC)
1873                 "\013" => '\v', # vertical tab   (VT)
1874                 "\000" => '\0', # nul character  (NUL)
1875         );
1876         my $chr = ( (exists $es{$cntrl})
1877                     ? $es{$cntrl}
1878                     : sprintf('\%2x', ord($cntrl)) );
1879         if ($opts{-nohtml}) {
1880                 return $chr;
1881         } else {
1882                 return "<span class=\"cntrl\">$chr</span>";
1883         }
1884 }
1885
1886 # Alternatively use unicode control pictures codepoints,
1887 # Unicode "printable representation" (PR)
1888 sub quot_upr {
1889         my $cntrl = shift;
1890         my %opts = @_;
1891
1892         my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
1893         if ($opts{-nohtml}) {
1894                 return $chr;
1895         } else {
1896                 return "<span class=\"cntrl\">$chr</span>";
1897         }
1898 }
1899
1900 # git may return quoted and escaped filenames
1901 sub unquote {
1902         my $str = shift;
1903
1904         sub unq {
1905                 my $seq = shift;
1906                 my %es = ( # character escape codes, aka escape sequences
1907                         't' => "\t",   # tab            (HT, TAB)
1908                         'n' => "\n",   # newline        (NL)
1909                         'r' => "\r",   # return         (CR)
1910                         'f' => "\f",   # form feed      (FF)
1911                         'b' => "\b",   # backspace      (BS)
1912                         'a' => "\a",   # alarm (bell)   (BEL)
1913                         'e' => "\e",   # escape         (ESC)
1914                         'v' => "\013", # vertical tab   (VT)
1915                 );
1916
1917                 if ($seq =~ m/^[0-7]{1,3}$/) {
1918                         # octal char sequence
1919                         return chr(oct($seq));
1920                 } elsif (exists $es{$seq}) {
1921                         # C escape sequence, aka character escape code
1922                         return $es{$seq};
1923                 }
1924                 # quoted ordinary character
1925                 return $seq;
1926         }
1927
1928         if ($str =~ m/^"(.*)"$/) {
1929                 # needs unquoting
1930                 $str = $1;
1931                 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
1932         }
1933         return $str;
1934 }
1935
1936 # escape tabs (convert tabs to spaces)
1937 sub untabify {
1938         my $line = shift;
1939
1940         while ((my $pos = index($line, "\t")) != -1) {
1941                 if (my $count = (8 - ($pos % 8))) {
1942                         my $spaces = ' ' x $count;
1943                         $line =~ s/\t/$spaces/;
1944                 }
1945         }
1946
1947         return $line;
1948 }
1949
1950 sub project_in_list {
1951         my $project = shift;
1952         my @list = git_get_projects_list();
1953         return @list && scalar(grep { $_->{'path'} eq $project } @list);
1954 }
1955
1956 ## ----------------------------------------------------------------------
1957 ## HTML aware string manipulation
1958
1959 # Try to chop given string on a word boundary between position
1960 # $len and $len+$add_len. If there is no word boundary there,
1961 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
1962 # (marking chopped part) would be longer than given string.
1963 sub chop_str {
1964         my $str = shift;
1965         my $len = shift;
1966         my $add_len = shift || 10;
1967         my $where = shift || 'right'; # 'left' | 'center' | 'right'
1968
1969         # Make sure perl knows it is utf8 encoded so we don't
1970         # cut in the middle of a utf8 multibyte char.
1971         $str = to_utf8($str);
1972
1973         # allow only $len chars, but don't cut a word if it would fit in $add_len
1974         # if it doesn't fit, cut it if it's still longer than the dots we would add
1975         # remove chopped character entities entirely
1976
1977         # when chopping in the middle, distribute $len into left and right part
1978         # return early if chopping wouldn't make string shorter
1979         if ($where eq 'center') {
1980                 return $str if ($len + 5 >= length($str)); # filler is length 5
1981                 $len = int($len/2);
1982         } else {
1983                 return $str if ($len + 4 >= length($str)); # filler is length 4
1984         }
1985
1986         # regexps: ending and beginning with word part up to $add_len
1987         my $endre = qr/.{$len}\w{0,$add_len}/;
1988         my $begre = qr/\w{0,$add_len}.{$len}/;
1989
1990         if ($where eq 'left') {
1991                 $str =~ m/^(.*?)($begre)$/;
1992                 my ($lead, $body) = ($1, $2);
1993                 if (length($lead) > 4) {
1994                         $lead = " ...";
1995                 }
1996                 return "$lead$body";
1997
1998         } elsif ($where eq 'center') {
1999                 $str =~ m/^($endre)(.*)$/;
2000                 my ($left, $str)  = ($1, $2);
2001                 $str =~ m/^(.*?)($begre)$/;
2002                 my ($mid, $right) = ($1, $2);
2003                 if (length($mid) > 5) {
2004                         $mid = " ... ";
2005                 }
2006                 return "$left$mid$right";
2007
2008         } else {
2009                 $str =~ m/^($endre)(.*)$/;
2010                 my $body = $1;
2011                 my $tail = $2;
2012                 if (length($tail) > 4) {
2013                         $tail = "... ";
2014                 }
2015                 return "$body$tail";
2016         }
2017 }
2018
2019 # takes the same arguments as chop_str, but also wraps a <span> around the
2020 # result with a title attribute if it does get chopped. Additionally, the
2021 # string is HTML-escaped.
2022 sub chop_and_escape_str {
2023         my ($str) = @_;
2024
2025         my $chopped = chop_str(@_);
2026         $str = to_utf8($str);
2027         if ($chopped eq $str) {
2028                 return esc_html($chopped);
2029         } else {
2030                 $str =~ s/[[:cntrl:]]/?/g;
2031                 return $cgi->span({-title=>$str}, esc_html($chopped));
2032         }
2033 }
2034
2035 # Highlight selected fragments of string, using given CSS class,
2036 # and escape HTML.  It is assumed that fragments do not overlap.
2037 # Regions are passed as list of pairs (array references).
2038 #
2039 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
2040 # '<span class="mark">foo</span>bar'
2041 sub esc_html_hl_regions {
2042         my ($str, $css_class, @sel) = @_;
2043         my %opts = grep { ref($_) ne 'ARRAY' } @sel;
2044         @sel     = grep { ref($_) eq 'ARRAY' } @sel;
2045         return esc_html($str, %opts) unless @sel;
2046
2047         my $out = '';
2048         my $pos = 0;
2049
2050         for my $s (@sel) {
2051                 my ($begin, $end) = @$s;
2052
2053                 # Don't create empty <span> elements.
2054                 next if $end <= $begin;
2055
2056                 my $escaped = esc_html(substr($str, $begin, $end - $begin),
2057                                        %opts);
2058
2059                 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
2060                         if ($begin - $pos > 0);
2061                 $out .= $cgi->span({-class => $css_class}, $escaped);
2062
2063                 $pos = $end;
2064         }
2065         $out .= esc_html(substr($str, $pos), %opts)
2066                 if ($pos < length($str));
2067
2068         return $out;
2069 }
2070
2071 # return positions of beginning and end of each match
2072 sub matchpos_list {
2073         my ($str, $regexp) = @_;
2074         return unless (defined $str && defined $regexp);
2075
2076         my @matches;
2077         while ($str =~ /$regexp/g) {
2078                 push @matches, [$-[0], $+[0]];
2079         }
2080         return @matches;
2081 }
2082
2083 # highlight match (if any), and escape HTML
2084 sub esc_html_match_hl {
2085         my ($str, $regexp) = @_;
2086         return esc_html($str) unless defined $regexp;
2087
2088         my @matches = matchpos_list($str, $regexp);
2089         return esc_html($str) unless @matches;
2090
2091         return esc_html_hl_regions($str, 'match', @matches);
2092 }
2093
2094
2095 # highlight match (if any) of shortened string, and escape HTML
2096 sub esc_html_match_hl_chopped {
2097         my ($str, $chopped, $regexp) = @_;
2098         return esc_html_match_hl($str, $regexp) unless defined $chopped;
2099
2100         my @matches = matchpos_list($str, $regexp);
2101         return esc_html($chopped) unless @matches;
2102
2103         # filter matches so that we mark chopped string
2104         my $tail = "... "; # see chop_str
2105         unless ($chopped =~ s/\Q$tail\E$//) {
2106                 $tail = '';
2107         }
2108         my $chop_len = length($chopped);
2109         my $tail_len = length($tail);
2110         my @filtered;
2111
2112         for my $m (@matches) {
2113                 if ($m->[0] > $chop_len) {
2114                         push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
2115                         last;
2116                 } elsif ($m->[1] > $chop_len) {
2117                         push @filtered, [ $m->[0], $chop_len + $tail_len ];
2118                         last;
2119                 }
2120                 push @filtered, $m;
2121         }
2122
2123         return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
2124 }
2125
2126 ## ----------------------------------------------------------------------
2127 ## functions returning short strings
2128
2129 # CSS class for given age epoch value (in seconds)
2130 # and reference time (optional, defaults to now) as second value
2131 sub age_class {
2132         my ($age_epoch, $time_now) = @_;
2133         return "noage" unless defined $age_epoch;
2134         defined $time_now or $time_now = time;
2135         my $age = $time_now - $age_epoch;
2136
2137         if ($age < 60*60*2) {
2138                 return "age0";
2139         } elsif ($age < 60*60*24*2) {
2140                 return "age1";
2141         } else {
2142                 return "age2";
2143         }
2144 }
2145
2146 # convert age epoch in seconds to "nn units ago" string
2147 # reference time used is now unless second argument passed in
2148 # to get the old behavior, pass 0 as the first argument and
2149 # the time in seconds as the second
2150 sub age_string {
2151         my ($age_epoch, $time_now) = @_;
2152         return "unknown" unless defined $age_epoch;
2153         defined $time_now or $time_now = time;
2154         my $age = $time_now - $age_epoch;
2155         my $age_str;
2156
2157         if ($age > 60*60*24*365*2) {
2158                 $age_str = (int $age/60/60/24/365);
2159                 $age_str .= " years ago";
2160         } elsif ($age > 60*60*24*(365/12)*2) {
2161                 $age_str = int $age/60/60/24/(365/12);
2162                 $age_str .= " months ago";
2163         } elsif ($age > 60*60*24*7*2) {
2164                 $age_str = int $age/60/60/24/7;
2165                 $age_str .= " weeks ago";
2166         } elsif ($age > 60*60*24*2) {
2167                 $age_str = int $age/60/60/24;
2168                 $age_str .= " days ago";
2169         } elsif ($age > 60*60*2) {
2170                 $age_str = int $age/60/60;
2171                 $age_str .= " hours ago";
2172         } elsif ($age > 60*2) {
2173                 $age_str = int $age/60;
2174                 $age_str .= " min ago";
2175         } elsif ($age > 2) {
2176                 $age_str = int $age;
2177                 $age_str .= " sec ago";
2178         } else {
2179                 $age_str .= " right now";
2180         }
2181         return $age_str;
2182 }
2183
2184 # returns age_string if the age is <= 2 weeks otherwise an absolute date
2185 # this is typically shown to the user directly with the age_string_age as a title
2186 sub age_string_date {
2187         my ($age_epoch, $time_now) = @_;
2188         return "unknown" unless defined $age_epoch;
2189         defined $time_now or $time_now = time;
2190         my $age = $time_now - $age_epoch;
2191
2192         if ($age > 60*60*24*7*2) {
2193                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2194                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2195         } else {
2196                 return age_string($age_epoch, $time_now);
2197         }
2198 }
2199
2200 # returns an absolute date if the age is <= 2 weeks otherwise age_string
2201 # this is typically used for the 'title' attribute so it will show as a tooltip
2202 sub age_string_age {
2203         my ($age_epoch, $time_now) = @_;
2204         return "unknown" unless defined $age_epoch;
2205         defined $time_now or $time_now = time;
2206         my $age = $time_now - $age_epoch;
2207
2208         if ($age > 60*60*24*7*2) {
2209                 return age_string($age_epoch, $time_now);
2210         } else {
2211                 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($age_epoch);
2212                 return sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
2213         }
2214 }
2215
2216 use constant {
2217         S_IFINVALID => 0030000,
2218         S_IFGITLINK => 0160000,
2219 };
2220
2221 # submodule/subproject, a commit object reference
2222 sub S_ISGITLINK {
2223         my $mode = shift;
2224
2225         return (($mode & S_IFMT) == S_IFGITLINK)
2226 }
2227
2228 # convert file mode in octal to symbolic file mode string
2229 sub mode_str {
2230         my $mode = oct shift;
2231
2232         if (S_ISGITLINK($mode)) {
2233                 return 'm---------';
2234         } elsif (S_ISDIR($mode & S_IFMT)) {
2235                 return 'drwxr-xr-x';
2236         } elsif (S_ISLNK($mode)) {
2237                 return 'lrwxrwxrwx';
2238         } elsif (S_ISREG($mode)) {
2239                 # git cares only about the executable bit
2240                 if ($mode & S_IXUSR) {
2241                         return '-rwxr-xr-x';
2242                 } else {
2243                         return '-rw-r--r--';
2244                 };
2245         } else {
2246                 return '----------';
2247         }
2248 }
2249
2250 # convert file mode in octal to file type string
2251 sub file_type {
2252         my $mode = shift;
2253
2254         if ($mode !~ m/^[0-7]+$/) {
2255                 return $mode;
2256         } else {
2257                 $mode = oct $mode;
2258         }
2259
2260         if (S_ISGITLINK($mode)) {
2261                 return "submodule";
2262         } elsif (S_ISDIR($mode & S_IFMT)) {
2263                 return "directory";
2264         } elsif (S_ISLNK($mode)) {
2265                 return "symlink";
2266         } elsif (S_ISREG($mode)) {
2267                 return "file";
2268         } else {
2269                 return "unknown";
2270         }
2271 }
2272
2273 # convert file mode in octal to file type description string
2274 sub file_type_long {
2275         my $mode = shift;
2276
2277         if ($mode !~ m/^[0-7]+$/) {
2278                 return $mode;
2279         } else {
2280                 $mode = oct $mode;
2281         }
2282
2283         if (S_ISGITLINK($mode)) {
2284                 return "submodule";
2285         } elsif (S_ISDIR($mode & S_IFMT)) {
2286                 return "directory";
2287         } elsif (S_ISLNK($mode)) {
2288                 return "symlink";
2289         } elsif (S_ISREG($mode)) {
2290                 if ($mode & S_IXUSR) {
2291                         return "executable";
2292                 } else {
2293                         return "file";
2294                 };
2295         } else {
2296                 return "unknown";
2297         }
2298 }
2299
2300
2301 ## ----------------------------------------------------------------------
2302 ## functions returning short HTML fragments, or transforming HTML fragments
2303 ## which don't belong to other sections
2304
2305 # format line of commit message.
2306 sub format_log_line_html {
2307         my $line = shift;
2308
2309         $line = esc_html($line, -nbsp=>1);
2310         $line =~ s{\b([0-9a-fA-F]{8,40})\b}{
2311                 $cgi->a({-href => href(action=>"object", hash=>$1),
2312                                         -class => "text"}, $1);
2313         }eg;
2314
2315         return $line;
2316 }
2317
2318 # format marker of refs pointing to given object
2319
2320 # the destination action is chosen based on object type and current context:
2321 # - for annotated tags, we choose the tag view unless it's the current view
2322 #   already, in which case we go to shortlog view
2323 # - for other refs, we keep the current view if we're in history, shortlog or
2324 #   log view, and select shortlog otherwise
2325 sub format_ref_marker {
2326         my ($refs, $id) = @_;
2327         my $markers = '';
2328
2329         if (defined $refs->{$id}) {
2330                 foreach my $ref (@{$refs->{$id}}) {
2331                         # this code exploits the fact that non-lightweight tags are the
2332                         # only indirect objects, and that they are the only objects for which
2333                         # we want to use tag instead of shortlog as action
2334                         my ($type, $name) = qw();
2335                         my $indirect = ($ref =~ s/\^\{\}$//);
2336                         # e.g. tags/v2.6.11 or heads/next
2337                         if ($ref =~ m!^(.*?)s?/(.*)$!) {
2338                                 $type = $1;
2339                                 $name = $2;
2340                         } else {
2341                                 $type = "ref";
2342                                 $name = $ref;
2343                         }
2344
2345                         my $class = $type;
2346                         $class .= " indirect" if $indirect;
2347
2348                         my $dest_action = "shortlog";
2349
2350                         if ($indirect) {
2351                                 $dest_action = "tag" unless $action eq "tag";
2352                         } elsif ($action =~ /^(history|(short)?log)$/) {
2353                                 $dest_action = $action;
2354                         }
2355
2356                         my $dest = "";
2357                         $dest .= "refs/" unless $ref =~ m!^refs/!;
2358                         $dest .= $ref;
2359
2360                         my $link = $cgi->a({
2361                                 -href => href(
2362                                         action=>$dest_action,
2363                                         hash=>$dest
2364                                 )}, $name);
2365
2366                         $markers .= " <span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2367                                 $link . "</span>";
2368                 }
2369         }
2370
2371         if ($markers) {
2372                 return ' <span class="refs">'. $markers . '</span>';
2373         } else {
2374                 return "";
2375         }
2376 }
2377
2378 # format, perhaps shortened and with markers, title line
2379 sub format_subject_html {
2380         my ($long, $short, $href, $extra) = @_;
2381         $extra = '' unless defined($extra);
2382
2383         if (length($short) < length($long)) {
2384                 $long =~ s/[[:cntrl:]]/?/g;
2385                 return $cgi->a({-href => $href, -class => "list subject",
2386                                 -title => to_utf8($long)},
2387                        esc_html($short)) . $extra;
2388         } else {
2389                 return $cgi->a({-href => $href, -class => "list subject"},
2390                        esc_html($long)) . $extra;
2391         }
2392 }
2393
2394 # Rather than recomputing the url for an email multiple times, we cache it
2395 # after the first hit. This gives a visible benefit in views where the avatar
2396 # for the same email is used repeatedly (e.g. shortlog).
2397 # The cache is shared by all avatar engines (currently gravatar only), which
2398 # are free to use it as preferred. Since only one avatar engine is used for any
2399 # given page, there's no risk for cache conflicts.
2400 our %avatar_cache = ();
2401
2402 # Compute the picon url for a given email, by using the picon search service over at
2403 # http://www.cs.indiana.edu/picons/search.html
2404 sub picon_url {
2405         my $email = lc shift;
2406         if (!$avatar_cache{$email}) {
2407                 my ($user, $domain) = split('@', $email);
2408                 $avatar_cache{$email} =
2409                         "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2410                         "$domain/$user/" .
2411                         "users+domains+unknown/up/single";
2412         }
2413         return $avatar_cache{$email};
2414 }
2415
2416 # Compute the gravatar url for a given email, if it's not in the cache already.
2417 # Gravatar stores only the part of the URL before the size, since that's the
2418 # one computationally more expensive. This also allows reuse of the cache for
2419 # different sizes (for this particular engine).
2420 sub gravatar_url {
2421         my $email = lc shift;
2422         my $size = shift;
2423         $avatar_cache{$email} ||=
2424                 "//www.gravatar.com/avatar/" .
2425                         Digest::MD5::md5_hex($email) . "?s=";
2426         return $avatar_cache{$email} . $size;
2427 }
2428
2429 # Insert an avatar for the given $email at the given $size if the feature
2430 # is enabled.
2431 sub git_get_avatar {
2432         my ($email, %opts) = @_;
2433         my $pre_white  = ($opts{-pad_before} ? "&nbsp;" : "");
2434         my $post_white = ($opts{-pad_after}  ? "&nbsp;" : "");
2435         $opts{-size} ||= 'default';
2436         my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2437         my $url = "";
2438         if ($git_avatar eq 'gravatar') {
2439                 $url = gravatar_url($email, $size);
2440         } elsif ($git_avatar eq 'picon') {
2441                 $url = picon_url($email);
2442         }
2443         # Other providers can be added by extending the if chain, defining $url
2444         # as needed. If no variant puts something in $url, we assume avatars
2445         # are completely disabled/unavailable.
2446         if ($url) {
2447                 return $pre_white .
2448                        "<img width=\"$size\" " .
2449                             "class=\"avatar\" " .
2450                             "src=\"".esc_url($url)."\" " .
2451                             "alt=\"\" " .
2452                        "/>" . $post_white;
2453         } else {
2454                 return "";
2455         }
2456 }
2457
2458 sub format_search_author {
2459         my ($author, $searchtype, $displaytext) = @_;
2460         my $have_search = gitweb_check_feature('search');
2461
2462         if ($have_search) {
2463                 my $performed = "";
2464                 if ($searchtype eq 'author') {
2465                         $performed = "authored";
2466                 } elsif ($searchtype eq 'committer') {
2467                         $performed = "committed";
2468                 }
2469
2470                 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2471                                 searchtext=>$author,
2472                                 searchtype=>$searchtype), class=>"list",
2473                                 title=>"Search for commits $performed by $author"},
2474                                 $displaytext);
2475
2476         } else {
2477                 return $displaytext;
2478         }
2479 }
2480
2481 # format the author name of the given commit with the given tag
2482 # the author name is chopped and escaped according to the other
2483 # optional parameters (see chop_str).
2484 sub format_author_html {
2485         my $tag = shift;
2486         my $co = shift;
2487         my $author = chop_and_escape_str($co->{'author_name'}, @_);
2488         return "<$tag class=\"author\">" .
2489                format_search_author($co->{'author_name'}, "author",
2490                        git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2491                        $author) .
2492                "</$tag>";
2493 }
2494
2495 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2496 sub format_git_diff_header_line {
2497         my $line = shift;
2498         my $diffinfo = shift;
2499         my ($from, $to) = @_;
2500
2501         if ($diffinfo->{'nparents'}) {
2502                 # combined diff
2503                 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2504                 if ($to->{'href'}) {
2505                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2506                                          esc_path($to->{'file'}));
2507                 } else { # file was deleted (no href)
2508                         $line .= esc_path($to->{'file'});
2509                 }
2510         } else {
2511                 # "ordinary" diff
2512                 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2513                 if ($from->{'href'}) {
2514                         $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2515                                          'a/' . esc_path($from->{'file'}));
2516                 } else { # file was added (no href)
2517                         $line .= 'a/' . esc_path($from->{'file'});
2518                 }
2519                 $line .= ' ';
2520                 if ($to->{'href'}) {
2521                         $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2522                                          'b/' . esc_path($to->{'file'}));
2523                 } else { # file was deleted
2524                         $line .= 'b/' . esc_path($to->{'file'});
2525                 }
2526         }
2527
2528         return "<div class=\"diff header\">$line</div>\n";
2529 }
2530
2531 # format extended diff header line, before patch itself
2532 sub format_extended_diff_header_line {
2533         my $line = shift;
2534         my $diffinfo = shift;
2535         my ($from, $to) = @_;
2536
2537         # match <path>
2538         if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2539                 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2540                                        esc_path($from->{'file'}));
2541         }
2542         if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2543                 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2544                                  esc_path($to->{'file'}));
2545         }
2546         # match single <mode>
2547         if ($line =~ m/\s(\d{6})$/) {
2548                 $line .= '<span class="info"> (' .
2549                          file_type_long($1) .
2550                          ')</span>';
2551         }
2552         # match <hash>
2553         if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2554                 # can match only for combined diff
2555                 $line = 'index ';
2556                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2557                         if ($from->{'href'}[$i]) {
2558                                 $line .= $cgi->a({-href=>$from->{'href'}[$i],
2559                                                   -class=>"hash"},
2560                                                  substr($diffinfo->{'from_id'}[$i],0,7));
2561                         } else {
2562                                 $line .= '0' x 7;
2563                         }
2564                         # separator
2565                         $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
2566                 }
2567                 $line .= '..';
2568                 if ($to->{'href'}) {
2569                         $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2570                                          substr($diffinfo->{'to_id'},0,7));
2571                 } else {
2572                         $line .= '0' x 7;
2573                 }
2574
2575         } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
2576                 # can match only for ordinary diff
2577                 my ($from_link, $to_link);
2578                 if ($from->{'href'}) {
2579                         $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
2580                                              substr($diffinfo->{'from_id'},0,7));
2581                 } else {
2582                         $from_link = '0' x 7;
2583                 }
2584                 if ($to->{'href'}) {
2585                         $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2586                                            substr($diffinfo->{'to_id'},0,7));
2587                 } else {
2588                         $to_link = '0' x 7;
2589                 }
2590                 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
2591                 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
2592         }
2593
2594         return $line . "<br/>\n";
2595 }
2596
2597 # format from-file/to-file diff header
2598 sub format_diff_from_to_header {
2599         my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
2600         my $line;
2601         my $result = '';
2602
2603         $line = $from_line;
2604         #assert($line =~ m/^---/) if DEBUG;
2605         # no extra formatting for "^--- /dev/null"
2606         if (! $diffinfo->{'nparents'}) {
2607                 # ordinary (single parent) diff
2608                 if ($line =~ m!^--- "?a/!) {
2609                         if ($from->{'href'}) {
2610                                 $line = '--- a/' .
2611                                         $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2612                                                 esc_path($from->{'file'}));
2613                         } else {
2614                                 $line = '--- a/' .
2615                                         esc_path($from->{'file'});
2616                         }
2617                 }
2618                 $result .= qq!<div class="diff from_file">$line</div>\n!;
2619
2620         } else {
2621                 # combined diff (merge commit)
2622                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2623                         if ($from->{'href'}[$i]) {
2624                                 $line = '--- ' .
2625                                         $cgi->a({-href=>href(action=>"blobdiff",
2626                                                              hash_parent=>$diffinfo->{'from_id'}[$i],
2627                                                              hash_parent_base=>$parents[$i],
2628                                                              file_parent=>$from->{'file'}[$i],
2629                                                              hash=>$diffinfo->{'to_id'},
2630                                                              hash_base=>$hash,
2631                                                              file_name=>$to->{'file'}),
2632                                                  -class=>"path",
2633                                                  -title=>"diff" . ($i+1)},
2634                                                 $i+1) .
2635                                         '/' .
2636                                         $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
2637                                                 esc_path($from->{'file'}[$i]));
2638                         } else {
2639                                 $line = '--- /dev/null';
2640                         }
2641                         $result .= qq!<div class="diff from_file">$line</div>\n!;
2642                 }
2643         }
2644
2645         $line = $to_line;
2646         #assert($line =~ m/^\+\+\+/) if DEBUG;
2647         # no extra formatting for "^+++ /dev/null"
2648         if ($line =~ m!^\+\+\+ "?b/!) {
2649                 if ($to->{'href'}) {
2650                         $line = '+++ b/' .
2651                                 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2652                                         esc_path($to->{'file'}));
2653                 } else {
2654                         $line = '+++ b/' .
2655                                 esc_path($to->{'file'});
2656                 }
2657         }
2658         $result .= qq!<div class="diff to_file">$line</div>\n!;
2659
2660         return $result;
2661 }
2662
2663 # create note for patch simplified by combined diff
2664 sub format_diff_cc_simplified {
2665         my ($diffinfo, @parents) = @_;
2666         my $result = '';
2667
2668         $result .= "<div class=\"diff header\">" .
2669                    "diff --cc ";
2670         if (!is_deleted($diffinfo)) {
2671                 $result .= $cgi->a({-href => href(action=>"blob",
2672                                                   hash_base=>$hash,
2673                                                   hash=>$diffinfo->{'to_id'},
2674                                                   file_name=>$diffinfo->{'to_file'}),
2675                                     -class => "path"},
2676                                    esc_path($diffinfo->{'to_file'}));
2677         } else {
2678                 $result .= esc_path($diffinfo->{'to_file'});
2679         }
2680         $result .= "</div>\n" . # class="diff header"
2681                    "<div class=\"diff nodifferences\">" .
2682                    "Simple merge" .
2683                    "</div>\n"; # class="diff nodifferences"
2684
2685         return $result;
2686 }
2687
2688 sub diff_line_class {
2689         my ($line, $from, $to) = @_;
2690
2691         # ordinary diff
2692         my $num_sign = 1;
2693         # combined diff
2694         if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
2695                 $num_sign = scalar @{$from->{'href'}};
2696         }
2697
2698         my @diff_line_classifier = (
2699                 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
2700                 { regexp => qr/^\\/,               class => "incomplete"  },
2701                 { regexp => qr/^ {$num_sign}/,     class => "ctx" },
2702                 # classifier for context must come before classifier add/rem,
2703                 # or we would have to use more complicated regexp, for example
2704                 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
2705                 { regexp => qr/^[+ ]{$num_sign}/,   class => "add" },
2706                 { regexp => qr/^[- ]{$num_sign}/,   class => "rem" },
2707         );
2708         for my $clsfy (@diff_line_classifier) {
2709                 return $clsfy->{'class'}
2710                         if ($line =~ $clsfy->{'regexp'});
2711         }
2712
2713         # fallback
2714         return "";
2715 }
2716
2717 # assumes that $from and $to are defined and correctly filled,
2718 # and that $line holds a line of chunk header for unified diff
2719 sub format_unidiff_chunk_header {
2720         my ($line, $from, $to) = @_;
2721
2722         my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
2723                 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
2724
2725         $from_lines = 0 unless defined $from_lines;
2726         $to_lines   = 0 unless defined $to_lines;
2727
2728         if ($from->{'href'}) {
2729                 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
2730                                      -class=>"list"}, $from_text);
2731         }
2732         if ($to->{'href'}) {
2733                 $to_text   = $cgi->a({-href=>"$to->{'href'}#l$to_start",
2734                                      -class=>"list"}, $to_text);
2735         }
2736         $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
2737                 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
2738         return $line;
2739 }
2740
2741 # assumes that $from and $to are defined and correctly filled,
2742 # and that $line holds a line of chunk header for combined diff
2743 sub format_cc_diff_chunk_header {
2744         my ($line, $from, $to) = @_;
2745
2746         my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
2747         my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
2748
2749         @from_text = split(' ', $ranges);
2750         for (my $i = 0; $i < @from_text; ++$i) {
2751                 ($from_start[$i], $from_nlines[$i]) =
2752                         (split(',', substr($from_text[$i], 1)), 0);
2753         }
2754
2755         $to_text   = pop @from_text;
2756         $to_start  = pop @from_start;
2757         $to_nlines = pop @from_nlines;
2758
2759         $line = "<span class=\"chunk_info\">$prefix ";
2760         for (my $i = 0; $i < @from_text; ++$i) {
2761                 if ($from->{'href'}[$i]) {
2762                         $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
2763                                           -class=>"list"}, $from_text[$i]);
2764                 } else {
2765                         $line .= $from_text[$i];
2766                 }
2767                 $line .= " ";
2768         }
2769         if ($to->{'href'}) {
2770                 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
2771                                   -class=>"list"}, $to_text);
2772         } else {
2773                 $line .= $to_text;
2774         }
2775         $line .= " $prefix</span>" .
2776                  "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
2777         return $line;
2778 }
2779
2780 # process patch (diff) line (not to be used for diff headers),
2781 # returning HTML-formatted (but not wrapped) line.
2782 # If the line is passed as a reference, it is treated as HTML and not
2783 # esc_html()'ed.
2784 sub format_diff_line {
2785         my ($line, $diff_class, $from, $to) = @_;
2786
2787         if (ref($line)) {
2788                 $line = $$line;
2789         } else {
2790                 chomp $line;
2791                 $line = untabify($line);
2792
2793                 if ($from && $to && $line =~ m/^\@{2} /) {
2794                         $line = format_unidiff_chunk_header($line, $from, $to);
2795                 } elsif ($from && $to && $line =~ m/^\@{3}/) {
2796                         $line = format_cc_diff_chunk_header($line, $from, $to);
2797                 } else {
2798                         $line = esc_html($line, -nbsp=>1);
2799                 }
2800         }
2801
2802         my $diff_classes = "diff";
2803         $diff_classes .= " $diff_class" if ($diff_class);
2804         $line = "<div class=\"$diff_classes\">$line</div>\n";
2805
2806         return $line;
2807 }
2808
2809 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
2810 # linked.  Pass the hash of the tree/commit to snapshot.
2811 sub format_snapshot_links {
2812         my ($hash) = @_;
2813         my $num_fmts = @snapshot_fmts;
2814         if ($num_fmts > 1) {
2815                 # A parenthesized list of links bearing format names.
2816                 # e.g. "snapshot (_tar.gz_ _zip_)"
2817                 return "snapshot (" . join(' ', map
2818                         $cgi->a({
2819                                 -href => href(
2820                                         action=>"snapshot",
2821                                         hash=>$hash,
2822                                         snapshot_format=>$_
2823                                 )
2824                         }, $known_snapshot_formats{$_}{'display'})
2825                 , @snapshot_fmts) . ")";
2826         } elsif ($num_fmts == 1) {
2827                 # A single "snapshot" link whose tooltip bears the format name.
2828                 # i.e. "_snapshot_"
2829                 my ($fmt) = @snapshot_fmts;
2830                 return
2831                         $cgi->a({
2832                                 -href => href(
2833                                         action=>"snapshot",
2834                                         hash=>$hash,
2835                                         snapshot_format=>$fmt
2836                                 ),
2837                                 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
2838                         }, "snapshot");
2839         } else { # $num_fmts == 0
2840                 return undef;
2841         }
2842 }
2843
2844 ## ......................................................................
2845 ## functions returning values to be passed, perhaps after some
2846 ## transformation, to other functions; e.g. returning arguments to href()
2847
2848 # returns hash to be passed to href to generate gitweb URL
2849 # in -title key it returns description of link
2850 sub get_feed_info {
2851         my $format = shift || 'Atom';
2852         my %res = (action => lc($format));
2853         my $matched_ref = 0;
2854
2855         # feed links are possible only for project views
2856         return unless (defined $project);
2857         # some views should link to OPML, or to generic project feed,
2858         # or don't have specific feed yet (so they should use generic)
2859         return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
2860
2861         my $branch = undef;
2862         # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
2863         # (fullname) to differentiate from tag links; this also makes
2864         # possible to detect branch links
2865         for my $ref (get_branch_refs()) {
2866                 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
2867                     (defined $hash      && $hash      =~ m!^refs/\Q$ref\E/(.*)$!)) {
2868                         $branch = $1;
2869                         $matched_ref = $ref;
2870                         last;
2871                 }
2872         }
2873         # find log type for feed description (title)
2874         my $type = 'log';
2875         if (defined $file_name) {
2876                 $type  = "history of $file_name";
2877                 $type .= "/" if ($action eq 'tree');
2878                 $type .= " on '$branch'" if (defined $branch);
2879         } else {
2880                 $type = "log of $branch" if (defined $branch);
2881         }
2882
2883         $res{-title} = $type;
2884         $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
2885         $res{'file_name'} = $file_name;
2886
2887         return %res;
2888 }
2889
2890 ## ----------------------------------------------------------------------
2891 ## git utility subroutines, invoking git commands
2892
2893 # returns path to the core git executable and the --git-dir parameter as list
2894 sub git_cmd {
2895         $number_of_git_cmds++;
2896         return $GIT, '--git-dir='.$git_dir;
2897 }
2898
2899 # opens a "-|" cmd pipe handle with 2>/dev/null and returns it
2900 sub cmd_pipe {
2901
2902         # In order to be compatible with FCGI mode we must use POSIX
2903         # and access the STDERR_FILENO file descriptor directly
2904
2905         use POSIX qw(STDERR_FILENO dup dup2);
2906
2907         open(my $null, '>', File::Spec->devnull) or die "couldn't open devnull: $!";
2908         (my $saveerr = dup(STDERR_FILENO)) or die "couldn't dup STDERR: $!";
2909         my $dup2ok = dup2(fileno($null), STDERR_FILENO);
2910         close($null) or !$dup2ok or die "couldn't close NULL: $!";
2911         $dup2ok or POSIX::close($saveerr), die "couldn't dup NULL to STDERR: $!";
2912         my $result = open(my $fd, "-|", @_);
2913         $dup2ok = dup2($saveerr, STDERR_FILENO);
2914         POSIX::close($saveerr) or !$dup2ok or die "couldn't close SAVEERR: $!";
2915         $dup2ok or die "couldn't dup SAVERR to STDERR: $!";
2916
2917         return $result ? $fd : undef;
2918 }
2919
2920 # opens a "-|" git_cmd pipe handle with 2>/dev/null and returns it
2921 sub git_cmd_pipe {
2922         return cmd_pipe git_cmd(), @_;
2923 }
2924
2925 # quote the given arguments for passing them to the shell
2926 # quote_command("command", "arg 1", "arg with ' and ! characters")
2927 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
2928 # Try to avoid using this function wherever possible.
2929 sub quote_command {
2930         return join(' ',
2931                 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
2932 }
2933
2934 # get HEAD ref of given project as hash
2935 sub git_get_head_hash {
2936         return git_get_full_hash(shift, 'HEAD');
2937 }
2938
2939 sub git_get_full_hash {
2940         return git_get_hash(@_);
2941 }
2942
2943 sub git_get_short_hash {
2944         return git_get_hash(@_, '--short=7');
2945 }
2946
2947 sub git_get_hash {
2948         my ($project, $hash, @options) = @_;
2949         my $o_git_dir = $git_dir;
2950         my $retval = undef;
2951         $git_dir = "$projectroot/$project";
2952         if (defined(my $fd = git_cmd_pipe 'rev-parse',
2953             '--verify', '-q', @options, $hash)) {
2954                 $retval = <$fd>;
2955                 chomp $retval if defined $retval;
2956                 close $fd;
2957         }
2958         if (defined $o_git_dir) {
2959                 $git_dir = $o_git_dir;
2960         }
2961         return $retval;
2962 }
2963
2964 # get type of given object
2965 sub git_get_type {
2966         my $hash = shift;
2967
2968         defined(my $fd = git_cmd_pipe "cat-file", '-t', $hash) or return;
2969         my $type = <$fd>;
2970         close $fd or return;
2971         chomp $type;
2972         return $type;
2973 }
2974
2975 # repository configuration
2976 our $config_file = '';
2977 our %config;
2978
2979 # store multiple values for single key as anonymous array reference
2980 # single values stored directly in the hash, not as [ <value> ]
2981 sub hash_set_multi {
2982         my ($hash, $key, $value) = @_;
2983
2984         if (!exists $hash->{$key}) {
2985                 $hash->{$key} = $value;
2986         } elsif (!ref $hash->{$key}) {
2987                 $hash->{$key} = [ $hash->{$key}, $value ];
2988         } else {
2989                 push @{$hash->{$key}}, $value;
2990         }
2991 }
2992
2993 # return hash of git project configuration
2994 # optionally limited to some section, e.g. 'gitweb'
2995 sub git_parse_project_config {
2996         my $section_regexp = shift;
2997         my %config;
2998
2999         local $/ = "\0";
3000
3001         defined(my $fh = git_cmd_pipe "config", '-z', '-l')
3002                 or return;
3003
3004         while (my $keyval = to_utf8(scalar <$fh>)) {
3005                 chomp $keyval;
3006                 my ($key, $value) = split(/\n/, $keyval, 2);
3007
3008                 hash_set_multi(\%config, $key, $value)
3009                         if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
3010         }
3011         close $fh;
3012
3013         return %config;
3014 }
3015
3016 # convert config value to boolean: 'true' or 'false'
3017 # no value, number > 0, 'true' and 'yes' values are true
3018 # rest of values are treated as false (never as error)
3019 sub config_to_bool {
3020         my $val = shift;
3021
3022         return 1 if !defined $val;             # section.key
3023
3024         # strip leading and trailing whitespace
3025         $val =~ s/^\s+//;
3026         $val =~ s/\s+$//;
3027
3028         return (($val =~ /^\d+$/ && $val) ||   # section.key = 1
3029                 ($val =~ /^(?:true|yes)$/i));  # section.key = true
3030 }
3031
3032 # convert config value to simple decimal number
3033 # an optional value suffix of 'k', 'm', or 'g' will cause the value
3034 # to be multiplied by 1024, 1048576, or 1073741824
3035 sub config_to_int {
3036         my $val = shift;
3037
3038         # strip leading and trailing whitespace
3039         $val =~ s/^\s+//;
3040         $val =~ s/\s+$//;
3041
3042         if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
3043                 $unit = lc($unit);
3044                 # unknown unit is treated as 1
3045                 return $num * ($unit eq 'g' ? 1073741824 :
3046                                $unit eq 'm' ?    1048576 :
3047                                $unit eq 'k' ?       1024 : 1);
3048         }
3049         return $val;
3050 }
3051
3052 # convert config value to array reference, if needed
3053 sub config_to_multi {
3054         my $val = shift;
3055
3056         return ref($val) ? $val : (defined($val) ? [ $val ] : []);
3057 }
3058
3059 sub git_get_project_config {
3060         my ($key, $type) = @_;
3061
3062         return unless defined $git_dir;
3063
3064         # key sanity check
3065         return unless ($key);
3066         # only subsection, if exists, is case sensitive,
3067         # and not lowercased by 'git config -z -l'
3068         if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
3069                 $lo =~ s/_//g;
3070                 $key = join(".", lc($hi), $mi, lc($lo));
3071                 return if ($lo =~ /\W/ || $hi =~ /\W/);
3072         } else {
3073                 $key = lc($key);
3074                 $key =~ s/_//g;
3075                 return if ($key =~ /\W/);
3076         }
3077         $key =~ s/^gitweb\.//;
3078
3079         # type sanity check
3080         if (defined $type) {
3081                 $type =~ s/^--//;
3082                 $type = undef
3083                         unless ($type eq 'bool' || $type eq 'int');
3084         }
3085
3086         # get config
3087         if (!defined $config_file ||
3088             $config_file ne "$git_dir/config") {
3089                 %config = git_parse_project_config('gitweb');
3090                 $config_file = "$git_dir/config";
3091         }
3092
3093         # check if config variable (key) exists
3094         return unless exists $config{"gitweb.$key"};
3095
3096         # ensure given type
3097         if (!defined $type) {
3098                 return $config{"gitweb.$key"};
3099         } elsif ($type eq 'bool') {
3100                 # backward compatibility: 'git config --bool' returns true/false
3101                 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
3102         } elsif ($type eq 'int') {
3103                 return config_to_int($config{"gitweb.$key"});
3104         }
3105         return $config{"gitweb.$key"};
3106 }
3107
3108 # get hash of given path at given ref
3109 sub git_get_hash_by_path {
3110         my $base = shift;
3111         my $path = shift || return undef;
3112         my $type = shift;
3113
3114         $path =~ s,/+$,,;
3115
3116         defined(my $fd = git_cmd_pipe "ls-tree", $base, "--", $path)
3117                 or die_error(500, "Open git-ls-tree failed");
3118         my $line = to_utf8(scalar <$fd>);
3119         close $fd or return undef;
3120
3121         if (!defined $line) {
3122                 # there is no tree or hash given by $path at $base
3123                 return undef;
3124         }
3125
3126         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3127         $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
3128         if (defined $type && $type ne $2) {
3129                 # type doesn't match
3130                 return undef;
3131         }
3132         return $3;
3133 }
3134
3135 # get path of entry with given hash at given tree-ish (ref)
3136 # used to get 'from' filename for combined diff (merge commit) for renames
3137 sub git_get_path_by_hash {
3138         my $base = shift || return;
3139         my $hash = shift || return;
3140
3141         local $/ = "\0";
3142
3143         defined(my $fd = git_cmd_pipe "ls-tree", '-r', '-t', '-z', $base)
3144                 or return undef;
3145         while (my $line = to_utf8(scalar <$fd>)) {
3146                 chomp $line;
3147
3148                 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423  gitweb'
3149                 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f  gitweb/README'
3150                 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
3151                         close $fd;
3152                         return $1;
3153                 }
3154         }
3155         close $fd;
3156         return undef;
3157 }
3158
3159 ## ......................................................................
3160 ## git utility functions, directly accessing git repository
3161
3162 # get the value of config variable either from file named as the variable
3163 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
3164 # configuration variable in the repository config file.
3165 sub git_get_file_or_project_config {
3166         my ($path, $name) = @_;
3167
3168         $git_dir = "$projectroot/$path";
3169         open my $fd, '<', "$git_dir/$name"
3170                 or return git_get_project_config($name);
3171         my $conf = to_utf8(scalar <$fd>);
3172         close $fd;
3173         if (defined $conf) {
3174                 chomp $conf;
3175         }
3176         return $conf;
3177 }
3178
3179 sub git_get_project_description {
3180         my $path = shift;
3181         return git_get_file_or_project_config($path, 'description');
3182 }
3183
3184 sub git_get_project_category {
3185         my $path = shift;
3186         return git_get_file_or_project_config($path, 'category');
3187 }
3188
3189
3190 # supported formats:
3191 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
3192 #   - if its contents is a number, use it as tag weight,
3193 #   - otherwise add a tag with weight 1
3194 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
3195 #   the same value multiple times increases tag weight
3196 # * `gitweb.ctag' multi-valued repo config variable
3197 sub git_get_project_ctags {
3198         my $project = shift;
3199         my $ctags = {};
3200
3201         $git_dir = "$projectroot/$project";
3202         if (opendir my $dh, "$git_dir/ctags") {
3203                 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
3204                 foreach my $tagfile (@files) {
3205                         open my $ct, '<', $tagfile
3206                                 or next;
3207                         my $val = <$ct>;
3208                         chomp $val if $val;
3209                         close $ct;
3210
3211                         (my $ctag = $tagfile) =~ s#.*/##;
3212                         $ctag = to_utf8($ctag);
3213                         if ($val =~ /^\d+$/) {
3214                                 $ctags->{$ctag} = $val;
3215                         } else {
3216                                 $ctags->{$ctag} = 1;
3217                         }
3218                 }
3219                 closedir $dh;
3220
3221         } elsif (open my $fh, '<', "$git_dir/ctags") {
3222                 while (my $line = to_utf8(scalar <$fh>)) {
3223                         chomp $line;
3224                         $ctags->{$line}++ if $line;
3225                 }
3226                 close $fh;
3227
3228         } else {
3229                 my $taglist = config_to_multi(git_get_project_config('ctag'));
3230                 foreach my $tag (@$taglist) {
3231                         $ctags->{$tag}++;
3232                 }
3233         }
3234
3235         return $ctags;
3236 }
3237
3238 # return hash, where keys are content tags ('ctags'),
3239 # and values are sum of weights of given tag in every project
3240 sub git_gather_all_ctags {
3241         my $projects = shift;
3242         my $ctags = {};
3243
3244         foreach my $p (@$projects) {
3245                 foreach my $ct (keys %{$p->{'ctags'}}) {
3246                         $ctags->{$ct} += $p->{'ctags'}->{$ct};
3247                 }
3248         }
3249
3250         return $ctags;
3251 }
3252
3253 sub git_populate_project_tagcloud {
3254         my ($ctags, $action) = @_;
3255
3256         # First, merge different-cased tags; tags vote on casing
3257         my %ctags_lc;
3258         foreach (keys %$ctags) {
3259                 $ctags_lc{lc $_}->{count} += $ctags->{$_};
3260                 if (not $ctags_lc{lc $_}->{topcount}
3261                     or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
3262                         $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
3263                         $ctags_lc{lc $_}->{topname} = $_;
3264                 }
3265         }
3266
3267         my $cloud;
3268         my $matched = $input_params{'ctag_filter'};
3269         if (eval { require HTML::TagCloud; 1; }) {
3270                 $cloud = HTML::TagCloud->new;
3271                 foreach my $ctag (sort keys %ctags_lc) {
3272                         # Pad the title with spaces so that the cloud looks
3273                         # less crammed.
3274                         my $title = esc_html($ctags_lc{$ctag}->{topname});
3275                         $title =~ s/ /&nbsp;/g;
3276                         $title =~ s/^/&nbsp;/g;
3277                         $title =~ s/$/&nbsp;/g;
3278                         if (defined $matched && $matched eq $ctag) {
3279                                 $title = qq(<span class="match">$title</span>);
3280                         }
3281                         $cloud->add($title, href(-replay=>1, action=>$action, ctag_filter=>$ctag),
3282                                     $ctags_lc{$ctag}->{count});
3283                 }
3284         } else {
3285                 $cloud = {};
3286                 foreach my $ctag (keys %ctags_lc) {
3287                         my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
3288                         if (defined $matched && $matched eq $ctag) {
3289                                 $title = qq(<span class="match">$title</span>);
3290                         }
3291                         $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3292                         $cloud->{$ctag}{ctag} =
3293                                 $cgi->a({-href=>href(-replay=>1, action=>$action, ctag_filter=>$ctag)}, $title);
3294                 }
3295         }
3296         return $cloud;
3297 }
3298
3299 sub git_show_project_tagcloud {
3300         my ($cloud, $count) = @_;
3301         if (ref $cloud eq 'HTML::TagCloud') {
3302                 return $cloud->html_and_css($count);
3303         } else {
3304                 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3305                 return
3306                         '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3307                         join (', ', map {
3308                                 $cloud->{$_}->{'ctag'}
3309                         } splice(@tags, 0, $count)) .
3310                         '</div>';
3311         }
3312 }
3313
3314 sub git_get_project_url_list {
3315         my $path = shift;
3316
3317         $git_dir = "$projectroot/$path";
3318         open my $fd, '<', "$git_dir/cloneurl"
3319                 or return wantarray ?
3320                 @{ config_to_multi(git_get_project_config('url')) } :
3321                    config_to_multi(git_get_project_config('url'));
3322         my @git_project_url_list = map { chomp; to_utf8($_) } <$fd>;
3323         close $fd;
3324
3325         return wantarray ? @git_project_url_list : \@git_project_url_list;
3326 }
3327
3328 sub git_get_projects_list {
3329         my $filter = shift || '';
3330         my $paranoid = shift;
3331         my @list;
3332
3333         if (-d $projects_list) {
3334                 # search in directory
3335                 my $dir = $projects_list;
3336                 # remove the trailing "/"
3337                 $dir =~ s!/+$!!;
3338                 my $pfxlen = length("$dir");
3339                 my $pfxdepth = ($dir =~ tr!/!!);
3340                 # when filtering, search only given subdirectory
3341                 if ($filter && !$paranoid) {
3342                         $dir .= "/$filter";
3343                         $dir =~ s!/+$!!;
3344                 }
3345
3346                 File::Find::find({
3347                         follow_fast => 1, # follow symbolic links
3348                         follow_skip => 2, # ignore duplicates
3349                         dangling_symlinks => 0, # ignore dangling symlinks, silently
3350                         wanted => sub {
3351                                 # global variables
3352                                 our $project_maxdepth;
3353                                 our $projectroot;
3354                                 # skip project-list toplevel, if we get it.
3355                                 return if (m!^[/.]$!);
3356                                 # only directories can be git repositories
3357                                 return unless (-d $_);
3358                                 # don't traverse too deep (Find is super slow on os x)
3359                                 # $project_maxdepth excludes depth of $projectroot
3360                                 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3361                                         $File::Find::prune = 1;
3362                                         return;
3363                                 }
3364
3365                                 my $path = substr($File::Find::name, $pfxlen + 1);
3366                                 # paranoidly only filter here
3367                                 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3368                                         next;
3369                                 }
3370                                 # we check related file in $projectroot
3371                                 if (check_export_ok("$projectroot/$path")) {
3372                                         push @list, { path => $path };
3373                                         $File::Find::prune = 1;
3374                                 }
3375                         },
3376                 }, "$dir");
3377
3378         } elsif (-f $projects_list) {
3379                 # read from file(url-encoded):
3380                 # 'git%2Fgit.git Linus+Torvalds'
3381                 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3382                 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3383                 open my $fd, '<', $projects_list or return;
3384         PROJECT:
3385                 while (my $line = <$fd>) {
3386                         chomp $line;
3387                         my ($path, $owner) = split ' ', $line;
3388                         $path = unescape($path);
3389                         $owner = unescape($owner);
3390                         if (!defined $path) {
3391                                 next;
3392                         }
3393                         # if $filter is rpovided, check if $path begins with $filter
3394                         if ($filter && $path !~ m!^\Q$filter\E/!) {
3395                                 next;
3396                         }
3397                         if (check_export_ok("$projectroot/$path")) {
3398                                 my $pr = {
3399                                         path => $path
3400                                 };
3401                                 if ($owner) {
3402                                         $pr->{'owner'} = to_utf8($owner);
3403                                 }
3404                                 push @list, $pr;
3405                         }
3406                 }
3407                 close $fd;
3408         }
3409         return @list;
3410 }
3411
3412 # written with help of Tree::Trie module (Perl Artistic License, GPL compatibile)
3413 # as side effects it sets 'forks' field to list of forks for forked projects
3414 sub filter_forks_from_projects_list {
3415         my $projects = shift;
3416
3417         my %trie; # prefix tree of directories (path components)
3418         # generate trie out of those directories that might contain forks
3419         foreach my $pr (@$projects) {
3420                 my $path = $pr->{'path'};
3421                 $path =~ s/\.git$//;      # forks of 'repo.git' are in 'repo/' directory
3422                 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3423                 next unless ($path);      # skip '.git' repository: tests, git-instaweb
3424                 next unless (-d "$projectroot/$path"); # containing directory exists
3425                 $pr->{'forks'} = [];      # there can be 0 or more forks of project
3426
3427                 # add to trie
3428                 my @dirs = split('/', $path);
3429                 # walk the trie, until either runs out of components or out of trie
3430                 my $ref = \%trie;
3431                 while (scalar @dirs &&
3432                        exists($ref->{$dirs[0]})) {
3433                         $ref = $ref->{shift @dirs};
3434                 }
3435                 # create rest of trie structure from rest of components
3436                 foreach my $dir (@dirs) {
3437                         $ref = $ref->{$dir} = {};
3438                 }
3439                 # create end marker, store $pr as a data
3440                 $ref->{''} = $pr if (!exists $ref->{''});
3441         }
3442
3443         # filter out forks, by finding shortest prefix match for paths
3444         my @filtered;
3445  PROJECT:
3446         foreach my $pr (@$projects) {
3447                 # trie lookup
3448                 my $ref = \%trie;
3449         DIR:
3450                 foreach my $dir (split('/', $pr->{'path'})) {
3451                         if (exists $ref->{''}) {
3452                                 # found [shortest] prefix, is a fork - skip it
3453                                 push @{$ref->{''}{'forks'}}, $pr;
3454                                 next PROJECT;
3455                         }
3456                         if (!exists $ref->{$dir}) {
3457                                 # not in trie, cannot have prefix, not a fork
3458                                 push @filtered, $pr;
3459                                 next PROJECT;
3460                         }
3461                         # If the dir is there, we just walk one step down the trie.
3462                         $ref = $ref->{$dir};
3463                 }
3464                 # we ran out of trie
3465                 # (shouldn't happen: it's either no match, or end marker)
3466                 push @filtered, $pr;
3467         }
3468
3469         return @filtered;
3470 }
3471
3472 # note: fill_project_list_info must be run first,
3473 # for 'descr_long' and 'ctags' to be filled
3474 sub search_projects_list {
3475         my ($projlist, %opts) = @_;
3476         my $tagfilter  = $opts{'tagfilter'};
3477         my $search_re = $opts{'search_regexp'};
3478
3479         return @$projlist
3480                 unless ($tagfilter || $search_re);
3481
3482         # searching projects require filling to be run before it;
3483         fill_project_list_info($projlist,
3484                                $tagfilter  ? 'ctags' : (),
3485                                $search_re ? ('path', 'descr') : ());
3486         my @projects;
3487  PROJECT:
3488         foreach my $pr (@$projlist) {
3489
3490                 if ($tagfilter) {
3491                         next unless ref($pr->{'ctags'}) eq 'HASH';
3492                         next unless
3493                                 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3494                 }
3495
3496                 if ($search_re) {
3497                         next unless
3498                                 $pr->{'path'} =~ /$search_re/ ||
3499                                 $pr->{'descr_long'} =~ /$search_re/;
3500                 }
3501
3502                 push @projects, $pr;
3503         }
3504
3505         return @projects;
3506 }
3507
3508 our $gitweb_project_owner = undef;
3509 sub git_get_project_list_from_file {
3510
3511         return if (defined $gitweb_project_owner);
3512
3513         $gitweb_project_owner = {};
3514         # read from file (url-encoded):
3515         # 'git%2Fgit.git Linus+Torvalds'
3516         # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3517         # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3518         if (-f $projects_list) {
3519                 open(my $fd, '<', $projects_list);
3520                 while (my $line = <$fd>) {
3521                         chomp $line;
3522                         my ($pr, $ow) = split ' ', $line;
3523                         $pr = unescape($pr);
3524                         $ow = unescape($ow);
3525                         $gitweb_project_owner->{$pr} = to_utf8($ow);
3526                 }
3527                 close $fd;
3528         }
3529 }
3530
3531 sub git_get_project_owner {
3532         my $project = shift;
3533         my $owner;
3534
3535         return undef unless $project;
3536         $git_dir = "$projectroot/$project";
3537
3538         if (!defined $gitweb_project_owner) {
3539                 git_get_project_list_from_file();
3540         }
3541
3542         if (exists $gitweb_project_owner->{$project}) {
3543                 $owner = $gitweb_project_owner->{$project};
3544         }
3545         if (!defined $owner){
3546                 $owner = git_get_project_config('owner');
3547         }
3548         if (!defined $owner) {
3549                 $owner = get_file_owner("$git_dir");
3550         }
3551
3552         return $owner;
3553 }
3554
3555 sub parse_activity_date {
3556         my $dstr = shift;
3557
3558         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
3559                 # Unix timestamp
3560                 return 0 + $1;
3561         }
3562         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt _](\d{1,2}):(\d{2}):(\d{2})(?:[ _]?([Zz]|(?:[-+]\d{1,2}:?\d{2})))?\s*$/) {
3563                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
3564                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
3565                 defined($z) && $z ne '' or $z = 'Z';
3566                 $z =~ s/://;
3567                 substr($z,1,0) = '0' if length($z) == 4;
3568                 my $off = 0;
3569                 if (uc($z) ne 'Z') {
3570                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
3571                         $off = -$off if substr($z,0,1) eq '-';
3572                 }
3573                 return $seconds - $off;
3574         }
3575         return undef;
3576 }
3577
3578 # If $quick is true only look at $lastactivity_file
3579 sub git_get_last_activity {
3580         my ($path, $quick) = @_;
3581         my $fd;
3582
3583         $git_dir = "$projectroot/$path";
3584         if ($lastactivity_file && open($fd, "<", "$git_dir/$lastactivity_file")) {
3585                 my $activity = <$fd>;
3586                 close $fd;
3587                 return (undef) unless defined $activity;
3588                 chomp $activity;
3589                 return (undef) if $activity eq '';
3590                 if (my $timestamp = parse_activity_date($activity)) {
3591                         return ($timestamp);
3592                 }
3593         }
3594         return (undef) if $quick;
3595         defined($fd = git_cmd_pipe 'for-each-ref',
3596              '--format=%(committer)',
3597              '--sort=-committerdate',
3598              '--count=1',
3599              map { "refs/$_" } get_branch_refs ()) or return;
3600         my $most_recent = <$fd>;
3601         close $fd or return (undef);
3602         if (defined $most_recent &&
3603             $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
3604                 my $timestamp = $1;
3605                 return ($timestamp);
3606         }
3607         return (undef);
3608 }
3609
3610 # Implementation note: when a single remote is wanted, we cannot use 'git
3611 # remote show -n' because that command always work (assuming it's a remote URL
3612 # if it's not defined), and we cannot use 'git remote show' because that would
3613 # try to make a network roundtrip. So the only way to find if that particular
3614 # remote is defined is to walk the list provided by 'git remote -v' and stop if
3615 # and when we find what we want.
3616 sub git_get_remotes_list {
3617         my $wanted = shift;
3618         my %remotes = ();
3619
3620         my $fd = git_cmd_pipe 'remote', '-v';
3621         return unless $fd;
3622         while (my $remote = to_utf8(scalar <$fd>)) {
3623                 chomp $remote;
3624                 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
3625                 next if $wanted and not $remote eq $wanted;
3626                 my ($url, $key) = ($1, $2);
3627
3628                 $remotes{$remote} ||= { 'heads' => () };
3629                 $remotes{$remote}{$key} = $url;
3630         }
3631         close $fd or return;
3632         return wantarray ? %remotes : \%remotes;
3633 }
3634
3635 # Takes a hash of remotes as first parameter and fills it by adding the
3636 # available remote heads for each of the indicated remotes.
3637 sub fill_remote_heads {
3638         my $remotes = shift;
3639         my @heads = map { "remotes/$_" } keys %$remotes;
3640         my @remoteheads = git_get_heads_list(undef, @heads);
3641         foreach my $remote (keys %$remotes) {
3642                 $remotes->{$remote}{'heads'} = [ grep {
3643                         $_->{'name'} =~ s!^$remote/!!
3644                         } @remoteheads ];
3645         }
3646 }
3647
3648 sub git_get_references {
3649         my $type = shift || "";
3650         my %refs;
3651         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
3652         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
3653         defined(my $fd = git_cmd_pipe "show-ref", "--dereference",
3654                 ($type ? ("--", "refs/$type") : ())) # use -- <pattern> if $type
3655                 or return;
3656
3657         while (my $line = to_utf8(scalar <$fd>)) {
3658                 chomp $line;
3659                 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
3660                         if (defined $refs{$1}) {
3661                                 push @{$refs{$1}}, $2;
3662                         } else {
3663                                 $refs{$1} = [ $2 ];
3664                         }
3665                 }
3666         }
3667         close $fd or return;
3668         return \%refs;
3669 }
3670
3671 sub git_get_rev_name_tags {
3672         my $hash = shift || return undef;
3673
3674         defined(my $fd = git_cmd_pipe "name-rev", "--tags", $hash)
3675                 or return;
3676         my $name_rev = to_utf8(scalar <$fd>);
3677         close $fd;
3678
3679         if ($name_rev =~ m|^$hash tags/(.*)$|) {
3680                 return $1;
3681         } else {
3682                 # catches also '$hash undefined' output
3683                 return undef;
3684         }
3685 }
3686
3687 ## ----------------------------------------------------------------------
3688 ## parse to hash functions
3689
3690 sub parse_date {
3691         my $epoch = shift;
3692         my $tz = shift || "-0000";
3693
3694         my %date;
3695         my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
3696         my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
3697         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
3698         $date{'hour'} = $hour;
3699         $date{'minute'} = $min;
3700         $date{'mday'} = $mday;
3701         $date{'day'} = $days[$wday];
3702         $date{'month'} = $months[$mon];
3703         $date{'rfc2822'}   = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
3704                              $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
3705         $date{'mday-time'} = sprintf "%d %s %02d:%02d",
3706                              $mday, $months[$mon], $hour ,$min;
3707         $date{'iso-8601'}  = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
3708                              1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
3709
3710         my ($tz_sign, $tz_hour, $tz_min) =
3711                 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
3712         $tz_sign = ($tz_sign eq '-' ? -1 : +1);
3713         my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
3714         ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
3715         $date{'hour_local'} = $hour;
3716         $date{'minute_local'} = $min;
3717         $date{'tz_local'} = $tz;
3718         $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
3719                                   1900+$year, $mon+1, $mday,
3720                                   $hour, $min, $sec, $tz);
3721         return %date;
3722 }
3723
3724 sub parse_tag {
3725         my $tag_id = shift;
3726         my %tag;
3727         my @comment;
3728
3729         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
3730         $tag{'id'} = $tag_id;
3731         while (my $line = to_utf8(scalar <$fd>)) {
3732                 chomp $line;
3733                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
3734                         $tag{'object'} = $1;
3735                 } elsif ($line =~ m/^type (.+)$/) {
3736                         $tag{'type'} = $1;
3737                 } elsif ($line =~ m/^tag (.+)$/) {
3738                         $tag{'name'} = $1;
3739                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
3740                         $tag{'author'} = $1;
3741                         $tag{'author_epoch'} = $2;
3742                         $tag{'author_tz'} = $3;
3743                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3744                                 $tag{'author_name'}  = $1;
3745                                 $tag{'author_email'} = $2;
3746                         } else {
3747                                 $tag{'author_name'} = $tag{'author'};
3748                         }
3749                 } elsif ($line =~ m/--BEGIN/) {
3750                         push @comment, $line;
3751                         last;
3752                 } elsif ($line eq "") {
3753                         last;
3754                 }
3755         }
3756         push @comment, map(to_utf8($_), <$fd>);
3757         $tag{'comment'} = \@comment;
3758         close $fd or return;
3759         if (!defined $tag{'name'}) {
3760                 return
3761         };
3762         return %tag
3763 }
3764
3765 sub parse_commit_text {
3766         my ($commit_text, $withparents) = @_;
3767         my @commit_lines = split '\n', $commit_text;
3768         my %co;
3769
3770         pop @commit_lines; # Remove '\0'
3771
3772         if (! @commit_lines) {
3773                 return;
3774         }
3775
3776         my $header = shift @commit_lines;
3777         if ($header !~ m/^[0-9a-fA-F]{40}/) {
3778                 return;
3779         }
3780         ($co{'id'}, my @parents) = split ' ', $header;
3781         while (my $line = shift @commit_lines) {
3782                 last if $line eq "\n";
3783                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
3784                         $co{'tree'} = $1;
3785                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
3786                         push @parents, $1;
3787                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
3788                         $co{'author'} = to_utf8($1);
3789                         $co{'author_epoch'} = $2;
3790                         $co{'author_tz'} = $3;
3791                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3792                                 $co{'author_name'}  = $1;
3793                                 $co{'author_email'} = $2;
3794                         } else {
3795                                 $co{'author_name'} = $co{'author'};
3796                         }
3797                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
3798                         $co{'committer'} = to_utf8($1);
3799                         $co{'committer_epoch'} = $2;
3800                         $co{'committer_tz'} = $3;
3801                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
3802                                 $co{'committer_name'}  = $1;
3803                                 $co{'committer_email'} = $2;
3804                         } else {
3805                                 $co{'committer_name'} = $co{'committer'};
3806                         }
3807                 }
3808         }
3809         if (!defined $co{'tree'}) {
3810                 return;
3811         };
3812         $co{'parents'} = \@parents;
3813         $co{'parent'} = $parents[0];
3814
3815         @commit_lines = map to_utf8($_), @commit_lines;
3816         foreach my $title (@commit_lines) {
3817                 $title =~ s/^    //;
3818                 if ($title ne "") {
3819                         $co{'title'} = chop_str($title, 80, 5);
3820                         # remove leading stuff of merges to make the interesting part visible
3821                         if (length($title) > 50) {
3822                                 $title =~ s/^Automatic //;
3823                                 $title =~ s/^merge (of|with) /Merge ... /i;
3824                                 if (length($title) > 50) {
3825                                         $title =~ s/(http|rsync):\/\///;
3826                                 }
3827                                 if (length($title) > 50) {
3828                                         $title =~ s/(master|www|rsync)\.//;
3829                                 }
3830                                 if (length($title) > 50) {
3831                                         $title =~ s/kernel.org:?//;
3832                                 }
3833                                 if (length($title) > 50) {
3834                                         $title =~ s/\/pub\/scm//;
3835                                 }
3836                         }
3837                         $co{'title_short'} = chop_str($title, 50, 5);
3838                         last;
3839                 }
3840         }
3841         if (! defined $co{'title'} || $co{'title'} eq "") {
3842                 $co{'title'} = $co{'title_short'} = '(no commit message)';
3843         }
3844         # remove added spaces
3845         foreach my $line (@commit_lines) {
3846                 $line =~ s/^    //;
3847         }
3848         $co{'comment'} = \@commit_lines;
3849
3850         my $age_epoch = $co{'committer_epoch'};
3851         $co{'age_epoch'} = $age_epoch;
3852         my $time_now = time;
3853         $co{'age_string'} = age_string($age_epoch, $time_now);
3854         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
3855         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
3856         return %co;
3857 }
3858
3859 sub parse_commit {
3860         my ($commit_id) = @_;
3861         my %co;
3862
3863         local $/ = "\0";
3864
3865         defined(my $fd = git_cmd_pipe "rev-list",
3866                 "--parents",
3867                 "--header",
3868                 "--max-count=1",
3869                 $commit_id,
3870                 "--")
3871                 or die_error(500, "Open git-rev-list failed");
3872         %co = parse_commit_text(<$fd>, 1);
3873         close $fd;
3874
3875         return %co;
3876 }
3877
3878 sub parse_commits {
3879         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
3880         my @cos;
3881
3882         $maxcount ||= 1;
3883         $skip ||= 0;
3884
3885         local $/ = "\0";
3886
3887         defined(my $fd = git_cmd_pipe "rev-list",
3888                 "--header",
3889                 @args,
3890                 ("--max-count=" . $maxcount),
3891                 ("--skip=" . $skip),
3892                 @extra_options,
3893                 $commit_id,
3894                 "--",
3895                 ($filename ? ($filename) : ()))
3896                 or die_error(500, "Open git-rev-list failed");
3897         while (my $line = <$fd>) {
3898                 my %co = parse_commit_text($line);
3899                 push @cos, \%co;
3900         }
3901         close $fd;
3902
3903         return wantarray ? @cos : \@cos;
3904 }
3905
3906 # parse line of git-diff-tree "raw" output
3907 sub parse_difftree_raw_line {
3908         my $line = shift;
3909         my %res;
3910
3911         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
3912         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
3913         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
3914                 $res{'from_mode'} = $1;
3915                 $res{'to_mode'} = $2;
3916                 $res{'from_id'} = $3;
3917                 $res{'to_id'} = $4;
3918                 $res{'status'} = $5;
3919                 $res{'similarity'} = $6;
3920                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
3921                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
3922                 } else {
3923                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
3924                 }
3925         }
3926         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
3927         # combined diff (for merge commit)
3928         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
3929                 $res{'nparents'}  = length($1);
3930                 $res{'from_mode'} = [ split(' ', $2) ];
3931                 $res{'to_mode'} = pop @{$res{'from_mode'}};
3932                 $res{'from_id'} = [ split(' ', $3) ];
3933                 $res{'to_id'} = pop @{$res{'from_id'}};
3934                 $res{'status'} = [ split('', $4) ];
3935                 $res{'to_file'} = unquote($5);
3936         }
3937         # 'c512b523472485aef4fff9e57b229d9d243c967f'
3938         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
3939                 $res{'commit'} = $1;
3940         }
3941
3942         return wantarray ? %res : \%res;
3943 }
3944
3945 # wrapper: return parsed line of git-diff-tree "raw" output
3946 # (the argument might be raw line, or parsed info)
3947 sub parsed_difftree_line {
3948         my $line_or_ref = shift;
3949
3950         if (ref($line_or_ref) eq "HASH") {
3951                 # pre-parsed (or generated by hand)
3952                 return $line_or_ref;
3953         } else {
3954                 return parse_difftree_raw_line($line_or_ref);
3955         }
3956 }
3957
3958 # parse line of git-ls-tree output
3959 sub parse_ls_tree_line {
3960         my $line = shift;
3961         my %opts = @_;
3962         my %res;
3963
3964         if ($opts{'-l'}) {
3965                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
3966                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
3967
3968                 $res{'mode'} = $1;
3969                 $res{'type'} = $2;
3970                 $res{'hash'} = $3;
3971                 $res{'size'} = $4;
3972                 if ($opts{'-z'}) {
3973                         $res{'name'} = $5;
3974                 } else {
3975                         $res{'name'} = unquote($5);
3976                 }
3977         } else {
3978                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3979                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
3980
3981                 $res{'mode'} = $1;
3982                 $res{'type'} = $2;
3983                 $res{'hash'} = $3;
3984                 if ($opts{'-z'}) {
3985                         $res{'name'} = $4;
3986                 } else {
3987                         $res{'name'} = unquote($4);
3988                 }
3989         }
3990
3991         return wantarray ? %res : \%res;
3992 }
3993
3994 # generates _two_ hashes, references to which are passed as 2 and 3 argument
3995 sub parse_from_to_diffinfo {
3996         my ($diffinfo, $from, $to, @parents) = @_;
3997
3998         if ($diffinfo->{'nparents'}) {
3999                 # combined diff
4000                 $from->{'file'} = [];
4001                 $from->{'href'} = [];
4002                 fill_from_file_info($diffinfo, @parents)
4003                         unless exists $diffinfo->{'from_file'};
4004                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4005                         $from->{'file'}[$i] =
4006                                 defined $diffinfo->{'from_file'}[$i] ?
4007                                         $diffinfo->{'from_file'}[$i] :
4008                                         $diffinfo->{'to_file'};
4009                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4010                                 $from->{'href'}[$i] = href(action=>"blob",
4011                                                            hash_base=>$parents[$i],
4012                                                            hash=>$diffinfo->{'from_id'}[$i],
4013                                                            file_name=>$from->{'file'}[$i]);
4014                         } else {
4015                                 $from->{'href'}[$i] = undef;
4016                         }
4017                 }
4018         } else {
4019                 # ordinary (not combined) diff
4020                 $from->{'file'} = $diffinfo->{'from_file'};
4021                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4022                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4023                                                hash=>$diffinfo->{'from_id'},
4024                                                file_name=>$from->{'file'});
4025                 } else {
4026                         delete $from->{'href'};
4027                 }
4028         }
4029
4030         $to->{'file'} = $diffinfo->{'to_file'};
4031         if (!is_deleted($diffinfo)) { # file exists in result
4032                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4033                                      hash=>$diffinfo->{'to_id'},
4034                                      file_name=>$to->{'file'});
4035         } else {
4036                 delete $to->{'href'};
4037         }
4038 }
4039
4040 ## ......................................................................
4041 ## parse to array of hashes functions
4042
4043 sub git_get_heads_list {
4044         my ($limit, @classes) = @_;
4045         @classes = get_branch_refs() unless @classes;
4046         my @patterns = map { "refs/$_" } @classes;
4047         my @headslist;
4048
4049         defined(my $fd = git_cmd_pipe 'for-each-ref',
4050                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4051                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4052                 @patterns)
4053                 or return;
4054         while (my $line = to_utf8(scalar <$fd>)) {
4055                 my %ref_item;
4056
4057                 chomp $line;
4058                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4059                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4060                 my ($committer, $epoch, $tz) =
4061                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4062                 $ref_item{'fullname'}  = $name;
4063                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4064                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4065                 $ref_item{'name'} = $name;
4066                 # for refs neither in 'heads' nor 'remotes' we want to
4067                 # show their ref dir
4068                 my $ref_dir = (defined $1) ? $1 : '';
4069                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4070                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4071                 }
4072
4073                 $ref_item{'id'}    = $hash;
4074                 $ref_item{'title'} = $title || '(no commit message)';
4075                 $ref_item{'epoch'} = $epoch;
4076                 if ($epoch) {
4077                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4078                 } else {
4079                         $ref_item{'age'} = "unknown";
4080                 }
4081
4082                 push @headslist, \%ref_item;
4083         }
4084         close $fd;
4085
4086         return wantarray ? @headslist : \@headslist;
4087 }
4088
4089 sub git_get_tags_list {
4090         my $limit = shift;
4091         my @tagslist;
4092
4093         defined(my $fd = git_cmd_pipe 'for-each-ref',
4094                 ($limit ? '--count='.($limit+1) : ()), '--sort=-creatordate',
4095                 '--format=%(objectname) %(objecttype) %(refname) '.
4096                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4097                 'refs/tags')
4098                 or return;
4099         while (my $line = to_utf8(scalar <$fd>)) {
4100                 my %ref_item;
4101
4102                 chomp $line;
4103                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4104                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4105                 my ($creator, $epoch, $tz) =
4106                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4107                 $ref_item{'fullname'} = $name;
4108                 $name =~ s!^refs/tags/!!;
4109
4110                 $ref_item{'type'} = $type;
4111                 $ref_item{'id'} = $id;
4112                 $ref_item{'name'} = $name;
4113                 if ($type eq "tag") {
4114                         $ref_item{'subject'} = $title;
4115                         $ref_item{'reftype'} = $reftype;
4116                         $ref_item{'refid'}   = $refid;
4117                 } else {
4118                         $ref_item{'reftype'} = $type;
4119                         $ref_item{'refid'}   = $id;
4120                 }
4121
4122                 if ($type eq "tag" || $type eq "commit") {
4123                         $ref_item{'epoch'} = $epoch;
4124                         if ($epoch) {
4125                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4126                         } else {
4127                                 $ref_item{'age'} = "unknown";
4128                         }
4129                 }
4130
4131                 push @tagslist, \%ref_item;
4132         }
4133         close $fd;
4134
4135         return wantarray ? @tagslist : \@tagslist;
4136 }
4137
4138 ## ----------------------------------------------------------------------
4139 ## filesystem-related functions
4140
4141 sub get_file_owner {
4142         my $path = shift;
4143
4144         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4145         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4146         if (!defined $gcos) {
4147                 return undef;
4148         }
4149         my $owner = $gcos;
4150         $owner =~ s/[,;].*$//;
4151         return to_utf8($owner);
4152 }
4153
4154 # assume that file exists
4155 sub insert_file {
4156         my $filename = shift;
4157
4158         open my $fd, '<', $filename;
4159         while (<$fd>) {
4160                 print to_utf8($_);
4161         }
4162         close $fd;
4163 }
4164
4165 ## ......................................................................
4166 ## mimetype related functions
4167
4168 sub mimetype_guess_file {
4169         my $filename = shift;
4170         my $mimemap = shift;
4171         -r $mimemap or return undef;
4172
4173         my %mimemap;
4174         open(my $mh, '<', $mimemap) or return undef;
4175         while (<$mh>) {
4176                 next if m/^#/; # skip comments
4177                 my ($mimetype, @exts) = split(/\s+/);
4178                 foreach my $ext (@exts) {
4179                         $mimemap{$ext} = $mimetype;
4180                 }
4181         }
4182         close($mh);
4183
4184         $filename =~ /\.([^.]*)$/;
4185         return $mimemap{$1};
4186 }
4187
4188 sub mimetype_guess {
4189         my $filename = shift;
4190         my $mime;
4191         $filename =~ /\./ or return undef;
4192
4193         if ($mimetypes_file) {
4194                 my $file = $mimetypes_file;
4195                 if ($file !~ m!^/!) { # if it is relative path
4196                         # it is relative to project
4197                         $file = "$projectroot/$project/$file";
4198                 }
4199                 $mime = mimetype_guess_file($filename, $file);
4200         }
4201         $mime ||= mimetype_guess_file($filename, '/etc/mime.types');
4202         return $mime;
4203 }
4204
4205 sub blob_mimetype {
4206         my $fd = shift;
4207         my $filename = shift;
4208
4209         if ($filename) {
4210                 my $mime = mimetype_guess($filename);
4211                 $mime and return $mime;
4212         }
4213
4214         # just in case
4215         return $default_blob_plain_mimetype unless $fd;
4216
4217         if (-T $fd) {
4218                 return 'text/plain';
4219         } elsif (! $filename) {
4220                 return 'application/octet-stream';
4221         } elsif ($filename =~ m/\.png$/i) {
4222                 return 'image/png';
4223         } elsif ($filename =~ m/\.gif$/i) {
4224                 return 'image/gif';
4225         } elsif ($filename =~ m/\.jpe?g$/i) {
4226                 return 'image/jpeg';
4227         } else {
4228                 return 'application/octet-stream';
4229         }
4230 }
4231
4232 sub blob_contenttype {
4233         my ($fd, $file_name, $type) = @_;
4234
4235         $type ||= blob_mimetype($fd, $file_name);
4236         if ($type eq 'text/plain' && defined $default_text_plain_charset) {
4237                 $type .= "; charset=$default_text_plain_charset";
4238         }
4239
4240         return $type;
4241 }
4242
4243 # peek the first upto 128 bytes off a file handle
4244 sub peek128bytes {
4245         my $fd = shift;
4246
4247         use IO::Handle;
4248         use bytes;
4249
4250         my $prefix128;
4251         return '' unless $fd && read($fd, $prefix128, 128);
4252
4253         # In the general case, we're guaranteed only to be able to ungetc one
4254         # character (provided, of course, we actually got a character first).
4255         #
4256         # However, we know:
4257         #
4258         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4259         #    already been called at least once on the file handle before us
4260         #
4261         # 2) we have an $fd positioned at the start of the input stream and
4262         #    therefore know we were positioned at a buffer boundary before
4263         #    reading the initial upto 128 bytes
4264         #
4265         # 3) the buffer size is at least 512 bytes
4266         #
4267         # 4) we are careful to only unget raw bytes
4268         #
4269         # 5) we are attempting to unget exactly the same number of bytes we got
4270         #
4271         # Given the above conditions we will ALWAYS be able to safely unget
4272         # the $prefix128 value we just got.
4273         #
4274         # In fact, we could read up to 511 bytes and still be sure.
4275         # (Reading 512 might pop us into the next internal buffer, but probably
4276         # not since that could break the always able to unget at least the one
4277         # you just got guarantee.)
4278
4279         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4280
4281         return $prefix128;
4282 }
4283
4284 # guess file syntax for syntax highlighting; return undef if no highlighting
4285 # the name of syntax can (in the future) depend on syntax highlighter used
4286 sub guess_file_syntax {
4287         my ($fd, $mimetype, $file_name) = @_;
4288         return undef unless $fd && defined $file_name &&
4289                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4290         my $basename = basename($file_name, '.in');
4291         return $highlight_basename{$basename}
4292                 if exists $highlight_basename{$basename};
4293
4294         # Peek to see if there's a shebang or xml line.
4295         # We always operate on bytes when testing this.
4296         {
4297                 use bytes;
4298                 my $shebang = peek128bytes($fd);
4299                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4300                         foreach my $key (keys %highlight_shebang) {
4301                                 my $ar = ref($highlight_shebang{$key}) ?
4302                                         $highlight_shebang{$key} :
4303                                         [$highlight_shebang{key}];
4304                                 map {return $key if $shebang =~ /$_/} @$ar;
4305                         }
4306                 }
4307                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4308         }
4309
4310         $basename =~ /\.([^.]*)$/;
4311         my $ext = $1 or return undef;
4312         return $highlight_ext{$ext}
4313                 if exists $highlight_ext{$ext};
4314
4315         return undef;
4316 }
4317
4318 # run highlighter and return FD of its output,
4319 # or return original FD if no highlighting
4320 sub run_highlighter {
4321         my ($fd, $syntax) = @_;
4322         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4323
4324         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4325                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4326                 quote_command($highlight_bin).
4327                 " --replace-tabs=8 --fragment --syntax $syntax")
4328                 or die_error(500, "Couldn't open file or run syntax highlighter");
4329         if (eof $hifd) {
4330                 # just in case, should not happen as we tested !eof($fd) above
4331                 return $fd if close($hifd);
4332
4333                 # should not happen
4334                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4335
4336                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4337                 # instead of dying horribly on this, just skip the highlighting
4338                 # but do output a message about it to STDERR that will end up in the log
4339                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4340                         sprintf("child exit status 0x%x\n", $?);
4341                 return $fd
4342         }
4343         close $fd;
4344         return ($hifd, 1);
4345 }
4346
4347 ## ======================================================================
4348 ## functions printing HTML: header, footer, error page
4349
4350 sub get_page_title {
4351         my $title = to_utf8($site_name);
4352
4353         unless (defined $project) {
4354                 if (defined $project_filter) {
4355                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4356                 }
4357                 return $title;
4358         }
4359         $title .= " - " . to_utf8($project);
4360
4361         return $title unless (defined $action);
4362         $title .= "/$action"; # $action is US-ASCII (7bit ASCII)
4363
4364         return $title unless (defined $file_name);
4365         $title .= " - " . esc_path($file_name);
4366         if ($action eq "tree" && $file_name !~ m|/$|) {
4367                 $title .= "/";
4368         }
4369
4370         return $title;
4371 }
4372
4373 sub get_content_type_html {
4374         # require explicit support from the UA if we are to send the page as
4375         # 'application/xhtml+xml', otherwise send it as plain old 'text/html'.
4376         # we have to do this because MSIE sometimes globs '*/*', pretending to
4377         # support xhtml+xml but choking when it gets what it asked for.
4378         if (defined $cgi->http('HTTP_ACCEPT') &&
4379             $cgi->http('HTTP_ACCEPT') =~ m/(,|;|\s|^)application\/xhtml\+xml(,|;|\s|$)/ &&
4380             $cgi->Accept('application/xhtml+xml') != 0) {
4381                 return 'application/xhtml+xml';
4382         } else {
4383                 return 'text/html';
4384         }
4385 }
4386
4387 sub print_feed_meta {
4388         if (defined $project) {
4389                 my %href_params = get_feed_info();
4390                 if (!exists $href_params{'-title'}) {
4391                         $href_params{'-title'} = 'log';
4392                 }
4393
4394                 foreach my $format (qw(RSS Atom)) {
4395                         my $type = lc($format);
4396                         my %link_attr = (
4397                                 '-rel' => 'alternate',
4398                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4399                                 '-type' => "application/$type+xml"
4400                         );
4401
4402                         $href_params{'extra_options'} = undef;
4403                         $href_params{'action'} = $type;
4404                         $link_attr{'-href'} = href(%href_params);
4405                         print "<link ".
4406                               "rel=\"$link_attr{'-rel'}\" ".
4407                               "title=\"$link_attr{'-title'}\" ".
4408                               "href=\"$link_attr{'-href'}\" ".
4409                               "type=\"$link_attr{'-type'}\" ".
4410                               "/>\n";
4411
4412                         $href_params{'extra_options'} = '--no-merges';
4413                         $link_attr{'-href'} = href(%href_params);
4414                         $link_attr{'-title'} .= ' (no merges)';
4415                         print "<link ".
4416                               "rel=\"$link_attr{'-rel'}\" ".
4417                               "title=\"$link_attr{'-title'}\" ".
4418                               "href=\"$link_attr{'-href'}\" ".
4419                               "type=\"$link_attr{'-type'}\" ".
4420                               "/>\n";
4421                 }
4422
4423         } else {
4424                 printf('<link rel="alternate" title="%s projects list" '.
4425                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4426                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4427                 printf('<link rel="alternate" title="%s projects feeds" '.
4428                        'href="%s" type="text/x-opml" />'."\n",
4429                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4430         }
4431 }
4432
4433 sub print_header_links {
4434         my $status = shift;
4435
4436         # print out each stylesheet that exist, providing backwards capability
4437         # for those people who defined $stylesheet in a config file
4438         if (defined $stylesheet) {
4439                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4440         } else {
4441                 foreach my $stylesheet (@stylesheets) {
4442                         next unless $stylesheet;
4443                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4444                 }
4445         }
4446         print_feed_meta()
4447                 if ($status eq '200 OK');
4448         if (defined $favicon) {
4449                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4450         }
4451 }
4452
4453 sub print_nav_breadcrumbs_path {
4454         my $dirprefix = undef;
4455         while (my $part = shift) {
4456                 $dirprefix .= "/" if defined $dirprefix;
4457                 $dirprefix .= $part;
4458                 print $cgi->a({-href => href(project => undef,
4459                                              project_filter => $dirprefix,
4460                                              action => "project_list")},
4461                               esc_html($part)) . " / ";
4462         }
4463 }
4464
4465 sub print_nav_breadcrumbs {
4466         my %opts = @_;
4467
4468         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4469                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4470         }
4471         if (defined $project) {
4472                 my @dirname = split '/', $project;
4473                 my $projectbasename = pop @dirname;
4474                 print_nav_breadcrumbs_path(@dirname);
4475                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4476                 if (defined $action) {
4477                         my $action_print = $action ;
4478                         if (defined $opts{-action_extra}) {
4479                                 $action_print = $cgi->a({-href => href(action=>$action)},
4480                                         $action);
4481                         }
4482                         print " / $action_print";
4483                 }
4484                 if (defined $opts{-action_extra}) {
4485                         print " / $opts{-action_extra}";
4486                 }
4487                 print "\n";
4488         } elsif (defined $project_filter) {
4489                 print_nav_breadcrumbs_path(split '/', $project_filter);
4490         }
4491 }
4492
4493 sub print_search_form {
4494         if (!defined $searchtext) {
4495                 $searchtext = "";
4496         }
4497         my $search_hash;
4498         if (defined $hash_base) {
4499                 $search_hash = $hash_base;
4500         } elsif (defined $hash) {
4501                 $search_hash = $hash;
4502         } else {
4503                 $search_hash = "HEAD";
4504         }
4505         my $action = $my_uri;
4506         my $use_pathinfo = gitweb_check_feature('pathinfo');
4507         if ($use_pathinfo) {
4508                 $action .= "/".esc_url($project);
4509         }
4510         print $cgi->start_form(-method => "get", -action => $action) .
4511               "<div class=\"search\">\n" .
4512               (!$use_pathinfo &&
4513               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
4514               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
4515               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
4516               $cgi->popup_menu(-name => 'st', -default => 'commit',
4517                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
4518               " " . $cgi->a({-href => href(action=>"search_help"),
4519                              -title => "search help" }, "?") . " search:\n",
4520               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
4521               "<span title=\"Extended regular expression\">" .
4522               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
4523                              -checked => $search_use_regexp) .
4524               "</span>" .
4525               "</div>" .
4526               $cgi->end_form() . "\n";
4527 }
4528
4529 sub git_header_html {
4530         my $status = shift || "200 OK";
4531         my $expires = shift;
4532         my %opts = @_;
4533
4534         my $title = get_page_title();
4535         my $content_type = get_content_type_html();
4536         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
4537                            -status=> $status, -expires => $expires)
4538                 unless ($opts{'-no_http_header'});
4539         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
4540         print <<EOF;
4541 <?xml version="1.0" encoding="utf-8"?>
4542 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
4543 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
4544 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
4545 <!-- git core binaries version $git_version -->
4546 <head>
4547 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
4548 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
4549 <meta name="robots" content="index, nofollow"/>
4550 <title>$title</title>
4551 EOF
4552         # the stylesheet, favicon etc urls won't work correctly with path_info
4553         # unless we set the appropriate base URL
4554         if ($ENV{'PATH_INFO'}) {
4555                 print "<base href=\"".esc_url($base_url)."\" />\n";
4556         }
4557         print_header_links($status);
4558
4559         if (defined $site_html_head_string) {
4560                 print to_utf8($site_html_head_string);
4561         }
4562
4563         print "</head>\n" .
4564               "<body>\n";
4565
4566         if (defined $site_header && -f $site_header) {
4567                 insert_file($site_header);
4568         }
4569
4570         print "<div class=\"page_header\">\n";
4571         if (defined $logo) {
4572                 print $cgi->a({-href => esc_url($logo_url),
4573                                -title => $logo_label},
4574                               $cgi->img({-src => esc_url($logo),
4575                                          -width => 72, -height => 27,
4576                                          -alt => "git",
4577                                          -class => "logo"}));
4578         }
4579         print_nav_breadcrumbs(%opts);
4580         print "</div>\n";
4581
4582         my $have_search = gitweb_check_feature('search');
4583         if (defined $project && $have_search) {
4584                 print_search_form();
4585         }
4586 }
4587
4588 sub git_footer_html {
4589         my $feed_class = 'rss_logo';
4590
4591         print "<div class=\"page_footer\">\n";
4592         if (defined $project) {
4593                 my $descr = git_get_project_description($project);
4594                 if (defined $descr) {
4595                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
4596                 }
4597
4598                 my %href_params = get_feed_info();
4599                 if (!%href_params) {
4600                         $feed_class .= ' generic';
4601                 }
4602                 $href_params{'-title'} ||= 'log';
4603
4604                 foreach my $format (qw(RSS Atom)) {
4605                         $href_params{'action'} = lc($format);
4606                         print $cgi->a({-href => href(%href_params),
4607                                       -title => "$href_params{'-title'} $format feed",
4608                                       -class => $feed_class}, $format)."\n";
4609                 }
4610
4611         } else {
4612                 print $cgi->a({-href => href(project=>undef, action=>"opml",
4613                                              project_filter => $project_filter),
4614                               -class => $feed_class}, "OPML") . " ";
4615                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
4616                                              project_filter => $project_filter),
4617                               -class => $feed_class}, "TXT") . "\n";
4618         }
4619         print "</div>\n"; # class="page_footer"
4620
4621         if (defined $t0 && gitweb_check_feature('timed')) {
4622                 print "<div id=\"generating_info\">\n";
4623                 print 'This page took '.
4624                       '<span id="generating_time" class="time_span">'.
4625                       tv_interval($t0, [ gettimeofday() ]).
4626                       ' seconds </span>'.
4627                       ' and '.
4628                       '<span id="generating_cmd">'.
4629                       $number_of_git_cmds.
4630                       '</span> git commands '.
4631                       " to generate.\n";
4632                 print "</div>\n"; # class="page_footer"
4633         }
4634
4635         if (defined $site_footer && -f $site_footer) {
4636                 insert_file($site_footer);
4637         }
4638
4639         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
4640         if (defined $action &&
4641             $action eq 'blame_incremental') {
4642                 print qq!<script type="text/javascript">\n!.
4643                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
4644                       qq!           "!. href() .qq!");\n!.
4645                       qq!</script>\n!;
4646         } else {
4647                 my ($jstimezone, $tz_cookie, $datetime_class) =
4648                         gitweb_get_feature('javascript-timezone');
4649
4650                 print qq!<script type="text/javascript">\n!.
4651                       qq!window.onload = function () {\n!;
4652                 if (gitweb_check_feature('javascript-actions')) {
4653                         print qq!       fixLinks();\n!;
4654                 }
4655                 if ($jstimezone && $tz_cookie && $datetime_class) {
4656                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
4657                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
4658                 }
4659                 print qq!};\n!.
4660                       qq!</script>\n!;
4661         }
4662
4663         print "</body>\n" .
4664               "</html>";
4665 }
4666
4667 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
4668 # Example: die_error(404, 'Hash not found')
4669 # By convention, use the following status codes (as defined in RFC 2616):
4670 # 400: Invalid or missing CGI parameters, or
4671 #      requested object exists but has wrong type.
4672 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
4673 #      this server or project.
4674 # 404: Requested object/revision/project doesn't exist.
4675 # 500: The server isn't configured properly, or
4676 #      an internal error occurred (e.g. failed assertions caused by bugs), or
4677 #      an unknown error occurred (e.g. the git binary died unexpectedly).
4678 # 503: The server is currently unavailable (because it is overloaded,
4679 #      or down for maintenance).  Generally, this is a temporary state.
4680 sub die_error {
4681         my $status = shift || 500;
4682         my $error = esc_html(shift) || "Internal Server Error";
4683         my $extra = shift;
4684         my %opts = @_;
4685
4686         my %http_responses = (
4687                 400 => '400 Bad Request',
4688                 403 => '403 Forbidden',
4689                 404 => '404 Not Found',
4690                 500 => '500 Internal Server Error',
4691                 503 => '503 Service Unavailable',
4692         );
4693         git_header_html($http_responses{$status}, undef, %opts);
4694         print <<EOF;
4695 <div class="page_body">
4696 <br /><br />
4697 $status - $error
4698 <br />
4699 EOF
4700         if (defined $extra) {
4701                 print "<hr />\n" .
4702                       "$extra\n";
4703         }
4704         print "</div>\n";
4705
4706         git_footer_html();
4707         goto DONE_GITWEB
4708                 unless ($opts{'-error_handler'});
4709 }
4710
4711 ## ----------------------------------------------------------------------
4712 ## functions printing or outputting HTML: navigation
4713
4714 sub git_print_page_nav {
4715         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
4716         $extra = '' if !defined $extra; # pager or formats
4717
4718         my @navs = qw(summary shortlog log commit commitdiff tree);
4719         if ($suppress) {
4720                 @navs = grep { $_ ne $suppress } @navs;
4721         }
4722
4723         my %arg = map { $_ => {action=>$_} } @navs;
4724         if (defined $head) {
4725                 for (qw(commit commitdiff)) {
4726                         $arg{$_}{'hash'} = $head;
4727                 }
4728                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
4729                         for (qw(shortlog log)) {
4730                                 $arg{$_}{'hash'} = $head;
4731                         }
4732                 }
4733         }
4734
4735         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
4736         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
4737
4738         my @actions = gitweb_get_feature('actions');
4739         my %repl = (
4740                 '%' => '%',
4741                 'n' => $project,         # project name
4742                 'f' => $git_dir,         # project path within filesystem
4743                 'h' => $treehead || '',  # current hash ('h' parameter)
4744                 'b' => $treebase || '',  # hash base ('hb' parameter)
4745         );
4746         while (@actions) {
4747                 my ($label, $link, $pos) = splice(@actions,0,3);
4748                 # insert
4749                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
4750                 # munch munch
4751                 $link =~ s/%([%nfhb])/$repl{$1}/g;
4752                 $arg{$label}{'_href'} = $link;
4753         }
4754
4755         print "<div class=\"page_nav\">\n" .
4756                 (join " | ",
4757                  map { $_ eq $current ?
4758                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
4759                  } @navs);
4760         print "<br/>\n$extra<br/>\n" .
4761               "</div>\n";
4762 }
4763
4764 # returns a submenu for the nagivation of the refs views (tags, heads,
4765 # remotes) with the current view disabled and the remotes view only
4766 # available if the feature is enabled
4767 sub format_ref_views {
4768         my ($current) = @_;
4769         my @ref_views = qw{tags heads};
4770         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
4771         return join " | ", map {
4772                 $_ eq $current ? $_ :
4773                 $cgi->a({-href => href(action=>$_)}, $_)
4774         } @ref_views
4775 }
4776
4777 sub format_paging_nav {
4778         my ($action, $page, $has_next_link) = @_;
4779         my $paging_nav;
4780
4781
4782         if ($page > 0) {
4783                 $paging_nav .=
4784                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
4785                         " &sdot; " .
4786                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
4787                                  -accesskey => "p", -title => "Alt-p"}, "prev");
4788         } else {
4789                 $paging_nav .= "first &sdot; prev";
4790         }
4791
4792         if ($has_next_link) {
4793                 $paging_nav .= " &sdot; " .
4794                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
4795                                  -accesskey => "n", -title => "Alt-n"}, "next");
4796         } else {
4797                 $paging_nav .= " &sdot; next";
4798         }
4799
4800         return $paging_nav;
4801 }
4802
4803 ## ......................................................................
4804 ## functions printing or outputting HTML: div
4805
4806 sub git_print_header_div {
4807         my ($action, $title, $hash, $hash_base) = @_;
4808         my %args = ();
4809
4810         $args{'action'} = $action;
4811         $args{'hash'} = $hash if $hash;
4812         $args{'hash_base'} = $hash_base if $hash_base;
4813
4814         print "<div class=\"header\">\n" .
4815               $cgi->a({-href => href(%args), -class => "title"},
4816               $title ? $title : $action) .
4817               "\n</div>\n";
4818 }
4819
4820 sub format_repo_url {
4821         my ($name, $url) = @_;
4822         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
4823 }
4824
4825 # Group output by placing it in a DIV element and adding a header.
4826 # Options for start_div() can be provided by passing a hash reference as the
4827 # first parameter to the function.
4828 # Options to git_print_header_div() can be provided by passing an array
4829 # reference. This must follow the options to start_div if they are present.
4830 # The content can be a scalar, which is output as-is, a scalar reference, which
4831 # is output after html escaping, an IO handle passed either as *handle or
4832 # *handle{IO}, or a function reference. In the latter case all following
4833 # parameters will be taken as argument to the content function call.
4834 sub git_print_section {
4835         my ($div_args, $header_args, $content);
4836         my $arg = shift;
4837         if (ref($arg) eq 'HASH') {
4838                 $div_args = $arg;
4839                 $arg = shift;
4840         }
4841         if (ref($arg) eq 'ARRAY') {
4842                 $header_args = $arg;
4843                 $arg = shift;
4844         }
4845         $content = $arg;
4846
4847         print $cgi->start_div($div_args);
4848         git_print_header_div(@$header_args);
4849
4850         if (ref($content) eq 'CODE') {
4851                 $content->(@_);
4852         } elsif (ref($content) eq 'SCALAR') {
4853                 print esc_html($$content);
4854         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
4855                 while (<$content>) {
4856                         print to_utf8($_);
4857                 }
4858         } elsif (!ref($content) && defined($content)) {
4859                 print $content;
4860         }
4861
4862         print $cgi->end_div;
4863 }
4864
4865 sub format_timestamp_html {
4866         my $date = shift;
4867         my $strtime = $date->{'rfc2822'};
4868
4869         my (undef, undef, $datetime_class) =
4870                 gitweb_get_feature('javascript-timezone');
4871         if ($datetime_class) {
4872                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
4873         }
4874
4875         my $localtime_format = '(%02d:%02d %s)';
4876         if ($date->{'hour_local'} < 6) {
4877                 $localtime_format = '(<span class="atnight">%02d:%02d</span> %s)';
4878         }
4879         $strtime .= ' ' .
4880                     sprintf($localtime_format,
4881                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
4882
4883         return $strtime;
4884 }
4885
4886 # Outputs the author name and date in long form
4887 sub git_print_authorship {
4888         my $co = shift;
4889         my %opts = @_;
4890         my $tag = $opts{-tag} || 'div';
4891         my $author = $co->{'author_name'};
4892
4893         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
4894         print "<$tag class=\"author_date\">" .
4895               format_search_author($author, "author", esc_html($author)) .
4896               " [".format_timestamp_html(\%ad)."]".
4897               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
4898               "</$tag>\n";
4899 }
4900
4901 # Outputs table rows containing the full author or committer information,
4902 # in the format expected for 'commit' view (& similar).
4903 # Parameters are a commit hash reference, followed by the list of people
4904 # to output information for. If the list is empty it defaults to both
4905 # author and committer.
4906 sub git_print_authorship_rows {
4907         my $co = shift;
4908         # too bad we can't use @people = @_ || ('author', 'committer')
4909         my @people = @_;
4910         @people = ('author', 'committer') unless @people;
4911         foreach my $who (@people) {
4912                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
4913                 print "<tr><td>$who</td><td>" .
4914                       format_search_author($co->{"${who}_name"}, $who,
4915                                            esc_html($co->{"${who}_name"})) . " " .
4916                       format_search_author($co->{"${who}_email"}, $who,
4917                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
4918                       "</td><td rowspan=\"2\">" .
4919                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
4920                       "</td></tr>\n" .
4921                       "<tr>" .
4922                       "<td></td><td>" .
4923                       format_timestamp_html(\%wd) .
4924                       "</td>" .
4925                       "</tr>\n";
4926         }
4927 }
4928
4929 sub git_print_page_path {
4930         my $name = shift;
4931         my $type = shift;
4932         my $hb = shift;
4933
4934
4935         print "<div class=\"page_path\">";
4936         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
4937                       -title => 'tree root'}, to_utf8("[$project]"));
4938         print " / ";
4939         if (defined $name) {
4940                 my @dirname = split '/', $name;
4941                 my $basename = pop @dirname;
4942                 my $fullname = '';
4943
4944                 foreach my $dir (@dirname) {
4945                         $fullname .= ($fullname ? '/' : '') . $dir;
4946                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
4947                                                      hash_base=>$hb),
4948                                       -title => $fullname}, esc_path($dir));
4949                         print " / ";
4950                 }
4951                 if (defined $type && $type eq 'blob') {
4952                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
4953                                                      hash_base=>$hb),
4954                                       -title => $name}, esc_path($basename));
4955                 } elsif (defined $type && $type eq 'tree') {
4956                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
4957                                                      hash_base=>$hb),
4958                                       -title => $name}, esc_path($basename));
4959                         print " / ";
4960                 } else {
4961                         print esc_path($basename);
4962                 }
4963         }
4964         print "<br/></div>\n";
4965 }
4966
4967 sub git_print_log {
4968         my $log = shift;
4969         my %opts = @_;
4970
4971         if ($opts{'-remove_title'}) {
4972                 # remove title, i.e. first line of log
4973                 shift @$log;
4974         }
4975         # remove leading empty lines
4976         while (defined $log->[0] && $log->[0] eq "") {
4977                 shift @$log;
4978         }
4979
4980         # print log
4981         my $skip_blank_line = 0;
4982         foreach my $line (@$log) {
4983                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
4984                         if (! $opts{'-remove_signoff'}) {
4985                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
4986                                 $skip_blank_line = 1;
4987                         }
4988                         next;
4989                 }
4990
4991                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
4992                         if (! $opts{'-remove_signoff'}) {
4993                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
4994                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
4995                                         "</span><br/>\n";
4996                                 $skip_blank_line = 1;
4997                         }
4998                         next;
4999                 }
5000
5001                 # print only one empty line
5002                 # do not print empty line after signoff
5003                 if ($line eq "") {
5004                         next if ($skip_blank_line);
5005                         $skip_blank_line = 1;
5006                 } else {
5007                         $skip_blank_line = 0;
5008                 }
5009
5010                 print format_log_line_html($line) . "<br/>\n";
5011         }
5012
5013         if ($opts{'-final_empty_line'}) {
5014                 # end with single empty line
5015                 print "<br/>\n" unless $skip_blank_line;
5016         }
5017 }
5018
5019 # return link target (what link points to)
5020 sub git_get_link_target {
5021         my $hash = shift;
5022         my $link_target;
5023
5024         # read link
5025         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5026                 or return;
5027         {
5028                 local $/ = undef;
5029                 $link_target = to_utf8(scalar <$fd>);
5030         }
5031         close $fd
5032                 or return;
5033
5034         return $link_target;
5035 }
5036
5037 # given link target, and the directory (basedir) the link is in,
5038 # return target of link relative to top directory (top tree);
5039 # return undef if it is not possible (including absolute links).
5040 sub normalize_link_target {
5041         my ($link_target, $basedir) = @_;
5042
5043         # absolute symlinks (beginning with '/') cannot be normalized
5044         return if (substr($link_target, 0, 1) eq '/');
5045
5046         # normalize link target to path from top (root) tree (dir)
5047         my $path;
5048         if ($basedir) {
5049                 $path = $basedir . '/' . $link_target;
5050         } else {
5051                 # we are in top (root) tree (dir)
5052                 $path = $link_target;
5053         }
5054
5055         # remove //, /./, and /../
5056         my @path_parts;
5057         foreach my $part (split('/', $path)) {
5058                 # discard '.' and ''
5059                 next if (!$part || $part eq '.');
5060                 # handle '..'
5061                 if ($part eq '..') {
5062                         if (@path_parts) {
5063                                 pop @path_parts;
5064                         } else {
5065                                 # link leads outside repository (outside top dir)
5066                                 return;
5067                         }
5068                 } else {
5069                         push @path_parts, $part;
5070                 }
5071         }
5072         $path = join('/', @path_parts);
5073
5074         return $path;
5075 }
5076
5077 # print tree entry (row of git_tree), but without encompassing <tr> element
5078 sub git_print_tree_entry {
5079         my ($t, $basedir, $hash_base, $have_blame) = @_;
5080
5081         my %base_key = ();
5082         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5083
5084         # The format of a table row is: mode list link.  Where mode is
5085         # the mode of the entry, list is the name of the entry, an href,
5086         # and link is the action links of the entry.
5087
5088         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5089         if (exists $t->{'size'}) {
5090                 print "<td class=\"size\">$t->{'size'}</td>\n";
5091         }
5092         if ($t->{'type'} eq "blob") {
5093                 print "<td class=\"list\">" .
5094                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5095                                                file_name=>"$basedir$t->{'name'}", %base_key),
5096                                 -class => "list"}, esc_path($t->{'name'}));
5097                 if (S_ISLNK(oct $t->{'mode'})) {
5098                         my $link_target = git_get_link_target($t->{'hash'});
5099                         if ($link_target) {
5100                                 my $norm_target = normalize_link_target($link_target, $basedir);
5101                                 if (defined $norm_target) {
5102                                         print " -> " .
5103                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5104                                                                      file_name=>$norm_target),
5105                                                        -title => $norm_target}, esc_path($link_target));
5106                                 } else {
5107                                         print " -> " . esc_path($link_target);
5108                                 }
5109                         }
5110                 }
5111                 print "</td>\n";
5112                 print "<td class=\"link\">";
5113                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5114                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5115                               "blob");
5116                 if ($have_blame) {
5117                         print " | " .
5118                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5119                                                      file_name=>"$basedir$t->{'name'}", %base_key)},
5120                                       "blame");
5121                 }
5122                 if (defined $hash_base) {
5123                         print " | " .
5124                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5125                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5126                                       "history");
5127                 }
5128                 print " | " .
5129                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5130                                                file_name=>"$basedir$t->{'name'}")},
5131                                 "raw");
5132                 print "</td>\n";
5133
5134         } elsif ($t->{'type'} eq "tree") {
5135                 print "<td class=\"list\">";
5136                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5137                                              file_name=>"$basedir$t->{'name'}",
5138                                              %base_key)},
5139                               esc_path($t->{'name'}));
5140                 print "</td>\n";
5141                 print "<td class=\"link\">";
5142                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5143                                              file_name=>"$basedir$t->{'name'}",
5144                                              %base_key)},
5145                               "tree");
5146                 if (defined $hash_base) {
5147                         print " | " .
5148                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5149                                                      file_name=>"$basedir$t->{'name'}")},
5150                                       "history");
5151                 }
5152                 print "</td>\n";
5153         } else {
5154                 # unknown object: we can only present history for it
5155                 # (this includes 'commit' object, i.e. submodule support)
5156                 print "<td class=\"list\">" .
5157                       esc_path($t->{'name'}) .
5158                       "</td>\n";
5159                 print "<td class=\"link\">";
5160                 if (defined $hash_base) {
5161                         print $cgi->a({-href => href(action=>"history",
5162                                                      hash_base=>$hash_base,
5163                                                      file_name=>"$basedir$t->{'name'}")},
5164                                       "history");
5165                 }
5166                 print "</td>\n";
5167         }
5168 }
5169
5170 ## ......................................................................
5171 ## functions printing large fragments of HTML
5172
5173 # get pre-image filenames for merge (combined) diff
5174 sub fill_from_file_info {
5175         my ($diff, @parents) = @_;
5176
5177         $diff->{'from_file'} = [ ];
5178         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5179         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5180                 if ($diff->{'status'}[$i] eq 'R' ||
5181                     $diff->{'status'}[$i] eq 'C') {
5182                         $diff->{'from_file'}[$i] =
5183                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5184                 }
5185         }
5186
5187         return $diff;
5188 }
5189
5190 # is current raw difftree line of file deletion
5191 sub is_deleted {
5192         my $diffinfo = shift;
5193
5194         return $diffinfo->{'to_id'} eq ('0' x 40);
5195 }
5196
5197 # does patch correspond to [previous] difftree raw line
5198 # $diffinfo  - hashref of parsed raw diff format
5199 # $patchinfo - hashref of parsed patch diff format
5200 #              (the same keys as in $diffinfo)
5201 sub is_patch_split {
5202         my ($diffinfo, $patchinfo) = @_;
5203
5204         return defined $diffinfo && defined $patchinfo
5205                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5206 }
5207
5208
5209 sub git_difftree_body {
5210         my ($difftree, $hash, @parents) = @_;
5211         my ($parent) = $parents[0];
5212         my $have_blame = gitweb_check_feature('blame');
5213         print "<div class=\"list_head\">\n";
5214         if ($#{$difftree} > 10) {
5215                 print(($#{$difftree} + 1) . " files changed:\n");
5216         }
5217         print "</div>\n";
5218
5219         print "<table class=\"" .
5220               (@parents > 1 ? "combined " : "") .
5221               "diff_tree\">\n";
5222
5223         # header only for combined diff in 'commitdiff' view
5224         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5225         if ($has_header) {
5226                 # table header
5227                 print "<thead><tr>\n" .
5228                        "<th></th><th></th>\n"; # filename, patchN link
5229                 for (my $i = 0; $i < @parents; $i++) {
5230                         my $par = $parents[$i];
5231                         print "<th>" .
5232                               $cgi->a({-href => href(action=>"commitdiff",
5233                                                      hash=>$hash, hash_parent=>$par),
5234                                        -title => 'commitdiff to parent number ' .
5235                                                   ($i+1) . ': ' . substr($par,0,7)},
5236                                       $i+1) .
5237                               "&nbsp;</th>\n";
5238                 }
5239                 print "</tr></thead>\n<tbody>\n";
5240         }
5241
5242         my $alternate = 1;
5243         my $patchno = 0;
5244         foreach my $line (@{$difftree}) {
5245                 my $diff = parsed_difftree_line($line);
5246
5247                 if ($alternate) {
5248                         print "<tr class=\"dark\">\n";
5249                 } else {
5250                         print "<tr class=\"light\">\n";
5251                 }
5252                 $alternate ^= 1;
5253
5254                 if (exists $diff->{'nparents'}) { # combined diff
5255
5256                         fill_from_file_info($diff, @parents)
5257                                 unless exists $diff->{'from_file'};
5258
5259                         if (!is_deleted($diff)) {
5260                                 # file exists in the result (child) commit
5261                                 print "<td>" .
5262                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5263                                                              file_name=>$diff->{'to_file'},
5264                                                              hash_base=>$hash),
5265                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5266                                       "</td>\n";
5267                         } else {
5268                                 print "<td>" .
5269                                       esc_path($diff->{'to_file'}) .
5270                                       "</td>\n";
5271                         }
5272
5273                         if ($action eq 'commitdiff') {
5274                                 # link to patch
5275                                 $patchno++;
5276                                 print "<td class=\"link\">" .
5277                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5278                                               "patch") .
5279                                       " | " .
5280                                       "</td>\n";
5281                         }
5282
5283                         my $has_history = 0;
5284                         my $not_deleted = 0;
5285                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5286                                 my $hash_parent = $parents[$i];
5287                                 my $from_hash = $diff->{'from_id'}[$i];
5288                                 my $from_path = $diff->{'from_file'}[$i];
5289                                 my $status = $diff->{'status'}[$i];
5290
5291                                 $has_history ||= ($status ne 'A');
5292                                 $not_deleted ||= ($status ne 'D');
5293
5294                                 if ($status eq 'A') {
5295                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
5296                                 } elsif ($status eq 'D') {
5297                                         print "<td class=\"link\">" .
5298                                               $cgi->a({-href => href(action=>"blob",
5299                                                                      hash_base=>$hash,
5300                                                                      hash=>$from_hash,
5301                                                                      file_name=>$from_path)},
5302                                                       "blob" . ($i+1)) .
5303                                               " | </td>\n";
5304                                 } else {
5305                                         if ($diff->{'to_id'} eq $from_hash) {
5306                                                 print "<td class=\"link nochange\">";
5307                                         } else {
5308                                                 print "<td class=\"link\">";
5309                                         }
5310                                         print $cgi->a({-href => href(action=>"blobdiff",
5311                                                                      hash=>$diff->{'to_id'},
5312                                                                      hash_parent=>$from_hash,
5313                                                                      hash_base=>$hash,
5314                                                                      hash_parent_base=>$hash_parent,
5315                                                                      file_name=>$diff->{'to_file'},
5316                                                                      file_parent=>$from_path)},
5317                                                       "diff" . ($i+1)) .
5318                                               " | </td>\n";
5319                                 }
5320                         }
5321
5322                         print "<td class=\"link\">";
5323                         if ($not_deleted) {
5324                                 print $cgi->a({-href => href(action=>"blob",
5325                                                              hash=>$diff->{'to_id'},
5326                                                              file_name=>$diff->{'to_file'},
5327                                                              hash_base=>$hash)},
5328                                               "blob");
5329                                 print " | " if ($has_history);
5330                         }
5331                         if ($has_history) {
5332                                 print $cgi->a({-href => href(action=>"history",
5333                                                              file_name=>$diff->{'to_file'},
5334                                                              hash_base=>$hash)},
5335                                               "history");
5336                         }
5337                         print "</td>\n";
5338
5339                         print "</tr>\n";
5340                         next; # instead of 'else' clause, to avoid extra indent
5341                 }
5342                 # else ordinary diff
5343
5344                 my ($to_mode_oct, $to_mode_str, $to_file_type);
5345                 my ($from_mode_oct, $from_mode_str, $from_file_type);
5346                 if ($diff->{'to_mode'} ne ('0' x 6)) {
5347                         $to_mode_oct = oct $diff->{'to_mode'};
5348                         if (S_ISREG($to_mode_oct)) { # only for regular file
5349                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
5350                         }
5351                         $to_file_type = file_type($diff->{'to_mode'});
5352                 }
5353                 if ($diff->{'from_mode'} ne ('0' x 6)) {
5354                         $from_mode_oct = oct $diff->{'from_mode'};
5355                         if (S_ISREG($from_mode_oct)) { # only for regular file
5356                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
5357                         }
5358                         $from_file_type = file_type($diff->{'from_mode'});
5359                 }
5360
5361                 if ($diff->{'status'} eq "A") { # created
5362                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
5363                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
5364                         $mode_chng   .= "]</span>";
5365                         print "<td>";
5366                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5367                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5368                                       -class => "list"}, esc_path($diff->{'file'}));
5369                         print "</td>\n";
5370                         print "<td>$mode_chng</td>\n";
5371                         print "<td class=\"link\">";
5372                         if ($action eq 'commitdiff') {
5373                                 # link to patch
5374                                 $patchno++;
5375                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5376                                               "patch") .
5377                                       " | ";
5378                         }
5379                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5380                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5381                                       "blob");
5382                         print "</td>\n";
5383
5384                 } elsif ($diff->{'status'} eq "D") { # deleted
5385                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5386                         print "<td>";
5387                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5388                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
5389                                        -class => "list"}, esc_path($diff->{'file'}));
5390                         print "</td>\n";
5391                         print "<td>$mode_chng</td>\n";
5392                         print "<td class=\"link\">";
5393                         if ($action eq 'commitdiff') {
5394                                 # link to patch
5395                                 $patchno++;
5396                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5397                                               "patch") .
5398                                       " | ";
5399                         }
5400                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5401                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
5402                                       "blob") . " | ";
5403                         if ($have_blame) {
5404                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5405                                                              file_name=>$diff->{'file'})},
5406                                               "blame") . " | ";
5407                         }
5408                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5409                                                      file_name=>$diff->{'file'})},
5410                                       "history");
5411                         print "</td>\n";
5412
5413                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5414                         my $mode_chnge = "";
5415                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5416                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5417                                 if ($from_file_type ne $to_file_type) {
5418                                         $mode_chnge .= " from $from_file_type to $to_file_type";
5419                                 }
5420                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
5421                                         if ($from_mode_str && $to_mode_str) {
5422                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
5423                                         } elsif ($to_mode_str) {
5424                                                 $mode_chnge .= " mode: $to_mode_str";
5425                                         }
5426                                 }
5427                                 $mode_chnge .= "]</span>\n";
5428                         }
5429                         print "<td>";
5430                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5431                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5432                                       -class => "list"}, esc_path($diff->{'file'}));
5433                         print "</td>\n";
5434                         print "<td>$mode_chnge</td>\n";
5435                         print "<td class=\"link\">";
5436                         if ($action eq 'commitdiff') {
5437                                 # link to patch
5438                                 $patchno++;
5439                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5440                                               "patch") .
5441                                       " | ";
5442                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5443                                 # "commit" view and modified file (not onlu mode changed)
5444                                 print $cgi->a({-href => href(action=>"blobdiff",
5445                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5446                                                              hash_base=>$hash, hash_parent_base=>$parent,
5447                                                              file_name=>$diff->{'file'})},
5448                                               "diff") .
5449                                       " | ";
5450                         }
5451                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5452                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5453                                        "blob") . " | ";
5454                         if ($have_blame) {
5455                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5456                                                              file_name=>$diff->{'file'})},
5457                                               "blame") . " | ";
5458                         }
5459                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5460                                                      file_name=>$diff->{'file'})},
5461                                       "history");
5462                         print "</td>\n";
5463
5464                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
5465                         my %status_name = ('R' => 'moved', 'C' => 'copied');
5466                         my $nstatus = $status_name{$diff->{'status'}};
5467                         my $mode_chng = "";
5468                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5469                                 # mode also for directories, so we cannot use $to_mode_str
5470                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
5471                         }
5472                         print "<td>" .
5473                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
5474                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
5475                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
5476                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
5477                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
5478                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
5479                                       -class => "list"}, esc_path($diff->{'from_file'})) .
5480                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
5481                               "<td class=\"link\">";
5482                         if ($action eq 'commitdiff') {
5483                                 # link to patch
5484                                 $patchno++;
5485                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5486                                               "patch") .
5487                                       " | ";
5488                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5489                                 # "commit" view and modified file (not only pure rename or copy)
5490                                 print $cgi->a({-href => href(action=>"blobdiff",
5491                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5492                                                              hash_base=>$hash, hash_parent_base=>$parent,
5493                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
5494                                               "diff") .
5495                                       " | ";
5496                         }
5497                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5498                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
5499                                       "blob") . " | ";
5500                         if ($have_blame) {
5501                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5502                                                              file_name=>$diff->{'to_file'})},
5503                                               "blame") . " | ";
5504                         }
5505                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5506                                                     file_name=>$diff->{'to_file'})},
5507                                       "history");
5508                         print "</td>\n";
5509
5510                 } # we should not encounter Unmerged (U) or Unknown (X) status
5511                 print "</tr>\n";
5512         }
5513         print "</tbody>" if $has_header;
5514         print "</table>\n";
5515 }
5516
5517 # Print context lines and then rem/add lines in a side-by-side manner.
5518 sub print_sidebyside_diff_lines {
5519         my ($ctx, $rem, $add) = @_;
5520
5521         # print context block before add/rem block
5522         if (@$ctx) {
5523                 print join '',
5524                         '<div class="chunk_block ctx">',
5525                                 '<div class="old">',
5526                                 @$ctx,
5527                                 '</div>',
5528                                 '<div class="new">',
5529                                 @$ctx,
5530                                 '</div>',
5531                         '</div>';
5532         }
5533
5534         if (!@$add) {
5535                 # pure removal
5536                 print join '',
5537                         '<div class="chunk_block rem">',
5538                                 '<div class="old">',
5539                                 @$rem,
5540                                 '</div>',
5541                         '</div>';
5542         } elsif (!@$rem) {
5543                 # pure addition
5544                 print join '',
5545                         '<div class="chunk_block add">',
5546                                 '<div class="new">',
5547                                 @$add,
5548                                 '</div>',
5549                         '</div>';
5550         } else {
5551                 print join '',
5552                         '<div class="chunk_block chg">',
5553                                 '<div class="old">',
5554                                 @$rem,
5555                                 '</div>',
5556                                 '<div class="new">',
5557                                 @$add,
5558                                 '</div>',
5559                         '</div>';
5560         }
5561 }
5562
5563 # Print context lines and then rem/add lines in inline manner.
5564 sub print_inline_diff_lines {
5565         my ($ctx, $rem, $add) = @_;
5566
5567         print @$ctx, @$rem, @$add;
5568 }
5569
5570 # Format removed and added line, mark changed part and HTML-format them.
5571 # Implementation is based on contrib/diff-highlight
5572 sub format_rem_add_lines_pair {
5573         my ($rem, $add, $num_parents) = @_;
5574
5575         # We need to untabify lines before split()'ing them;
5576         # otherwise offsets would be invalid.
5577         chomp $rem;
5578         chomp $add;
5579         $rem = untabify($rem);
5580         $add = untabify($add);
5581
5582         my @rem = split(//, $rem);
5583         my @add = split(//, $add);
5584         my ($esc_rem, $esc_add);
5585         # Ignore leading +/- characters for each parent.
5586         my ($prefix_len, $suffix_len) = ($num_parents, 0);
5587         my ($prefix_has_nonspace, $suffix_has_nonspace);
5588
5589         my $shorter = (@rem < @add) ? @rem : @add;
5590         while ($prefix_len < $shorter) {
5591                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
5592
5593                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
5594                 $prefix_len++;
5595         }
5596
5597         while ($prefix_len + $suffix_len < $shorter) {
5598                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
5599
5600                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
5601                 $suffix_len++;
5602         }
5603
5604         # Mark lines that are different from each other, but have some common
5605         # part that isn't whitespace.  If lines are completely different, don't
5606         # mark them because that would make output unreadable, especially if
5607         # diff consists of multiple lines.
5608         if ($prefix_has_nonspace || $suffix_has_nonspace) {
5609                 $esc_rem = esc_html_hl_regions($rem, 'marked',
5610                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
5611                 $esc_add = esc_html_hl_regions($add, 'marked',
5612                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
5613         } else {
5614                 $esc_rem = esc_html($rem, -nbsp=>1);
5615                 $esc_add = esc_html($add, -nbsp=>1);
5616         }
5617
5618         return format_diff_line(\$esc_rem, 'rem'),
5619                format_diff_line(\$esc_add, 'add');
5620 }
5621
5622 # HTML-format diff context, removed and added lines.
5623 sub format_ctx_rem_add_lines {
5624         my ($ctx, $rem, $add, $num_parents) = @_;
5625         my (@new_ctx, @new_rem, @new_add);
5626         my $can_highlight = 0;
5627         my $is_combined = ($num_parents > 1);
5628
5629         # Highlight if every removed line has a corresponding added line.
5630         if (@$add > 0 && @$add == @$rem) {
5631                 $can_highlight = 1;
5632
5633                 # Highlight lines in combined diff only if the chunk contains
5634                 # diff between the same version, e.g.
5635                 #
5636                 #    - a
5637                 #   -  b
5638                 #    + c
5639                 #   +  d
5640                 #
5641                 # Otherwise the highlightling would be confusing.
5642                 if ($is_combined) {
5643                         for (my $i = 0; $i < @$add; $i++) {
5644                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
5645                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
5646
5647                                 $prefix_rem =~ s/-/+/g;
5648
5649                                 if ($prefix_rem ne $prefix_add) {
5650                                         $can_highlight = 0;
5651                                         last;
5652                                 }
5653                         }
5654                 }
5655         }
5656
5657         if ($can_highlight) {
5658                 for (my $i = 0; $i < @$add; $i++) {
5659                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
5660                                 $rem->[$i], $add->[$i], $num_parents);
5661                         push @new_rem, $line_rem;
5662                         push @new_add, $line_add;
5663                 }
5664         } else {
5665                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
5666                 @new_add = map { format_diff_line($_, 'add') } @$add;
5667         }
5668
5669         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
5670
5671         return (\@new_ctx, \@new_rem, \@new_add);
5672 }
5673
5674 # Print context lines and then rem/add lines.
5675 sub print_diff_lines {
5676         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
5677         my $is_combined = $num_parents > 1;
5678
5679         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
5680                 $num_parents);
5681
5682         if ($diff_style eq 'sidebyside' && !$is_combined) {
5683                 print_sidebyside_diff_lines($ctx, $rem, $add);
5684         } else {
5685                 # default 'inline' style and unknown styles
5686                 print_inline_diff_lines($ctx, $rem, $add);
5687         }
5688 }
5689
5690 sub print_diff_chunk {
5691         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
5692         my (@ctx, @rem, @add);
5693
5694         # The class of the previous line.
5695         my $prev_class = '';
5696
5697         return unless @chunk;
5698
5699         # incomplete last line might be among removed or added lines,
5700         # or both, or among context lines: find which
5701         for (my $i = 1; $i < @chunk; $i++) {
5702                 if ($chunk[$i][0] eq 'incomplete') {
5703                         $chunk[$i][0] = $chunk[$i-1][0];
5704                 }
5705         }
5706
5707         # guardian
5708         push @chunk, ["", ""];
5709
5710         foreach my $line_info (@chunk) {
5711                 my ($class, $line) = @$line_info;
5712
5713                 # print chunk headers
5714                 if ($class && $class eq 'chunk_header') {
5715                         print format_diff_line($line, $class, $from, $to);
5716                         next;
5717                 }
5718
5719                 ## print from accumulator when have some add/rem lines or end
5720                 # of chunk (flush context lines), or when have add and rem
5721                 # lines and new block is reached (otherwise add/rem lines could
5722                 # be reordered)
5723                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
5724                     (@rem && @add && $class ne $prev_class)) {
5725                         print_diff_lines(\@ctx, \@rem, \@add,
5726                                          $diff_style, $num_parents);
5727                         @ctx = @rem = @add = ();
5728                 }
5729
5730                 ## adding lines to accumulator
5731                 # guardian value
5732                 last unless $line;
5733                 # rem, add or change
5734                 if ($class eq 'rem') {
5735                         push @rem, $line;
5736                 } elsif ($class eq 'add') {
5737                         push @add, $line;
5738                 }
5739                 # context line
5740                 if ($class eq 'ctx') {
5741                         push @ctx, $line;
5742                 }
5743
5744                 $prev_class = $class;
5745         }
5746 }
5747
5748 sub git_patchset_body {
5749         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
5750         my ($hash_parent) = $hash_parents[0];
5751
5752         my $is_combined = (@hash_parents > 1);
5753         my $patch_idx = 0;
5754         my $patch_number = 0;
5755         my $patch_line;
5756         my $diffinfo;
5757         my $to_name;
5758         my (%from, %to);
5759         my @chunk; # for side-by-side diff
5760
5761         print "<div class=\"patchset\">\n";
5762
5763         # skip to first patch
5764         while ($patch_line = to_utf8(scalar <$fd>)) {
5765                 chomp $patch_line;
5766
5767                 last if ($patch_line =~ m/^diff /);
5768         }
5769
5770  PATCH:
5771         while ($patch_line) {
5772
5773                 # parse "git diff" header line
5774                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
5775                         # $1 is from_name, which we do not use
5776                         $to_name = unquote($2);
5777                         $to_name =~ s!^b/!!;
5778                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
5779                         # $1 is 'cc' or 'combined', which we do not use
5780                         $to_name = unquote($2);
5781                 } else {
5782                         $to_name = undef;
5783                 }
5784
5785                 # check if current patch belong to current raw line
5786                 # and parse raw git-diff line if needed
5787                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
5788                         # this is continuation of a split patch
5789                         print "<div class=\"patch cont\">\n";
5790                 } else {
5791                         # advance raw git-diff output if needed
5792                         $patch_idx++ if defined $diffinfo;
5793
5794                         # read and prepare patch information
5795                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5796
5797                         # compact combined diff output can have some patches skipped
5798                         # find which patch (using pathname of result) we are at now;
5799                         if ($is_combined) {
5800                                 while ($to_name ne $diffinfo->{'to_file'}) {
5801                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
5802                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
5803                                               "</div>\n";  # class="patch"
5804
5805                                         $patch_idx++;
5806                                         $patch_number++;
5807
5808                                         last if $patch_idx > $#$difftree;
5809                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5810                                 }
5811                         }
5812
5813                         # modifies %from, %to hashes
5814                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
5815
5816                         # this is first patch for raw difftree line with $patch_idx index
5817                         # we index @$difftree array from 0, but number patches from 1
5818                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
5819                 }
5820
5821                 # git diff header
5822                 #assert($patch_line =~ m/^diff /) if DEBUG;
5823                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
5824                 $patch_number++;
5825                 # print "git diff" header
5826                 print format_git_diff_header_line($patch_line, $diffinfo,
5827                                                   \%from, \%to);
5828
5829                 # print extended diff header
5830                 print "<div class=\"diff extended_header\">\n";
5831         EXTENDED_HEADER:
5832                 while ($patch_line = to_utf8(scalar<$fd>)) {
5833                         chomp $patch_line;
5834
5835                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
5836
5837                         print format_extended_diff_header_line($patch_line, $diffinfo,
5838                                                                \%from, \%to);
5839                 }
5840                 print "</div>\n"; # class="diff extended_header"
5841
5842                 # from-file/to-file diff header
5843                 if (! $patch_line) {
5844                         print "</div>\n"; # class="patch"
5845                         last PATCH;
5846                 }
5847                 next PATCH if ($patch_line =~ m/^diff /);
5848                 #assert($patch_line =~ m/^---/) if DEBUG;
5849
5850                 my $last_patch_line = $patch_line;
5851                 $patch_line = to_utf8(scalar <$fd>);
5852                 chomp $patch_line;
5853                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
5854
5855                 print format_diff_from_to_header($last_patch_line, $patch_line,
5856                                                  $diffinfo, \%from, \%to,
5857                                                  @hash_parents);
5858
5859                 # the patch itself
5860         LINE:
5861                 while ($patch_line = to_utf8(scalar <$fd>)) {
5862                         chomp $patch_line;
5863
5864                         next PATCH if ($patch_line =~ m/^diff /);
5865
5866                         my $class = diff_line_class($patch_line, \%from, \%to);
5867
5868                         if ($class eq 'chunk_header') {
5869                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
5870                                 @chunk = ();
5871                         }
5872
5873                         push @chunk, [ $class, $patch_line ];
5874                 }
5875
5876         } continue {
5877                 if (@chunk) {
5878                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
5879                         @chunk = ();
5880                 }
5881                 print "</div>\n"; # class="patch"
5882         }
5883
5884         # for compact combined (--cc) format, with chunk and patch simplification
5885         # the patchset might be empty, but there might be unprocessed raw lines
5886         for (++$patch_idx if $patch_number > 0;
5887              $patch_idx < @$difftree;
5888              ++$patch_idx) {
5889                 # read and prepare patch information
5890                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5891
5892                 # generate anchor for "patch" links in difftree / whatchanged part
5893                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
5894                       format_diff_cc_simplified($diffinfo, @hash_parents) .
5895                       "</div>\n";  # class="patch"
5896
5897                 $patch_number++;
5898         }
5899
5900         if ($patch_number == 0) {
5901                 if (@hash_parents > 1) {
5902                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
5903                 } else {
5904                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
5905                 }
5906         }
5907
5908         print "</div>\n"; # class="patchset"
5909 }
5910
5911 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
5912
5913 sub git_project_search_form {
5914         my ($searchtext, $search_use_regexp) = @_;
5915
5916         my $limit = '';
5917         if ($project_filter) {
5918                 $limit = " in '$project_filter'";
5919         }
5920
5921         print "<div class=\"projsearch\">\n";
5922         print $cgi->start_form(-method => 'get', -action => $my_uri) .
5923               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
5924         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
5925                 if (defined $project_filter);
5926         print $cgi->textfield(-name => 's', -value => $searchtext,
5927                               -title => "Search project by name and description$limit",
5928                               -size => 60) . "\n" .
5929               "<span title=\"Extended regular expression\">" .
5930               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5931                              -checked => $search_use_regexp) .
5932               "</span>\n" .
5933               $cgi->submit(-name => 'btnS', -value => 'Search') .
5934               $cgi->end_form() . "\n" .
5935               "<span class=\"projectlist_link\">" .
5936               $cgi->a({-href => href(project => undef, searchtext => undef,
5937                                      action => 'project_list',
5938                                      project_filter => $project_filter)},
5939                       esc_html("List all projects$limit")) . "</span><br />\n";
5940         print "<span class=\"projectlist_link\">" .
5941               $cgi->a({-href => href(project => undef, searchtext => undef,
5942                                      action => 'project_list',
5943                                      project_filter => undef)},
5944                       esc_html("List all projects")) . "</span>\n" if $project_filter;
5945         print "</div>\n";
5946 }
5947
5948 # entry for given @keys needs filling if at least one of keys in list
5949 # is not present in %$project_info
5950 sub project_info_needs_filling {
5951         my ($project_info, @keys) = @_;
5952
5953         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
5954         foreach my $key (@keys) {
5955                 if (!exists $project_info->{$key}) {
5956                         return 1;
5957                 }
5958         }
5959         return;
5960 }
5961
5962 sub git_cache_file_format {
5963         return GITWEB_CACHE_FORMAT .
5964                 (gitweb_check_feature('forks') ? " (forks)" : "");
5965 }
5966
5967 sub git_retrieve_cache_file {
5968         my $cache_file = shift;
5969
5970         use Storable qw(retrieve);
5971
5972         if ((my $dump = eval { retrieve($cache_file) })) {
5973                 return $$dump[1] if
5974                         ref($dump) eq 'ARRAY' &&
5975                         @$dump == 2 &&
5976                         ref($$dump[1]) eq 'ARRAY' &&
5977                         @{$$dump[1]} == 2 &&
5978                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
5979                         ref(${$$dump[1]}[1]) eq 'HASH' &&
5980                         $$dump[0] eq git_cache_file_format();
5981         }
5982
5983         return undef;
5984 }
5985
5986 sub git_store_cache_file {
5987         my ($cache_file, $cachedata) = @_;
5988
5989         use File::Basename qw(dirname);
5990         use File::stat;
5991         use POSIX qw(:fcntl_h);
5992         use Storable qw(store_fd);
5993
5994         my $result = undef;
5995         my $cache_d = dirname($cache_file);
5996         my $mask = umask();
5997         umask($mask & ~0070) if $cache_grpshared;
5998         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
5999             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6000                 store_fd([git_cache_file_format(), $cachedata], $fd);
6001                 close $fd;
6002                 rename "$cache_file.lock", $cache_file;
6003                 $result = stat($cache_file)->mtime;
6004         }
6005         umask($mask) if $cache_grpshared;
6006         return $result;
6007 }
6008
6009 sub verify_cached_project {
6010         my ($hashref, $path) = @_;
6011         return undef unless $path;
6012         delete $$hashref{$path}, return undef unless is_valid_project($path);
6013         return $$hashref{$path} if exists $$hashref{$path};
6014
6015         # A valid project was requested but it's not yet in the cache
6016         # Manufacture a minimal project entry (path, name, description)
6017         # Also provide age, but only if it's available via $lastactivity_file
6018
6019         my %proj = ('path' => $path);
6020         my $val = git_get_project_description($path);
6021         defined $val or $val = '';
6022         $proj{'descr_long'} = $val;
6023         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6024         unless ($omit_owner) {
6025                 $val = git_get_project_owner($path);
6026                 defined $val or $val = '';
6027                 $proj{'owner'} = $val;
6028         }
6029         unless ($omit_age_column) {
6030                 ($val) = git_get_last_activity($path, 1);
6031                 $proj{'age_epoch'} = $val if defined $val;
6032         }
6033         $$hashref{$path} = \%proj;
6034         return \%proj;
6035 }
6036
6037 sub git_filter_cached_projects {
6038         my ($cache, $projlist, $verify) = @_;
6039         my $hashref = $$cache[1];
6040         my $sub = $verify ?
6041                 sub {verify_cached_project($hashref, $_[0])} :
6042                 sub {$$hashref{$_[0]}};
6043         return map {
6044                 my $c = &$sub($_->{'path'});
6045                 defined $c ? ($_ = $c) : ()
6046         } @$projlist;
6047 }
6048
6049 # fills project list info (age, description, owner, category, forks, etc.)
6050 # for each project in the list, removing invalid projects from
6051 # returned list, or fill only specified info.
6052 #
6053 # Invalid projects are removed from the returned list if and only if you
6054 # ask 'age_epoch' to be filled, because they are the only fields
6055 # that run unconditionally git command that requires repository, and
6056 # therefore do always check if project repository is invalid.
6057 #
6058 # USAGE:
6059 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6060 #   ensures that 'descr_long' and 'ctags' fields are filled
6061 # * @project_list = fill_project_list_info(\@project_list)
6062 #   ensures that all fields are filled (and invalid projects removed)
6063 #
6064 # NOTE: modifies $projlist, but does not remove entries from it
6065 sub fill_project_list_info {
6066         my ($projlist, @wanted_keys) = @_;
6067
6068         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6069         return fill_project_list_info_uncached($projlist, @wanted_keys)
6070                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6071
6072         use File::stat;
6073
6074         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6075         my $cache_file = "$cache_dir/$projlist_cache_name";
6076
6077         my @projects;
6078         my $stale = 0;
6079         my $now = time();
6080         my $cache_mtime;
6081         if ($cache_lifetime && -f $cache_file) {
6082                 $cache_mtime = stat($cache_file)->mtime;
6083                 $cache_dump = undef if $cache_mtime &&
6084                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6085         }
6086         if (defined $cache_mtime && # caching is on and $cache_file exists
6087             $cache_mtime + $cache_lifetime*60 > $now &&
6088             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6089                 # Cache hit.
6090                 $cache_dump_mtime = $cache_mtime;
6091                 $stale = $now - $cache_mtime;
6092                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6093                         gitweb_check_feature('forks');
6094                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6095
6096         } else { # Cache miss.
6097                 if (defined $cache_mtime) {
6098                         # Postpone timeout by two minutes so that we get
6099                         # enough time to do our job, or to be more exact
6100                         # make cache expire after two minutes from now.
6101                         my $time = $now - $cache_lifetime*60 + 120;
6102                         utime $time, $time, $cache_file;
6103                 }
6104                 my @all_projects = git_get_projects_list();
6105                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6106                         fill_project_list_info_uncached(\@all_projects);
6107                 map { $all_projects_filled{$_->{'path'}} = $_ }
6108                         filter_forks_from_projects_list([values(%all_projects_filled)])
6109                         if gitweb_check_feature('forks');
6110                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6111                                \%all_projects_filled];
6112                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6113                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6114         }
6115
6116         if ($cache_lifetime && $stale > 0) {
6117                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6118                         unless $shown_stale_message;
6119                 $shown_stale_message = 1;
6120         }
6121
6122         return @projects;
6123 }
6124
6125 sub fill_project_list_info_uncached {
6126         my ($projlist, @wanted_keys) = @_;
6127         my @projects;
6128         my $filter_set = sub { return @_; };
6129         if (@wanted_keys) {
6130                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6131                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6132         }
6133
6134         my $show_ctags = gitweb_check_feature('ctags');
6135  PROJECT:
6136         foreach my $pr (@$projlist) {
6137                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6138                         my (@activity) = git_get_last_activity($pr->{'path'});
6139                         unless (@activity) {
6140                                 next PROJECT;
6141                         }
6142                         ($pr->{'age_epoch'}) = @activity;
6143                 }
6144                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6145                         my $descr = git_get_project_description($pr->{'path'}) || "";
6146                         $descr = to_utf8($descr);
6147                         $pr->{'descr_long'} = $descr;
6148                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6149                 }
6150                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6151                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6152                 }
6153                 if ($show_ctags &&
6154                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6155                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6156                 }
6157                 if ($projects_list_group_categories &&
6158                     project_info_needs_filling($pr, $filter_set->('category'))) {
6159                         my $cat = git_get_project_category($pr->{'path'}) ||
6160                                                            $project_list_default_category;
6161                         $pr->{'category'} = to_utf8($cat);
6162                 }
6163
6164                 push @projects, $pr;
6165         }
6166
6167         return @projects;
6168 }
6169
6170 sub sort_projects_list {
6171         my ($projlist, $order) = @_;
6172
6173         sub order_str {
6174                 my $key = shift;
6175                 return sub { $a->{$key} cmp $b->{$key} };
6176         }
6177
6178         sub order_reverse_num_then_undef {
6179                 my $key = shift;
6180                 return sub {
6181                         defined $a->{$key} ?
6182                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6183                                 (defined $b->{$key} ? 1 : 0)
6184                 };
6185         }
6186
6187         my %orderings = (
6188                 project => order_str('path'),
6189                 descr => order_str('descr_long'),
6190                 owner => order_str('owner'),
6191                 age => order_reverse_num_then_undef('age_epoch'),
6192         );
6193
6194         my $ordering = $orderings{$order};
6195         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6196 }
6197
6198 # returns a hash of categories, containing the list of project
6199 # belonging to each category
6200 sub build_projlist_by_category {
6201         my ($projlist, $from, $to) = @_;
6202         my %categories;
6203
6204         $from = 0 unless defined $from;
6205         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6206
6207         for (my $i = $from; $i <= $to; $i++) {
6208                 my $pr = $projlist->[$i];
6209                 push @{$categories{ $pr->{'category'} }}, $pr;
6210         }
6211
6212         return wantarray ? %categories : \%categories;
6213 }
6214
6215 # print 'sort by' <th> element, generating 'sort by $name' replay link
6216 # if that order is not selected
6217 sub print_sort_th {
6218         print format_sort_th(@_);
6219 }
6220
6221 sub format_sort_th {
6222         my ($name, $order, $header) = @_;
6223         my $sort_th = "";
6224         $header ||= ucfirst($name);
6225
6226         if ($order eq $name) {
6227                 $sort_th .= "<th>$header</th>\n";
6228         } else {
6229                 $sort_th .= "<th>" .
6230                             $cgi->a({-href => href(-replay=>1, order=>$name),
6231                                      -class => "header"}, $header) .
6232                             "</th>\n";
6233         }
6234
6235         return $sort_th;
6236 }
6237
6238 sub git_project_list_rows {
6239         my ($projlist, $from, $to, $check_forks) = @_;
6240
6241         $from = 0 unless defined $from;
6242         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6243
6244         my $now = time;
6245         my $alternate = 1;
6246         for (my $i = $from; $i <= $to; $i++) {
6247                 my $pr = $projlist->[$i];
6248
6249                 if ($alternate) {
6250                         print "<tr class=\"dark\">\n";
6251                 } else {
6252                         print "<tr class=\"light\">\n";
6253                 }
6254                 $alternate ^= 1;
6255
6256                 if ($check_forks) {
6257                         print "<td>";
6258                         if ($pr->{'forks'}) {
6259                                 my $nforks = scalar @{$pr->{'forks'}};
6260                                 if ($nforks > 0) {
6261                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6262                                                        -title => "$nforks forks"}, "+");
6263                                 } else {
6264                                         print $cgi->span({-title => "$nforks forks"}, "+");
6265                                 }
6266                         }
6267                         print "</td>\n";
6268                 }
6269                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6270                                         -class => "list"},
6271                                        esc_html_match_hl($pr->{'path'}, $search_regexp)) .
6272                       "</td>\n" .
6273                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6274                                         -class => "list",
6275                                         -title => $pr->{'descr_long'}},
6276                                         $search_regexp
6277                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6278                                                                     $pr->{'descr'}, $search_regexp)
6279                                         : esc_html($pr->{'descr'})) .
6280                       "</td>\n";
6281                 unless ($omit_owner) {
6282                         print "<td><i>" . chop_and_escape_str($pr->{'owner'}, 15) . "</i></td>\n";
6283                 }
6284                 unless ($omit_age_column) {
6285                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6286                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6287                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6288                 }
6289                 print"<td class=\"link\">" .
6290                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
6291                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "shortlog") . " | " .
6292                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"log")}, "log") . " | " .
6293                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6294                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6295                       "</td>\n" .
6296                       "</tr>\n";
6297         }
6298 }
6299
6300 sub git_project_list_body {
6301         # actually uses global variable $project
6302         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action) = @_;
6303         my @projects = @$projlist;
6304
6305         my $check_forks = gitweb_check_feature('forks');
6306         my $show_ctags  = gitweb_check_feature('ctags');
6307         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6308         $check_forks = undef
6309                 if ($tagfilter || $search_regexp);
6310
6311         # filtering out forks before filling info allows to do less work
6312         @projects = filter_forks_from_projects_list(\@projects)
6313                 if ($check_forks);
6314         # search_projects_list pre-fills required info
6315         @projects = search_projects_list(\@projects,
6316                                          'search_regexp' => $search_regexp,
6317                                          'tagfilter'  => $tagfilter)
6318                 if ($tagfilter || $search_regexp);
6319         # fill the rest
6320         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6321         push @all_fields, 'age_epoch' unless($omit_age_column);
6322         push @all_fields, 'owner' unless($omit_owner);
6323         @projects = fill_project_list_info(\@projects, @all_fields);
6324
6325         $order ||= $default_projects_order;
6326         $from = 0 unless defined $from;
6327         $to = $#projects if (!defined $to || $#projects < $to);
6328
6329         # short circuit
6330         if ($from > $to) {
6331                 print "<center>\n".
6332                       "<b>No such projects found</b><br />\n".
6333                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
6334                       "</center>\n<br />\n";
6335                 return;
6336         }
6337
6338         @projects = sort_projects_list(\@projects, $order);
6339
6340         if ($show_ctags) {
6341                 my $ctags = git_gather_all_ctags(\@projects);
6342                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
6343                 print git_show_project_tagcloud($cloud, 64);
6344         }
6345
6346         print "<table class=\"project_list\">\n";
6347         unless ($no_header) {
6348                 print "<tr>\n";
6349                 if ($check_forks) {
6350                         print "<th></th>\n";
6351                 }
6352                 print_sort_th('project', $order, 'Project');
6353                 print_sort_th('descr', $order, 'Description');
6354                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
6355                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
6356                 print "<th></th>\n" . # for links
6357                       "</tr>\n";
6358         }
6359
6360         if ($projects_list_group_categories) {
6361                 # only display categories with projects in the $from-$to window
6362                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
6363                 my %categories = build_projlist_by_category(\@projects, $from, $to);
6364                 foreach my $cat (sort keys %categories) {
6365                         unless ($cat eq "") {
6366                                 print "<tr>\n";
6367                                 if ($check_forks) {
6368                                         print "<td></td>\n";
6369                                 }
6370                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
6371                                 print "</tr>\n";
6372                         }
6373
6374                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
6375                 }
6376         } else {
6377                 git_project_list_rows(\@projects, $from, $to, $check_forks);
6378         }
6379
6380         if (defined $extra) {
6381                 print "<tr>\n";
6382                 if ($check_forks) {
6383                         print "<td></td>\n";
6384                 }
6385                 print "<td colspan=\"5\">$extra</td>\n" .
6386                       "</tr>\n";
6387         }
6388         print "</table>\n";
6389 }
6390
6391 sub git_log_body {
6392         # uses global variable $project
6393         my ($commitlist, $from, $to, $refs, $extra) = @_;
6394
6395         $from = 0 unless defined $from;
6396         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6397
6398         for (my $i = 0; $i <= $to; $i++) {
6399                 my %co = %{$commitlist->[$i]};
6400                 next if !%co;
6401                 my $commit = $co{'id'};
6402                 my $ref = format_ref_marker($refs, $commit);
6403                 git_print_header_div('commit',
6404                                "<span class=\"age\">$co{'age_string'}</span>" .
6405                                esc_html($co{'title'}) . $ref,
6406                                $commit);
6407                 print "<div class=\"title_text\">\n" .
6408                       "<div class=\"log_link\">\n" .
6409                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
6410                       " | " .
6411                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
6412                       " | " .
6413                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
6414                       "<br/>\n" .
6415                       "</div>\n";
6416                       git_print_authorship(\%co, -tag => 'span');
6417                       print "<br/>\n</div>\n";
6418
6419                 print "<div class=\"log_body\">\n";
6420                 git_print_log($co{'comment'}, -final_empty_line=> 1);
6421                 print "</div>\n";
6422         }
6423         if ($extra) {
6424                 print "<div class=\"page_nav\">\n";
6425                 print "$extra\n";
6426                 print "</div>\n";
6427         }
6428 }
6429
6430 sub git_shortlog_body {
6431         # uses global variable $project
6432         my ($commitlist, $from, $to, $refs, $extra) = @_;
6433
6434         $from = 0 unless defined $from;
6435         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6436
6437         print "<table class=\"shortlog\">\n";
6438         my $alternate = 1;
6439         for (my $i = $from; $i <= $to; $i++) {
6440                 my %co = %{$commitlist->[$i]};
6441                 my $commit = $co{'id'};
6442                 my $ref = format_ref_marker($refs, $commit);
6443                 if ($alternate) {
6444                         print "<tr class=\"dark\">\n";
6445                 } else {
6446                         print "<tr class=\"light\">\n";
6447                 }
6448                 $alternate ^= 1;
6449                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
6450                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6451                       format_author_html('td', \%co, 10) . "<td>";
6452                 print format_subject_html($co{'title'}, $co{'title_short'},
6453                                           href(action=>"commit", hash=>$commit), $ref);
6454                 print "</td>\n" .
6455                       "<td class=\"link\">" .
6456                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
6457                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
6458                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
6459                 my $snapshot_links = format_snapshot_links($commit);
6460                 if (defined $snapshot_links) {
6461                         print " | " . $snapshot_links;
6462                 }
6463                 print "</td>\n" .
6464                       "</tr>\n";
6465         }
6466         if (defined $extra) {
6467                 print "<tr>\n" .
6468                       "<td colspan=\"4\">$extra</td>\n" .
6469                       "</tr>\n";
6470         }
6471         print "</table>\n";
6472 }
6473
6474 sub git_history_body {
6475         # Warning: assumes constant type (blob or tree) during history
6476         my ($commitlist, $from, $to, $refs, $extra,
6477             $file_name, $file_hash, $ftype) = @_;
6478
6479         $from = 0 unless defined $from;
6480         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
6481
6482         print "<table class=\"history\">\n";
6483         my $alternate = 1;
6484         for (my $i = $from; $i <= $to; $i++) {
6485                 my %co = %{$commitlist->[$i]};
6486                 if (!%co) {
6487                         next;
6488                 }
6489                 my $commit = $co{'id'};
6490
6491                 my $ref = format_ref_marker($refs, $commit);
6492
6493                 if ($alternate) {
6494                         print "<tr class=\"dark\">\n";
6495                 } else {
6496                         print "<tr class=\"light\">\n";
6497                 }
6498                 $alternate ^= 1;
6499                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6500         # shortlog:   format_author_html('td', \%co, 10)
6501                       format_author_html('td', \%co, 15, 3) . "<td>";
6502                 # originally git_history used chop_str($co{'title'}, 50)
6503                 print format_subject_html($co{'title'}, $co{'title_short'},
6504                                           href(action=>"commit", hash=>$commit), $ref);
6505                 print "</td>\n" .
6506                       "<td class=\"link\">" .
6507                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
6508                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
6509
6510                 if ($ftype eq 'blob') {
6511                         my $blob_current = $file_hash;
6512                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
6513                         if (defined $blob_current && defined $blob_parent &&
6514                                         $blob_current ne $blob_parent) {
6515                                 print " | " .
6516                                         $cgi->a({-href => href(action=>"blobdiff",
6517                                                                hash=>$blob_current, hash_parent=>$blob_parent,
6518                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
6519                                                                file_name=>$file_name)},
6520                                                 "diff to current");
6521                         }
6522                 }
6523                 print "</td>\n" .
6524                       "</tr>\n";
6525         }
6526         if (defined $extra) {
6527                 print "<tr>\n" .
6528                       "<td colspan=\"4\">$extra</td>\n" .
6529                       "</tr>\n";
6530         }
6531         print "</table>\n";
6532 }
6533
6534 sub git_tags_body {
6535         # uses global variable $project
6536         my ($taglist, $from, $to, $extra) = @_;
6537         $from = 0 unless defined $from;
6538         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
6539
6540         print "<table class=\"tags\">\n";
6541         my $alternate = 1;
6542         for (my $i = $from; $i <= $to; $i++) {
6543                 my $entry = $taglist->[$i];
6544                 my %tag = %$entry;
6545                 my $comment = $tag{'subject'};
6546                 my $comment_short;
6547                 if (defined $comment) {
6548                         $comment_short = chop_str($comment, 30, 5);
6549                 }
6550                 if ($alternate) {
6551                         print "<tr class=\"dark\">\n";
6552                 } else {
6553                         print "<tr class=\"light\">\n";
6554                 }
6555                 $alternate ^= 1;
6556                 if (defined $tag{'age'}) {
6557                         print "<td><i>$tag{'age'}</i></td>\n";
6558                 } else {
6559                         print "<td></td>\n";
6560                 }
6561                 print "<td>" .
6562                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
6563                                -class => "list name"}, esc_html($tag{'name'})) .
6564                       "</td>\n" .
6565                       "<td>";
6566                 if (defined $comment) {
6567                         print format_subject_html($comment, $comment_short,
6568                                                   href(action=>"tag", hash=>$tag{'id'}));
6569                 }
6570                 print "</td>\n" .
6571                       "<td class=\"selflink\">";
6572                 if ($tag{'type'} eq "tag") {
6573                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
6574                 } else {
6575                         print "&nbsp;";
6576                 }
6577                 print "</td>\n" .
6578                       "<td class=\"link\">" . " | " .
6579                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
6580                 if ($tag{'reftype'} eq "commit") {
6581                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "shortlog") .
6582                               " | " . $cgi->a({-href => href(action=>"log", hash=>$tag{'fullname'})}, "log");
6583                 } elsif ($tag{'reftype'} eq "blob") {
6584                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
6585                 }
6586                 print "</td>\n" .
6587                       "</tr>";
6588         }
6589         if (defined $extra) {
6590                 print "<tr>\n" .
6591                       "<td colspan=\"5\">$extra</td>\n" .
6592                       "</tr>\n";
6593         }
6594         print "</table>\n";
6595 }
6596
6597 sub git_heads_body {
6598         # uses global variable $project
6599         my ($headlist, $head_at, $from, $to, $extra) = @_;
6600         $from = 0 unless defined $from;
6601         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
6602
6603         print "<table class=\"heads\">\n";
6604         my $alternate = 1;
6605         for (my $i = $from; $i <= $to; $i++) {
6606                 my $entry = $headlist->[$i];
6607                 my %ref = %$entry;
6608                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
6609                 if ($alternate) {
6610                         print "<tr class=\"dark\">\n";
6611                 } else {
6612                         print "<tr class=\"light\">\n";
6613                 }
6614                 $alternate ^= 1;
6615                 print "<td><i>$ref{'age'}</i></td>\n" .
6616                       ($curr ? "<td class=\"current_head\">" : "<td>") .
6617                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
6618                                -class => "list name"},esc_html($ref{'name'})) .
6619                       "</td>\n" .
6620                       "<td class=\"link\">" .
6621                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "shortlog") . " | " .
6622                       $cgi->a({-href => href(action=>"log", hash=>$ref{'fullname'})}, "log") . " | " .
6623                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
6624                       "</td>\n" .
6625                       "</tr>";
6626         }
6627         if (defined $extra) {
6628                 print "<tr>\n" .
6629                       "<td colspan=\"3\">$extra</td>\n" .
6630                       "</tr>\n";
6631         }
6632         print "</table>\n";
6633 }
6634
6635 # Display a single remote block
6636 sub git_remote_block {
6637         my ($remote, $rdata, $limit, $head) = @_;
6638
6639         my $heads = $rdata->{'heads'};
6640         my $fetch = $rdata->{'fetch'};
6641         my $push = $rdata->{'push'};
6642
6643         my $urls_table = "<table class=\"projects_list\">\n" ;
6644
6645         if (defined $fetch) {
6646                 if ($fetch eq $push) {
6647                         $urls_table .= format_repo_url("URL", $fetch);
6648                 } else {
6649                         $urls_table .= format_repo_url("Fetch URL", $fetch);
6650                         $urls_table .= format_repo_url("Push URL", $push) if defined $push;
6651                 }
6652         } elsif (defined $push) {
6653                 $urls_table .= format_repo_url("Push URL", $push);
6654         } else {
6655                 $urls_table .= format_repo_url("", "No remote URL");
6656         }
6657
6658         $urls_table .= "</table>\n";
6659
6660         my $dots;
6661         if (defined $limit && $limit < @$heads) {
6662                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
6663         }
6664
6665         print $urls_table;
6666         git_heads_body($heads, $head, 0, $limit, $dots);
6667 }
6668
6669 # Display a list of remote names with the respective fetch and push URLs
6670 sub git_remotes_list {
6671         my ($remotedata, $limit) = @_;
6672         print "<table class=\"heads\">\n";
6673         my $alternate = 1;
6674         my @remotes = sort keys %$remotedata;
6675
6676         my $limited = $limit && $limit < @remotes;
6677
6678         $#remotes = $limit - 1 if $limited;
6679
6680         while (my $remote = shift @remotes) {
6681                 my $rdata = $remotedata->{$remote};
6682                 my $fetch = $rdata->{'fetch'};
6683                 my $push = $rdata->{'push'};
6684                 if ($alternate) {
6685                         print "<tr class=\"dark\">\n";
6686                 } else {
6687                         print "<tr class=\"light\">\n";
6688                 }
6689                 $alternate ^= 1;
6690                 print "<td>" .
6691                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
6692                                -class=> "list name"},esc_html($remote)) .
6693                       "</td>";
6694                 print "<td class=\"link\">" .
6695                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
6696                       " | " .
6697                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
6698                       "</td>";
6699
6700                 print "</tr>\n";
6701         }
6702
6703         if ($limited) {
6704                 print "<tr>\n" .
6705                       "<td colspan=\"3\">" .
6706                       $cgi->a({-href => href(action=>"remotes")}, "...") .
6707                       "</td>\n" . "</tr>\n";
6708         }
6709
6710         print "</table>";
6711 }
6712
6713 # Display remote heads grouped by remote, unless there are too many
6714 # remotes, in which case we only display the remote names
6715 sub git_remotes_body {
6716         my ($remotedata, $limit, $head) = @_;
6717         if ($limit and $limit < keys %$remotedata) {
6718                 git_remotes_list($remotedata, $limit);
6719         } else {
6720                 fill_remote_heads($remotedata);
6721                 while (my ($remote, $rdata) = each %$remotedata) {
6722                         git_print_section({-class=>"remote", -id=>$remote},
6723                                 ["remotes", $remote, $remote], sub {
6724                                         git_remote_block($remote, $rdata, $limit, $head);
6725                                 });
6726                 }
6727         }
6728 }
6729
6730 sub git_search_message {
6731         my %co = @_;
6732
6733         my $greptype;
6734         if ($searchtype eq 'commit') {
6735                 $greptype = "--grep=";
6736         } elsif ($searchtype eq 'author') {
6737                 $greptype = "--author=";
6738         } elsif ($searchtype eq 'committer') {
6739                 $greptype = "--committer=";
6740         }
6741         $greptype .= $searchtext;
6742         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
6743                                        $greptype, '--regexp-ignore-case',
6744                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
6745
6746         my $paging_nav = '';
6747         if ($page > 0) {
6748                 $paging_nav .=
6749                         $cgi->a({-href => href(-replay=>1, page=>undef)},
6750                                 "first") .
6751                         " &sdot; " .
6752                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
6753                                  -accesskey => "p", -title => "Alt-p"}, "prev");
6754         } else {
6755                 $paging_nav .= "first &sdot; prev";
6756         }
6757         my $next_link = '';
6758         if ($#commitlist >= 100) {
6759                 $next_link =
6760                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
6761                                  -accesskey => "n", -title => "Alt-n"}, "next");
6762                 $paging_nav .= " &sdot; $next_link";
6763         } else {
6764                 $paging_nav .= " &sdot; next";
6765         }
6766
6767         git_header_html();
6768
6769         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
6770         git_print_header_div('commit', esc_html($co{'title'}), $hash);
6771         if ($page == 0 && !@commitlist) {
6772                 print "<p>No match.</p>\n";
6773         } else {
6774                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
6775         }
6776
6777         git_footer_html();
6778 }
6779
6780 sub git_search_changes {
6781         my %co = @_;
6782
6783         local $/ = "\n";
6784         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
6785                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
6786                 ($search_use_regexp ? '--pickaxe-regex' : ()))
6787                         or die_error(500, "Open git-log failed");
6788
6789         git_header_html();
6790
6791         git_print_page_nav('','', $hash,$co{'tree'},$hash);
6792         git_print_header_div('commit', esc_html($co{'title'}), $hash);
6793
6794         print "<table class=\"pickaxe search\">\n";
6795         my $alternate = 1;
6796         undef %co;
6797         my @files;
6798         while (my $line = to_utf8(scalar <$fd>)) {
6799                 chomp $line;
6800                 next unless $line;
6801
6802                 my %set = parse_difftree_raw_line($line);
6803                 if (defined $set{'commit'}) {
6804                         # finish previous commit
6805                         if (%co) {
6806                                 print "</td>\n" .
6807                                       "<td class=\"link\">" .
6808                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
6809                                               "commit") .
6810                                       " | " .
6811                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
6812                                                              hash_base=>$co{'id'})},
6813                                               "tree") .
6814                                       "</td>\n" .
6815                                       "</tr>\n";
6816                         }
6817
6818                         if ($alternate) {
6819                                 print "<tr class=\"dark\">\n";
6820                         } else {
6821                                 print "<tr class=\"light\">\n";
6822                         }
6823                         $alternate ^= 1;
6824                         %co = parse_commit($set{'commit'});
6825                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
6826                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6827                               "<td><i>$author</i></td>\n" .
6828                               "<td>" .
6829                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
6830                                       -class => "list subject"},
6831                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
6832                 } elsif (defined $set{'to_id'}) {
6833                         next if ($set{'to_id'} =~ m/^0{40}$/);
6834
6835                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
6836                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
6837                                       -class => "list"},
6838                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
6839                               "<br/>\n";
6840                 }
6841         }
6842         close $fd;
6843
6844         # finish last commit (warning: repetition!)
6845         if (%co) {
6846                 print "</td>\n" .
6847                       "<td class=\"link\">" .
6848                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
6849                               "commit") .
6850                       " | " .
6851                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
6852                                              hash_base=>$co{'id'})},
6853                               "tree") .
6854                       "</td>\n" .
6855                       "</tr>\n";
6856         }
6857
6858         print "</table>\n";
6859
6860         git_footer_html();
6861 }
6862
6863 sub git_search_files {
6864         my %co = @_;
6865
6866         local $/ = "\n";
6867         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
6868                 $search_use_regexp ? ('-E', '-i') : '-F',
6869                 $searchtext, $co{'tree'})
6870                         or die_error(500, "Open git-grep failed");
6871
6872         git_header_html();
6873
6874         git_print_page_nav('','', $hash,$co{'tree'},$hash);
6875         git_print_header_div('commit', esc_html($co{'title'}), $hash);
6876
6877         print "<table class=\"grep_search\">\n";
6878         my $alternate = 1;
6879         my $matches = 0;
6880         my $lastfile = '';
6881         my $file_href;
6882         while (my $line = to_utf8(scalar <$fd>)) {
6883                 chomp $line;
6884                 my ($file, $lno, $ltext, $binary);
6885                 last if ($matches++ > 1000);
6886                 if ($line =~ /^Binary file (.+) matches$/) {
6887                         $file = $1;
6888                         $binary = 1;
6889                 } else {
6890                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
6891                         $file =~ s/^$co{'tree'}://;
6892                 }
6893                 if ($file ne $lastfile) {
6894                         $lastfile and print "</td></tr>\n";
6895                         if ($alternate++) {
6896                                 print "<tr class=\"dark\">\n";
6897                         } else {
6898                                 print "<tr class=\"light\">\n";
6899                         }
6900                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
6901                                           file_name=>$file);
6902                         print "<td class=\"list\">".
6903                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
6904                         print "</td><td>\n";
6905                         $lastfile = $file;
6906                 }
6907                 if ($binary) {
6908                         print "<div class=\"binary\">Binary file</div>\n";
6909                 } else {
6910                         $ltext = untabify($ltext);
6911                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
6912                                 $ltext = esc_html($1, -nbsp=>1);
6913                                 $ltext .= '<span class="match">';
6914                                 $ltext .= esc_html($2, -nbsp=>1);
6915                                 $ltext .= '</span>';
6916                                 $ltext .= esc_html($3, -nbsp=>1);
6917                         } else {
6918                                 $ltext = esc_html($ltext, -nbsp=>1);
6919                         }
6920                         print "<div class=\"pre\">" .
6921                                 $cgi->a({-href => $file_href.'#l'.$lno,
6922                                         -class => "linenr"}, sprintf('%4i', $lno)) .
6923                                 ' ' .  $ltext . "</div>\n";
6924                 }
6925         }
6926         if ($lastfile) {
6927                 print "</td></tr>\n";
6928                 if ($matches > 1000) {
6929                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
6930                 }
6931         } else {
6932                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
6933         }
6934         close $fd;
6935
6936         print "</table>\n";
6937
6938         git_footer_html();
6939 }
6940
6941 sub git_search_grep_body {
6942         my ($commitlist, $from, $to, $extra) = @_;
6943         $from = 0 unless defined $from;
6944         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6945
6946         print "<table class=\"commit_search\">\n";
6947         my $alternate = 1;
6948         for (my $i = $from; $i <= $to; $i++) {
6949                 my %co = %{$commitlist->[$i]};
6950                 if (!%co) {
6951                         next;
6952                 }
6953                 my $commit = $co{'id'};
6954                 if ($alternate) {
6955                         print "<tr class=\"dark\">\n";
6956                 } else {
6957                         print "<tr class=\"light\">\n";
6958                 }
6959                 $alternate ^= 1;
6960                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6961                       format_author_html('td', \%co, 15, 5) .
6962                       "<td>" .
6963                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
6964                                -class => "list subject"},
6965                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
6966                 my $comment = $co{'comment'};
6967                 foreach my $line (@$comment) {
6968                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
6969                                 my ($lead, $match, $trail) = ($1, $2, $3);
6970                                 $match = chop_str($match, 70, 5, 'center');
6971                                 my $contextlen = int((80 - length($match))/2);
6972                                 $contextlen = 30 if ($contextlen > 30);
6973                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
6974                                 $trail = chop_str($trail, $contextlen, 10, 'right');
6975
6976                                 $lead  = esc_html($lead);
6977                                 $match = esc_html($match);
6978                                 $trail = esc_html($trail);
6979
6980                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
6981                         }
6982                 }
6983                 print "</td>\n" .
6984                       "<td class=\"link\">" .
6985                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
6986                       " | " .
6987                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
6988                       " | " .
6989                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
6990                 print "</td>\n" .
6991                       "</tr>\n";
6992         }
6993         if (defined $extra) {
6994                 print "<tr>\n" .
6995                       "<td colspan=\"3\">$extra</td>\n" .
6996                       "</tr>\n";
6997         }
6998         print "</table>\n";
6999 }
7000
7001 ## ======================================================================
7002 ## ======================================================================
7003 ## actions
7004
7005 sub git_project_list_load {
7006         my $empty_list_ok = shift;
7007         my $order = $input_params{'order'};
7008         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7009                 die_error(400, "Unknown order parameter");
7010         }
7011
7012         my @list = git_get_projects_list($project_filter, $strict_export);
7013         if (!@list) {
7014                 die_error(404, "No projects found") unless $empty_list_ok;
7015         }
7016
7017         return (\@list, $order);
7018 }
7019
7020 sub git_frontpage {
7021         my ($projlist, $order);
7022
7023         if ($frontpage_no_project_list) {
7024                 $project = undef;
7025                 $project_filter = undef;
7026         } else {
7027                 ($projlist, $order) = git_project_list_load(1);
7028         }
7029         git_header_html();
7030         if (defined $home_text && -f $home_text) {
7031                 print "<div class=\"index_include\">\n";
7032                 insert_file($home_text);
7033                 print "</div>\n";
7034         }
7035         git_project_search_form($searchtext, $search_use_regexp);
7036         if ($frontpage_no_project_list) {
7037                 my $show_ctags = gitweb_check_feature('ctags');
7038                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7039                         my @projects = git_get_projects_list($project_filter, $strict_export);
7040                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7041                         @projects = fill_project_list_info(\@projects, 'ctags');
7042                         my $ctags = git_gather_all_ctags(\@projects);
7043                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7044                         print git_show_project_tagcloud($cloud, 64);
7045                 }
7046         } else {
7047                 git_project_list_body($projlist, $order);
7048         }
7049         git_footer_html();
7050 }
7051
7052 sub git_project_list {
7053         my ($projlist, $order) = git_project_list_load();
7054         git_header_html();
7055         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7056                 print "<div class=\"index_include\">\n";
7057                 insert_file($home_text);
7058                 print "</div>\n";
7059         }
7060         git_project_search_form();
7061         git_project_list_body($projlist, $order);
7062         git_footer_html();
7063 }
7064
7065 sub git_forks {
7066         my $order = $input_params{'order'};
7067         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7068                 die_error(400, "Unknown order parameter");
7069         }
7070
7071         my $filter = $project;
7072         $filter =~ s/\.git$//;
7073         my @list = git_get_projects_list($filter);
7074         if (!@list) {
7075                 die_error(404, "No forks found");
7076         }
7077
7078         git_header_html();
7079         git_print_page_nav('','');
7080         git_print_header_div('summary', "$project forks");
7081         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7082         git_footer_html();
7083 }
7084
7085 sub git_project_index {
7086         my @projects = git_get_projects_list($project_filter, $strict_export);
7087         if (!@projects) {
7088                 die_error(404, "No projects found");
7089         }
7090
7091         print $cgi->header(
7092                 -type => 'text/plain',
7093                 -charset => 'utf-8',
7094                 -content_disposition => 'inline; filename="index.aux"');
7095
7096         foreach my $pr (@projects) {
7097                 if (!exists $pr->{'owner'}) {
7098                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7099                 }
7100
7101                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7102                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7103                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7104                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7105                 $path  =~ s/ /\+/g;
7106                 $owner =~ s/ /\+/g;
7107
7108                 print "$path $owner\n";
7109         }
7110 }
7111
7112 sub git_summary {
7113         my $descr = git_get_project_description($project) || "none";
7114         my %co = parse_commit("HEAD");
7115         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7116         my $head = $co{'id'};
7117         my $remote_heads = gitweb_check_feature('remote_heads');
7118
7119         my $owner = git_get_project_owner($project);
7120
7121         my $refs = git_get_references();
7122         # These get_*_list functions return one more to allow us to see if
7123         # there are more ...
7124         my @taglist  = git_get_tags_list(16);
7125         my @headlist = git_get_heads_list(16);
7126         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7127         my @forklist;
7128         my $check_forks = gitweb_check_feature('forks');
7129
7130         if ($check_forks) {
7131                 # find forks of a project
7132                 my $filter = $project;
7133                 $filter =~ s/\.git$//;
7134                 @forklist = git_get_projects_list($filter);
7135                 # filter out forks of forks
7136                 @forklist = filter_forks_from_projects_list(\@forklist)
7137                         if (@forklist);
7138         }
7139
7140         git_header_html();
7141         git_print_page_nav('summary','', $head);
7142
7143         print "<div class=\"title\">&nbsp;</div>\n";
7144         print "<table class=\"projects_list\">\n" .
7145               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7146         if ($owner and not $omit_owner) {
7147                 print  "<tr id=\"metadata_owner\"><td>owner</td><td>" . esc_html($owner) . "</td></tr>\n";
7148         }
7149         if (defined $cd{'rfc2822'}) {
7150                 print "<tr id=\"metadata_lchange\"><td>last change</td>" .
7151                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7152         }
7153
7154         # use per project git URL list in $projectroot/$project/cloneurl
7155         # or make project git URL from git base URL and project name
7156         my $url_tag = "URL";
7157         my @url_list = git_get_project_url_list($project);
7158         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7159         foreach my $git_url (@url_list) {
7160                 next unless $git_url;
7161                 print format_repo_url($url_tag, $git_url);
7162                 $url_tag = "";
7163         }
7164
7165         # Tag cloud
7166         my $show_ctags = gitweb_check_feature('ctags');
7167         if ($show_ctags) {
7168                 my $ctags = git_get_project_ctags($project);
7169                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7170                         # without ability to add tags, don't show if there are none
7171                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7172                         print "<tr id=\"metadata_ctags\">" .
7173                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7174                         print "</td>\n<td>" unless %$ctags;
7175                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7176                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7177                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7178                               unless $show_ctags =~ /^\d+$/;
7179                         print "</td>\n<td>" if %$ctags;
7180                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7181                               "</tr>\n";
7182                 }
7183         }
7184
7185         print "</table>\n";
7186
7187         # If XSS prevention is on, we don't include README.html.
7188         # TODO: Allow a readme in some safe format.
7189         if (!$prevent_xss && -s "$projectroot/$project/README.html") {
7190                 print "<div class=\"title\">readme</div>\n" .
7191                       "<div class=\"readme\">\n";
7192                 insert_file("$projectroot/$project/README.html");
7193                 print "\n</div>\n"; # class="readme"
7194         }
7195
7196         # we need to request one more than 16 (0..15) to check if
7197         # those 16 are all
7198         my @commitlist = $head ? parse_commits($head, 17) : ();
7199         if (@commitlist) {
7200                 git_print_header_div('shortlog');
7201                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7202                                   $#commitlist <=  15 ? undef :
7203                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7204         }
7205
7206         if (@taglist) {
7207                 git_print_header_div('tags');
7208                 git_tags_body(\@taglist, 0, 15,
7209                               $#taglist <=  15 ? undef :
7210                               $cgi->a({-href => href(action=>"tags")}, "..."));
7211         }
7212
7213         if (@headlist) {
7214                 git_print_header_div('heads');
7215                 git_heads_body(\@headlist, $head, 0, 15,
7216                                $#headlist <= 15 ? undef :
7217                                $cgi->a({-href => href(action=>"heads")}, "..."));
7218         }
7219
7220         if (%remotedata) {
7221                 git_print_header_div('remotes');
7222                 git_remotes_body(\%remotedata, 15, $head);
7223         }
7224
7225         if (@forklist) {
7226                 git_print_header_div('forks');
7227                 git_project_list_body(\@forklist, 'age', 0, 15,
7228                                       $#forklist <= 15 ? undef :
7229                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7230                                       'no_header', 'forks');
7231         }
7232
7233         git_footer_html();
7234 }
7235
7236 sub git_tag {
7237         my %tag = parse_tag($hash);
7238
7239         if (! %tag) {
7240                 die_error(404, "Unknown tag object");
7241         }
7242
7243         my $head = git_get_head_hash($project);
7244         git_header_html();
7245         git_print_page_nav('','', $head,undef,$head);
7246         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
7247         print "<div class=\"title_text\">\n" .
7248               "<table class=\"object_header\">\n" .
7249               "<tr>\n" .
7250               "<td>object</td>\n" .
7251               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7252                                $tag{'object'}) . "</td>\n" .
7253               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7254                                               $tag{'type'}) . "</td>\n" .
7255               "</tr>\n";
7256         if (defined($tag{'author'})) {
7257                 git_print_authorship_rows(\%tag, 'author');
7258         }
7259         print "</table>\n\n" .
7260               "</div>\n";
7261         print "<div class=\"page_body\">";
7262         my $comment = $tag{'comment'};
7263         foreach my $line (@$comment) {
7264                 chomp $line;
7265                 print esc_html($line, -nbsp=>1) . "<br/>\n";
7266         }
7267         print "</div>\n";
7268         git_footer_html();
7269 }
7270
7271 sub git_blame_common {
7272         my $format = shift || 'porcelain';
7273         if ($format eq 'porcelain' && $input_params{'javascript'}) {
7274                 $format = 'incremental';
7275                 $action = 'blame_incremental'; # for page title etc
7276         }
7277
7278         # permissions
7279         gitweb_check_feature('blame')
7280                 or die_error(403, "Blame view not allowed");
7281
7282         # error checking
7283         die_error(400, "No file name given") unless $file_name;
7284         $hash_base ||= git_get_head_hash($project);
7285         die_error(404, "Couldn't find base commit") unless $hash_base;
7286         my %co = parse_commit($hash_base)
7287                 or die_error(404, "Commit not found");
7288         my $ftype = "blob";
7289         if (!defined $hash) {
7290                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
7291                         or die_error(404, "Error looking up file");
7292         } else {
7293                 $ftype = git_get_type($hash);
7294                 if ($ftype !~ "blob") {
7295                         die_error(400, "Object is not a blob");
7296                 }
7297         }
7298
7299         my $fd;
7300         if ($format eq 'incremental') {
7301                 # get file contents (as base)
7302                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
7303                         or die_error(500, "Open git-cat-file failed");
7304         } elsif ($format eq 'data') {
7305                 # run git-blame --incremental
7306                 defined($fd = git_cmd_pipe "blame", "--incremental",
7307                         $hash_base, "--", $file_name)
7308                         or die_error(500, "Open git-blame --incremental failed");
7309         } else {
7310                 # run git-blame --porcelain
7311                 defined($fd = git_cmd_pipe "blame", '-p',
7312                         $hash_base, '--', $file_name)
7313                         or die_error(500, "Open git-blame --porcelain failed");
7314         }
7315
7316         # incremental blame data returns early
7317         if ($format eq 'data') {
7318                 print $cgi->header(
7319                         -type=>"text/plain", -charset => "utf-8",
7320                         -status=> "200 OK");
7321                 local $| = 1; # output autoflush
7322                 while (<$fd>) {
7323                         print to_utf8($_);
7324                 }
7325                 close $fd
7326                         or print "ERROR $!\n";
7327
7328                 print 'END';
7329                 if (defined $t0 && gitweb_check_feature('timed')) {
7330                         print ' '.
7331                               tv_interval($t0, [ gettimeofday() ]).
7332                               ' '.$number_of_git_cmds;
7333                 }
7334                 print "\n";
7335
7336                 return;
7337         }
7338
7339         # page header
7340         git_header_html();
7341         my $formats_nav =
7342                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
7343                         "blob") .
7344                 " | ";
7345         if ($format eq 'incremental') {
7346                 $formats_nav .=
7347                         $cgi->a({-href => href(action=>"blame", javascript=>0, -replay=>1)},
7348                                 "blame") . " (non-incremental)";
7349         } else {
7350                 $formats_nav .=
7351                         $cgi->a({-href => href(action=>"blame_incremental", -replay=>1)},
7352                                 "blame") . " (incremental)";
7353         }
7354         $formats_nav .=
7355                 " | " .
7356                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7357                         "history") .
7358                 " | " .
7359                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
7360                         "HEAD");
7361         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7362         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7363         git_print_page_path($file_name, $ftype, $hash_base);
7364
7365         # page body
7366         if ($format eq 'incremental') {
7367                 print "<noscript>\n<div class=\"error\"><center><b>\n".
7368                       "This page requires JavaScript to run.\n Use ".
7369                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
7370                               'this page').
7371                       " instead.\n".
7372                       "</b></center></div>\n</noscript>\n";
7373
7374                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
7375         }
7376
7377         print qq!<div class="page_body">\n!;
7378         print qq!<div id="progress_info">... / ...</div>\n!
7379                 if ($format eq 'incremental');
7380         print qq!<table id="blame_table" class="blame" width="100%">\n!.
7381               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
7382               qq!<thead>\n!.
7383               qq!<tr><th>Commit</th><th>Line</th><th>Data</th></tr>\n!.
7384               qq!</thead>\n!.
7385               qq!<tbody>\n!;
7386
7387         my @rev_color = qw(light dark);
7388         my $num_colors = scalar(@rev_color);
7389         my $current_color = 0;
7390
7391         if ($format eq 'incremental') {
7392                 my $color_class = $rev_color[$current_color];
7393
7394                 #contents of a file
7395                 my $linenr = 0;
7396         LINE:
7397                 while (my $line = to_utf8(scalar <$fd>)) {
7398                         chomp $line;
7399                         $linenr++;
7400
7401                         print qq!<tr id="l$linenr" class="$color_class">!.
7402                               qq!<td class="sha1"><a href=""> </a></td>!.
7403                               qq!<td class="linenr">!.
7404                               qq!<a class="linenr" href="">$linenr</a></td>!;
7405                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
7406                         print qq!</tr>\n!;
7407                 }
7408
7409         } else { # porcelain, i.e. ordinary blame
7410                 my %metainfo = (); # saves information about commits
7411
7412                 # blame data
7413         LINE:
7414                 while (my $line = to_utf8(scalar <$fd>)) {
7415                         chomp $line;
7416                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
7417                         # no <lines in group> for subsequent lines in group of lines
7418                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
7419                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
7420                         if (!exists $metainfo{$full_rev}) {
7421                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
7422                         }
7423                         my $meta = $metainfo{$full_rev};
7424                         my $data;
7425                         while ($data = to_utf8(scalar <$fd>)) {
7426                                 chomp $data;
7427                                 last if ($data =~ s/^\t//); # contents of line
7428                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
7429                                         $meta->{$1} = $2 unless exists $meta->{$1};
7430                                 }
7431                                 if ($data =~ /^previous /) {
7432                                         $meta->{'nprevious'}++;
7433                                 }
7434                         }
7435                         my $short_rev = substr($full_rev, 0, 8);
7436                         my $author = $meta->{'author'};
7437                         my %date =
7438                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
7439                         my $date = $date{'iso-tz'};
7440                         if ($group_size) {
7441                                 $current_color = ($current_color + 1) % $num_colors;
7442                         }
7443                         my $tr_class = $rev_color[$current_color];
7444                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
7445                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
7446                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
7447                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
7448                         if ($group_size) {
7449                                 print "<td class=\"sha1\"";
7450                                 print " title=\"". esc_html($author) . ", $date\"";
7451                                 print " rowspan=\"$group_size\"" if ($group_size > 1);
7452                                 print ">";
7453                                 print $cgi->a({-href => href(action=>"commit",
7454                                                              hash=>$full_rev,
7455                                                              file_name=>$file_name)},
7456                                               esc_html($short_rev));
7457                                 if ($group_size >= 2) {
7458                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
7459                                         if (@author_initials) {
7460                                                 print "<br />" .
7461                                                       esc_html(join('', @author_initials));
7462                                                 #           or join('.', ...)
7463                                         }
7464                                 }
7465                                 print "</td>\n";
7466                         }
7467                         # 'previous' <sha1 of parent commit> <filename at commit>
7468                         if (exists $meta->{'previous'} &&
7469                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
7470                                 $meta->{'parent'} = $1;
7471                                 $meta->{'file_parent'} = unquote($2);
7472                         }
7473                         my $linenr_commit =
7474                                 exists($meta->{'parent'}) ?
7475                                 $meta->{'parent'} : $full_rev;
7476                         my $linenr_filename =
7477                                 exists($meta->{'file_parent'}) ?
7478                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
7479                         my $blamed = href(action => 'blame',
7480                                           file_name => $linenr_filename,
7481                                           hash_base => $linenr_commit);
7482                         print "<td class=\"linenr\">";
7483                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
7484                                         -class => "linenr" },
7485                                       esc_html($lineno));
7486                         print "</td>";
7487                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
7488                         print "</tr>\n";
7489                 } # end while
7490
7491         }
7492
7493         # footer
7494         print "</tbody>\n".
7495               "</table>\n"; # class="blame"
7496         print "</div>\n";   # class="blame_body"
7497         close $fd
7498                 or print "Reading blob failed\n";
7499
7500         git_footer_html();
7501 }
7502
7503 sub git_blame {
7504         git_blame_common();
7505 }
7506
7507 sub git_blame_incremental {
7508         git_blame_common('incremental');
7509 }
7510
7511 sub git_blame_data {
7512         git_blame_common('data');
7513 }
7514
7515 sub git_tags {
7516         my $head = git_get_head_hash($project);
7517         git_header_html();
7518         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
7519         git_print_header_div('summary', $project);
7520
7521         my @tagslist = git_get_tags_list();
7522         if (@tagslist) {
7523                 git_tags_body(\@tagslist);
7524         }
7525         git_footer_html();
7526 }
7527
7528 sub git_heads {
7529         my $head = git_get_head_hash($project);
7530         git_header_html();
7531         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
7532         git_print_header_div('summary', $project);
7533
7534         my @headslist = git_get_heads_list();
7535         if (@headslist) {
7536                 git_heads_body(\@headslist, $head);
7537         }
7538         git_footer_html();
7539 }
7540
7541 # used both for single remote view and for list of all the remotes
7542 sub git_remotes {
7543         gitweb_check_feature('remote_heads')
7544                 or die_error(403, "Remote heads view is disabled");
7545
7546         my $head = git_get_head_hash($project);
7547         my $remote = $input_params{'hash'};
7548
7549         my $remotedata = git_get_remotes_list($remote);
7550         die_error(500, "Unable to get remote information") unless defined $remotedata;
7551
7552         unless (%$remotedata) {
7553                 die_error(404, defined $remote ?
7554                         "Remote $remote not found" :
7555                         "No remotes found");
7556         }
7557
7558         git_header_html(undef, undef, -action_extra => $remote);
7559         git_print_page_nav('', '',  $head, undef, $head,
7560                 format_ref_views($remote ? '' : 'remotes'));
7561
7562         fill_remote_heads($remotedata);
7563         if (defined $remote) {
7564                 git_print_header_div('remotes', "$remote remote for $project");
7565                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
7566         } else {
7567                 git_print_header_div('summary', "$project remotes");
7568                 git_remotes_body($remotedata, undef, $head);
7569         }
7570
7571         git_footer_html();
7572 }
7573
7574 sub git_blob_plain {
7575         my $type = shift;
7576         my $expires;
7577
7578         if (!defined $hash) {
7579                 if (defined $file_name) {
7580                         my $base = $hash_base || git_get_head_hash($project);
7581                         $hash = git_get_hash_by_path($base, $file_name, "blob")
7582                                 or die_error(404, "Cannot find file");
7583                 } else {
7584                         die_error(400, "No file name defined");
7585                 }
7586         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7587                 # blobs defined by non-textual hash id's can be cached
7588                 $expires = "+1d";
7589         }
7590
7591         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
7592                 or die_error(500, "Open git-cat-file blob '$hash' failed");
7593         binmode($fd);
7594
7595         # content-type (can include charset)
7596         $type = blob_contenttype($fd, $file_name, $type);
7597
7598         # "save as" filename, even when no $file_name is given
7599         my $save_as = "$hash";
7600         if (defined $file_name) {
7601                 $save_as = $file_name;
7602         } elsif ($type =~ m/^text\//) {
7603                 $save_as .= '.txt';
7604         }
7605
7606         # With XSS prevention on, blobs of all types except a few known safe
7607         # ones are served with "Content-Disposition: attachment" to make sure
7608         # they don't run in our security domain.  For certain image types,
7609         # blob view writes an <img> tag referring to blob_plain view, and we
7610         # want to be sure not to break that by serving the image as an
7611         # attachment (though Firefox 3 doesn't seem to care).
7612         my $sandbox = $prevent_xss &&
7613                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
7614
7615         # serve text/* as text/plain
7616         if ($prevent_xss &&
7617             ($type =~ m!^text/[a-z]+\b(.*)$! ||
7618              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
7619                 my $rest = $1;
7620                 $rest = defined $rest ? $rest : '';
7621                 $type = "text/plain$rest";
7622         }
7623
7624         print $cgi->header(
7625                 -type => $type,
7626                 -expires => $expires,
7627                 -content_disposition =>
7628                         ($sandbox ? 'attachment' : 'inline')
7629                         . '; filename="' . $save_as . '"');
7630         binmode STDOUT, ':raw';
7631         $fcgi_raw_mode = 1;
7632         my $buf;
7633         while (read($fd, $buf, 32768)) {
7634                 print $buf;
7635         }
7636         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
7637         $fcgi_raw_mode = 0;
7638         close $fd;
7639 }
7640
7641 sub git_blob {
7642         my $expires;
7643
7644         if (!defined $hash) {
7645                 if (defined $file_name) {
7646                         my $base = $hash_base || git_get_head_hash($project);
7647                         $hash = git_get_hash_by_path($base, $file_name, "blob")
7648                                 or die_error(404, "Cannot find file");
7649                 } else {
7650                         die_error(400, "No file name defined");
7651                 }
7652         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7653                 # blobs defined by non-textual hash id's can be cached
7654                 $expires = "+1d";
7655         }
7656
7657         my $have_blame = gitweb_check_feature('blame');
7658         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
7659                 or die_error(500, "Couldn't cat $file_name, $hash");
7660         my $mimetype = blob_mimetype($fd, $file_name);
7661         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
7662         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
7663                 close $fd;
7664                 return git_blob_plain($mimetype);
7665         }
7666         # we can have blame only for text/* mimetype
7667         $have_blame &&= ($mimetype =~ m!^text/!);
7668
7669         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
7670         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
7671         my $highlight_mode_active;
7672         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
7673
7674         git_header_html(undef, $expires);
7675         my $formats_nav = '';
7676         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7677                 if (defined $file_name) {
7678                         if ($have_blame) {
7679                                 $formats_nav .=
7680                                         $cgi->a({-href => href(action=>"blame", -replay=>1)},
7681                                                 "blame") .
7682                                         " | ";
7683                         }
7684                         $formats_nav .=
7685                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7686                                         "history") .
7687                                 " | " .
7688                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
7689                                         "raw") .
7690                                 " | " .
7691                                 $cgi->a({-href => href(action=>"blob",
7692                                                        hash_base=>"HEAD", file_name=>$file_name)},
7693                                         "HEAD");
7694                 } else {
7695                         $formats_nav .=
7696                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
7697                                         "raw");
7698                 }
7699                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7700                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7701         } else {
7702                 print "<div class=\"page_nav\">\n" .
7703                       "<br/><br/></div>\n" .
7704                       "<div class=\"title\">".esc_html($hash)."</div>\n";
7705         }
7706         git_print_page_path($file_name, "blob", $hash_base);
7707         print "<div class=\"page_body\">\n";
7708         if ($mimetype =~ m!^image/!) {
7709                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
7710                 if ($file_name) {
7711                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
7712                 }
7713                 print qq! src="! .
7714                       href(action=>"blob_plain", hash=>$hash,
7715                            hash_base=>$hash_base, file_name=>$file_name) .
7716                       qq!" />\n!;
7717         } else {
7718                 my $nr;
7719                 while (my $line = to_utf8(scalar <$fd>)) {
7720                         chomp $line;
7721                         $nr++;
7722                         $line = untabify($line);
7723                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
7724                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
7725                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
7726                 }
7727         }
7728         close $fd
7729                 or print "Reading blob failed.\n";
7730         print "</div>";
7731         git_footer_html();
7732 }
7733
7734 sub git_tree {
7735         if (!defined $hash_base) {
7736                 $hash_base = "HEAD";
7737         }
7738         if (!defined $hash) {
7739                 if (defined $file_name) {
7740                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
7741                 } else {
7742                         $hash = $hash_base;
7743                 }
7744         }
7745         die_error(404, "No such tree") unless defined($hash);
7746
7747         my $show_sizes = gitweb_check_feature('show-sizes');
7748         my $have_blame = gitweb_check_feature('blame');
7749
7750         my @entries = ();
7751         {
7752                 local $/ = "\0";
7753                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
7754                         ($show_sizes ? '-l' : ()), @extra_options, $hash)
7755                         or die_error(500, "Open git-ls-tree failed");
7756                 @entries = map { chomp; to_utf8($_) } <$fd>;
7757                 close $fd
7758                         or die_error(404, "Reading tree failed");
7759         }
7760
7761         my $refs = git_get_references();
7762         my $ref = format_ref_marker($refs, $hash_base);
7763         git_header_html();
7764         my $basedir = '';
7765         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7766                 my @views_nav = ();
7767                 if (defined $file_name) {
7768                         push @views_nav,
7769                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7770                                         "history"),
7771                                 $cgi->a({-href => href(action=>"tree",
7772                                                        hash_base=>"HEAD", file_name=>$file_name)},
7773                                         "HEAD"),
7774                 }
7775                 my $snapshot_links = format_snapshot_links($hash);
7776                 if (defined $snapshot_links) {
7777                         # FIXME: Should be available when we have no hash base as well.
7778                         push @views_nav, $snapshot_links;
7779                 }
7780                 git_print_page_nav('tree','', $hash_base, undef, undef,
7781                                    join(' | ', @views_nav));
7782                 git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash_base);
7783         } else {
7784                 undef $hash_base;
7785                 print "<div class=\"page_nav\">\n";
7786                 print "<br/><br/></div>\n";
7787                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
7788         }
7789         if (defined $file_name) {
7790                 $basedir = $file_name;
7791                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
7792                         $basedir .= '/';
7793                 }
7794                 git_print_page_path($file_name, 'tree', $hash_base);
7795         }
7796         print "<div class=\"page_body\">\n";
7797         print "<table class=\"tree\">\n";
7798         my $alternate = 1;
7799         # '..' (top directory) link if possible
7800         if (defined $hash_base &&
7801             defined $file_name && $file_name =~ m![^/]+$!) {
7802                 if ($alternate) {
7803                         print "<tr class=\"dark\">\n";
7804                 } else {
7805                         print "<tr class=\"light\">\n";
7806                 }
7807                 $alternate ^= 1;
7808
7809                 my $up = $file_name;
7810                 $up =~ s!/?[^/]+$!!;
7811                 undef $up unless $up;
7812                 # based on git_print_tree_entry
7813                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
7814                 print '<td class="size">&nbsp;</td>'."\n" if $show_sizes;
7815                 print '<td class="list">';
7816                 print $cgi->a({-href => href(action=>"tree",
7817                                              hash_base=>$hash_base,
7818                                              file_name=>$up)},
7819                               "..");
7820                 print "</td>\n";
7821                 print "<td class=\"link\"></td>\n";
7822
7823                 print "</tr>\n";
7824         }
7825         foreach my $line (@entries) {
7826                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
7827
7828                 if ($alternate) {
7829                         print "<tr class=\"dark\">\n";
7830                 } else {
7831                         print "<tr class=\"light\">\n";
7832                 }
7833                 $alternate ^= 1;
7834
7835                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
7836
7837                 print "</tr>\n";
7838         }
7839         print "</table>\n" .
7840               "</div>";
7841         git_footer_html();
7842 }
7843
7844 sub sanitize_for_filename {
7845     my $name = shift;
7846
7847     $name =~ s!/!-!g;
7848     $name =~ s/[^[:alnum:]_.-]//g;
7849
7850     return $name;
7851 }
7852
7853 sub snapshot_name {
7854         my ($project, $hash) = @_;
7855
7856         # path/to/project.git  -> project
7857         # path/to/project/.git -> project
7858         my $name = to_utf8($project);
7859         $name =~ s,([^/])/*\.git$,$1,;
7860         $name = sanitize_for_filename(basename($name));
7861
7862         my $ver = $hash;
7863         if ($hash =~ /^[0-9a-fA-F]+$/) {
7864                 # shorten SHA-1 hash
7865                 my $full_hash = git_get_full_hash($project, $hash);
7866                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
7867                         $ver = git_get_short_hash($project, $hash);
7868                 }
7869         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
7870                 # tags don't need shortened SHA-1 hash
7871                 $ver = $1;
7872         } else {
7873                 # branches and other need shortened SHA-1 hash
7874                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
7875                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
7876                         my $ref_dir = (defined $1) ? $1 : '';
7877                         $ver = $2;
7878
7879                         $ref_dir = sanitize_for_filename($ref_dir);
7880                         # for refs neither in heads nor remotes we want to
7881                         # add a ref dir to archive name
7882                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
7883                                 $ver = $ref_dir . '-' . $ver;
7884                         }
7885                 }
7886                 $ver .= '-' . git_get_short_hash($project, $hash);
7887         }
7888         # special case of sanitization for filename - we change
7889         # slashes to dots instead of dashes
7890         # in case of hierarchical branch names
7891         $ver =~ s!/!.!g;
7892         $ver =~ s/[^[:alnum:]_.-]//g;
7893
7894         # name = project-version_string
7895         $name = "$name-$ver";
7896
7897         return wantarray ? ($name, $name) : $name;
7898 }
7899
7900 sub exit_if_unmodified_since {
7901         my ($latest_epoch) = @_;
7902         our $cgi;
7903
7904         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
7905         if (defined $if_modified) {
7906                 my $since;
7907                 if (eval { require HTTP::Date; 1; }) {
7908                         $since = HTTP::Date::str2time($if_modified);
7909                 } elsif (eval { require Time::ParseDate; 1; }) {
7910                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
7911                 }
7912                 if (defined $since && $latest_epoch <= $since) {
7913                         my %latest_date = parse_date($latest_epoch);
7914                         print $cgi->header(
7915                                 -last_modified => $latest_date{'rfc2822'},
7916                                 -status => '304 Not Modified');
7917                         goto DONE_GITWEB;
7918                 }
7919         }
7920 }
7921
7922 sub git_snapshot {
7923         my $format = $input_params{'snapshot_format'};
7924         if (!@snapshot_fmts) {
7925                 die_error(403, "Snapshots not allowed");
7926         }
7927         # default to first supported snapshot format
7928         $format ||= $snapshot_fmts[0];
7929         if ($format !~ m/^[a-z0-9]+$/) {
7930                 die_error(400, "Invalid snapshot format parameter");
7931         } elsif (!exists($known_snapshot_formats{$format})) {
7932                 die_error(400, "Unknown snapshot format");
7933         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
7934                 die_error(403, "Snapshot format not allowed");
7935         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
7936                 die_error(403, "Unsupported snapshot format");
7937         }
7938
7939         my $type = git_get_type("$hash^{}");
7940         if (!$type) {
7941                 die_error(404, 'Object does not exist');
7942         }  elsif ($type eq 'blob') {
7943                 die_error(400, 'Object is not a tree-ish');
7944         }
7945
7946         my ($name, $prefix) = snapshot_name($project, $hash);
7947         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
7948
7949         my %co = parse_commit($hash);
7950         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
7951
7952         my @cmd = (
7953                 git_cmd(), 'archive',
7954                 "--format=$known_snapshot_formats{$format}{'format'}",
7955                 "--prefix=$prefix/", $hash);
7956         if (exists $known_snapshot_formats{$format}{'compressor'}) {
7957                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
7958                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
7959         }
7960
7961         $filename =~ s/(["\\])/\\$1/g;
7962         my %latest_date;
7963         if (%co) {
7964                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
7965         }
7966
7967         print $cgi->header(
7968                 -type => $known_snapshot_formats{$format}{'type'},
7969                 -content_disposition => 'inline; filename="' . $filename . '"',
7970                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
7971                 -status => '200 OK');
7972
7973         defined(my $fd = cmd_pipe @cmd)
7974                 or die_error(500, "Execute git-archive failed");
7975         binmode($fd);
7976         binmode STDOUT, ':raw';
7977         $fcgi_raw_mode = 1;
7978         my $buf;
7979         while (read($fd, $buf, 32768)) {
7980                 print $buf;
7981         }
7982         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
7983         $fcgi_raw_mode = 0;
7984         close $fd;
7985 }
7986
7987 sub git_log_generic {
7988         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
7989
7990         my $head = git_get_head_hash($project);
7991         if (!defined $base) {
7992                 $base = $head;
7993         }
7994         if (!defined $page) {
7995                 $page = 0;
7996         }
7997         my $refs = git_get_references();
7998
7999         my $commit_hash = $base;
8000         if (defined $parent) {
8001                 $commit_hash = "$parent..$base";
8002         }
8003         my @commitlist =
8004                 parse_commits($commit_hash, 101, (100 * $page),
8005                               defined $file_name ? ($file_name, "--full-history") : ());
8006
8007         my $ftype;
8008         if (!defined $file_hash && defined $file_name) {
8009                 # some commits could have deleted file in question,
8010                 # and not have it in tree, but one of them has to have it
8011                 for (my $i = 0; $i < @commitlist; $i++) {
8012                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8013                         last if defined $file_hash;
8014                 }
8015         }
8016         if (defined $file_hash) {
8017                 $ftype = git_get_type($file_hash);
8018         }
8019         if (defined $file_name && !defined $ftype) {
8020                 die_error(500, "Unknown type of object");
8021         }
8022         my %co;
8023         if (defined $file_name) {
8024                 %co = parse_commit($base)
8025                         or die_error(404, "Unknown commit object");
8026         }
8027
8028
8029         my $paging_nav = format_paging_nav($fmt_name, $page, $#commitlist >= 100);
8030         my $next_link = '';
8031         if ($#commitlist >= 100) {
8032                 $next_link =
8033                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8034                                  -accesskey => "n", -title => "Alt-n"}, "next");
8035         }
8036         my $patch_max = gitweb_get_feature('patches');
8037         if ($patch_max && !defined $file_name) {
8038                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8039                         $paging_nav .= " &sdot; " .
8040                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
8041                                         "patches");
8042                 }
8043         }
8044
8045         git_header_html();
8046         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8047         if (defined $file_name) {
8048                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8049         } else {
8050                 git_print_header_div('summary', $project)
8051         }
8052         git_print_page_path($file_name, $ftype, $hash_base)
8053                 if (defined $file_name);
8054
8055         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8056                      $file_name, $file_hash, $ftype);
8057
8058         git_footer_html();
8059 }
8060
8061 sub git_log {
8062         git_log_generic('log', \&git_log_body,
8063                         $hash, $hash_parent);
8064 }
8065
8066 sub git_commit {
8067         $hash ||= $hash_base || "HEAD";
8068         my %co = parse_commit($hash)
8069             or die_error(404, "Unknown commit object");
8070
8071         my $parent  = $co{'parent'};
8072         my $parents = $co{'parents'}; # listref
8073
8074         # we need to prepare $formats_nav before any parameter munging
8075         my $formats_nav;
8076         if (!defined $parent) {
8077                 # --root commitdiff
8078                 $formats_nav .= '(initial)';
8079         } elsif (@$parents == 1) {
8080                 # single parent commit
8081                 $formats_nav .=
8082                         '(parent: ' .
8083                         $cgi->a({-href => href(action=>"commit",
8084                                                hash=>$parent)},
8085                                 esc_html(substr($parent, 0, 7))) .
8086                         ')';
8087         } else {
8088                 # merge commit
8089                 $formats_nav .=
8090                         '(merge: ' .
8091                         join(' ', map {
8092                                 $cgi->a({-href => href(action=>"commit",
8093                                                        hash=>$_)},
8094                                         esc_html(substr($_, 0, 7)));
8095                         } @$parents ) .
8096                         ')';
8097         }
8098         if (gitweb_check_feature('patches') && @$parents <= 1) {
8099                 $formats_nav .= " | " .
8100                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8101                                 "patch");
8102         }
8103
8104         if (!defined $parent) {
8105                 $parent = "--root";
8106         }
8107         my @difftree;
8108         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8109                 @diff_opts,
8110                 (@$parents <= 1 ? $parent : '-c'),
8111                 $hash, "--")
8112                 or die_error(500, "Open git-diff-tree failed");
8113         @difftree = map { chomp; to_utf8($_) } <$fd>;
8114         close $fd or die_error(404, "Reading git-diff-tree failed");
8115
8116         # non-textual hash id's can be cached
8117         my $expires;
8118         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8119                 $expires = "+1d";
8120         }
8121         my $refs = git_get_references();
8122         my $ref = format_ref_marker($refs, $co{'id'});
8123
8124         git_header_html(undef, $expires);
8125         git_print_page_nav('commit', '',
8126                            $hash, $co{'tree'}, $hash,
8127                            $formats_nav);
8128
8129         if (defined $co{'parent'}) {
8130                 git_print_header_div('commitdiff', esc_html($co{'title'}) . $ref, $hash);
8131         } else {
8132                 git_print_header_div('tree', esc_html($co{'title'}) . $ref, $co{'tree'}, $hash);
8133         }
8134         print "<div class=\"title_text\">\n" .
8135               "<table class=\"object_header\">\n";
8136         git_print_authorship_rows(\%co);
8137         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8138         print "<tr>" .
8139               "<td>tree</td>" .
8140               "<td class=\"sha1\">" .
8141               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8142                        class => "list"}, $co{'tree'}) .
8143               "</td>" .
8144               "<td class=\"link\">" .
8145               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8146                       "tree");
8147         my $snapshot_links = format_snapshot_links($hash);
8148         if (defined $snapshot_links) {
8149                 print " | " . $snapshot_links;
8150         }
8151         print "</td>" .
8152               "</tr>\n";
8153
8154         foreach my $par (@$parents) {
8155                 print "<tr>" .
8156                       "<td>parent</td>" .
8157                       "<td class=\"sha1\">" .
8158                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8159                                class => "list"}, $par) .
8160                       "</td>" .
8161                       "<td class=\"link\">" .
8162                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8163                       " | " .
8164                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8165                       "</td>" .
8166                       "</tr>\n";
8167         }
8168         print "</table>".
8169               "</div>\n";
8170
8171         print "<div class=\"page_body\">\n";
8172         git_print_log($co{'comment'});
8173         print "</div>\n";
8174
8175         git_difftree_body(\@difftree, $hash, @$parents);
8176
8177         git_footer_html();
8178 }
8179
8180 sub git_object {
8181         # object is defined by:
8182         # - hash or hash_base alone
8183         # - hash_base and file_name
8184         my $type;
8185
8186         # - hash or hash_base alone
8187         if ($hash || ($hash_base && !defined $file_name)) {
8188                 my $object_id = $hash || $hash_base;
8189
8190                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8191                         or die_error(404, "Object does not exist");
8192                 $type = <$fd>;
8193                 chomp $type;
8194                 close $fd
8195                         or die_error(404, "Object does not exist");
8196
8197         # - hash_base and file_name
8198         } elsif ($hash_base && defined $file_name) {
8199                 $file_name =~ s,/+$,,;
8200
8201                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
8202                         or die_error(404, "Base object does not exist");
8203
8204                 # here errors should not happen
8205                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
8206                         or die_error(500, "Open git-ls-tree failed");
8207                 my $line = to_utf8(scalar <$fd>);
8208                 close $fd;
8209
8210                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
8211                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
8212                         die_error(404, "File or directory for given base does not exist");
8213                 }
8214                 $type = $2;
8215                 $hash = $3;
8216         } else {
8217                 die_error(400, "Not enough information to find object");
8218         }
8219
8220         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
8221                                           hash=>$hash, hash_base=>$hash_base,
8222                                           file_name=>$file_name),
8223                              -status => '302 Found');
8224 }
8225
8226 sub git_blobdiff {
8227         my $format = shift || 'html';
8228         my $diff_style = $input_params{'diff_style'} || 'inline';
8229
8230         my $fd;
8231         my @difftree;
8232         my %diffinfo;
8233         my $expires;
8234
8235         # preparing $fd and %diffinfo for git_patchset_body
8236         # new style URI
8237         if (defined $hash_base && defined $hash_parent_base) {
8238                 if (defined $file_name) {
8239                         # read raw output
8240                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8241                                 $hash_parent_base, $hash_base,
8242                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
8243                                 or die_error(500, "Open git-diff-tree failed");
8244                         @difftree = map { chomp; to_utf8($_) } <$fd>;
8245                         close $fd
8246                                 or die_error(404, "Reading git-diff-tree failed");
8247                         @difftree
8248                                 or die_error(404, "Blob diff not found");
8249
8250                 } elsif (defined $hash &&
8251                          $hash =~ /[0-9a-fA-F]{40}/) {
8252                         # try to find filename from $hash
8253
8254                         # read filtered raw output
8255                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8256                                 $hash_parent_base, $hash_base, "--")
8257                                 or die_error(500, "Open git-diff-tree failed");
8258                         @difftree =
8259                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
8260                                 # $hash == to_id
8261                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
8262                                 map { chomp; to_utf8($_) } <$fd>;
8263                         close $fd
8264                                 or die_error(404, "Reading git-diff-tree failed");
8265                         @difftree
8266                                 or die_error(404, "Blob diff not found");
8267
8268                 } else {
8269                         die_error(400, "Missing one of the blob diff parameters");
8270                 }
8271
8272                 if (@difftree > 1) {
8273                         die_error(400, "Ambiguous blob diff specification");
8274                 }
8275
8276                 %diffinfo = parse_difftree_raw_line($difftree[0]);
8277                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
8278                 $file_name   ||= $diffinfo{'to_file'};
8279
8280                 $hash_parent ||= $diffinfo{'from_id'};
8281                 $hash        ||= $diffinfo{'to_id'};
8282
8283                 # non-textual hash id's can be cached
8284                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
8285                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
8286                         $expires = '+1d';
8287                 }
8288
8289                 # open patch output
8290                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8291                         '-p', ($format eq 'html' ? "--full-index" : ()),
8292                         $hash_parent_base, $hash_base,
8293                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
8294                         or die_error(500, "Open git-diff-tree failed");
8295         }
8296
8297         # old/legacy style URI -- not generated anymore since 1.4.3.
8298         if (!%diffinfo) {
8299                 die_error('404 Not Found', "Missing one of the blob diff parameters")
8300         }
8301
8302         # header
8303         if ($format eq 'html') {
8304                 my $formats_nav =
8305                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
8306                                 "raw");
8307                 $formats_nav .= diff_style_nav($diff_style);
8308                 git_header_html(undef, $expires);
8309                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8310                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8311                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8312                 } else {
8313                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
8314                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
8315                 }
8316                 if (defined $file_name) {
8317                         git_print_page_path($file_name, "blob", $hash_base);
8318                 } else {
8319                         print "<div class=\"page_path\"></div>\n";
8320                 }
8321
8322         } elsif ($format eq 'plain') {
8323                 print $cgi->header(
8324                         -type => 'text/plain',
8325                         -charset => 'utf-8',
8326                         -expires => $expires,
8327                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
8328
8329                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8330
8331         } else {
8332                 die_error(400, "Unknown blobdiff format");
8333         }
8334
8335         # patch
8336         if ($format eq 'html') {
8337                 print "<div class=\"page_body\">\n";
8338
8339                 git_patchset_body($fd, $diff_style,
8340                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
8341                 close $fd;
8342
8343                 print "</div>\n"; # class="page_body"
8344                 git_footer_html();
8345
8346         } else {
8347                 while (my $line = to_utf8(scalar <$fd>)) {
8348                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
8349                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
8350
8351                         print $line;
8352
8353                         last if $line =~ m!^\+\+\+!;
8354                 }
8355                 while (<$fd>) {
8356                         print to_utf8($_);
8357                 }
8358                 close $fd;
8359         }
8360 }
8361
8362 sub git_blobdiff_plain {
8363         git_blobdiff('plain');
8364 }
8365
8366 # assumes that it is added as later part of already existing navigation,
8367 # so it returns "| foo | bar" rather than just "foo | bar"
8368 sub diff_style_nav {
8369         my ($diff_style, $is_combined) = @_;
8370         $diff_style ||= 'inline';
8371
8372         return "" if ($is_combined);
8373
8374         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
8375         my %styles = @styles;
8376         @styles =
8377                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
8378
8379         return join '',
8380                 map { " | ".$_ }
8381                 map {
8382                         $_ eq $diff_style ? $styles{$_} :
8383                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
8384                 } @styles;
8385 }
8386
8387 sub git_commitdiff {
8388         my %params = @_;
8389         my $format = $params{-format} || 'html';
8390         my $diff_style = $input_params{'diff_style'} || 'inline';
8391
8392         my ($patch_max) = gitweb_get_feature('patches');
8393         if ($format eq 'patch') {
8394                 die_error(403, "Patch view not allowed") unless $patch_max;
8395         }
8396
8397         $hash ||= $hash_base || "HEAD";
8398         my %co = parse_commit($hash)
8399             or die_error(404, "Unknown commit object");
8400
8401         # choose format for commitdiff for merge
8402         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
8403                 $hash_parent = '--cc';
8404         }
8405         # we need to prepare $formats_nav before almost any parameter munging
8406         my $formats_nav;
8407         if ($format eq 'html') {
8408                 $formats_nav =
8409                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
8410                                 "raw");
8411                 if ($patch_max && @{$co{'parents'}} <= 1) {
8412                         $formats_nav .= " | " .
8413                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
8414                                         "patch");
8415                 }
8416                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
8417
8418                 if (defined $hash_parent &&
8419                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
8420                         # commitdiff with two commits given
8421                         my $hash_parent_short = $hash_parent;
8422                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
8423                                 $hash_parent_short = substr($hash_parent, 0, 7);
8424                         }
8425                         $formats_nav .=
8426                                 ' (from';
8427                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
8428                                 if ($co{'parents'}[$i] eq $hash_parent) {
8429                                         $formats_nav .= ' parent ' . ($i+1);
8430                                         last;
8431                                 }
8432                         }
8433                         $formats_nav .= ': ' .
8434                                 $cgi->a({-href => href(-replay=>1,
8435                                                        hash=>$hash_parent, hash_base=>undef)},
8436                                         esc_html($hash_parent_short)) .
8437                                 ')';
8438                 } elsif (!$co{'parent'}) {
8439                         # --root commitdiff
8440                         $formats_nav .= ' (initial)';
8441                 } elsif (scalar @{$co{'parents'}} == 1) {
8442                         # single parent commit
8443                         $formats_nav .=
8444                                 ' (parent: ' .
8445                                 $cgi->a({-href => href(-replay=>1,
8446                                                        hash=>$co{'parent'}, hash_base=>undef)},
8447                                         esc_html(substr($co{'parent'}, 0, 7))) .
8448                                 ')';
8449                 } else {
8450                         # merge commit
8451                         if ($hash_parent eq '--cc') {
8452                                 $formats_nav .= ' | ' .
8453                                         $cgi->a({-href => href(-replay=>1,
8454                                                                hash=>$hash, hash_parent=>'-c')},
8455                                                 'combined');
8456                         } else { # $hash_parent eq '-c'
8457                                 $formats_nav .= ' | ' .
8458                                         $cgi->a({-href => href(-replay=>1,
8459                                                                hash=>$hash, hash_parent=>'--cc')},
8460                                                 'compact');
8461                         }
8462                         $formats_nav .=
8463                                 ' (merge: ' .
8464                                 join(' ', map {
8465                                         $cgi->a({-href => href(-replay=>1,
8466                                                                hash=>$_, hash_base=>undef)},
8467                                                 esc_html(substr($_, 0, 7)));
8468                                 } @{$co{'parents'}} ) .
8469                                 ')';
8470                 }
8471         }
8472
8473         my $hash_parent_param = $hash_parent;
8474         if (!defined $hash_parent_param) {
8475                 # --cc for multiple parents, --root for parentless
8476                 $hash_parent_param =
8477                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
8478         }
8479
8480         # read commitdiff
8481         my $fd;
8482         my @difftree;
8483         if ($format eq 'html') {
8484                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8485                         "--no-commit-id", "--patch-with-raw", "--full-index",
8486                         $hash_parent_param, $hash, "--")
8487                         or die_error(500, "Open git-diff-tree failed");
8488
8489                 while (my $line = to_utf8(scalar <$fd>)) {
8490                         chomp $line;
8491                         # empty line ends raw part of diff-tree output
8492                         last unless $line;
8493                         push @difftree, scalar parse_difftree_raw_line($line);
8494                 }
8495
8496         } elsif ($format eq 'plain') {
8497                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8498                         '-p', $hash_parent_param, $hash, "--")
8499                         or die_error(500, "Open git-diff-tree failed");
8500         } elsif ($format eq 'patch') {
8501                 # For commit ranges, we limit the output to the number of
8502                 # patches specified in the 'patches' feature.
8503                 # For single commits, we limit the output to a single patch,
8504                 # diverging from the git-format-patch default.
8505                 my @commit_spec = ();
8506                 if ($hash_parent) {
8507                         if ($patch_max > 0) {
8508                                 push @commit_spec, "-$patch_max";
8509                         }
8510                         push @commit_spec, '-n', "$hash_parent..$hash";
8511                 } else {
8512                         if ($params{-single}) {
8513                                 push @commit_spec, '-1';
8514                         } else {
8515                                 if ($patch_max > 0) {
8516                                         push @commit_spec, "-$patch_max";
8517                                 }
8518                                 push @commit_spec, "-n";
8519                         }
8520                         push @commit_spec, '--root', $hash;
8521                 }
8522                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
8523                         '--encoding=utf8', '--stdout', @commit_spec)
8524                         or die_error(500, "Open git-format-patch failed");
8525         } else {
8526                 die_error(400, "Unknown commitdiff format");
8527         }
8528
8529         # non-textual hash id's can be cached
8530         my $expires;
8531         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8532                 $expires = "+1d";
8533         }
8534
8535         # write commit message
8536         if ($format eq 'html') {
8537                 my $refs = git_get_references();
8538                 my $ref = format_ref_marker($refs, $co{'id'});
8539
8540                 git_header_html(undef, $expires);
8541                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
8542                 git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash);
8543                 print "<div class=\"title_text\">\n" .
8544                       "<table class=\"object_header\">\n";
8545                 git_print_authorship_rows(\%co);
8546                 print "</table>".
8547                       "</div>\n";
8548                 print "<div class=\"page_body\">\n";
8549                 if (@{$co{'comment'}} > 1) {
8550                         print "<div class=\"log\">\n";
8551                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
8552                         print "</div>\n"; # class="log"
8553                 }
8554
8555         } elsif ($format eq 'plain') {
8556                 my $refs = git_get_references("tags");
8557                 my $tagname = git_get_rev_name_tags($hash);
8558                 my $filename = basename($project) . "-$hash.patch";
8559
8560                 print $cgi->header(
8561                         -type => 'text/plain',
8562                         -charset => 'utf-8',
8563                         -expires => $expires,
8564                         -content_disposition => 'inline; filename="' . "$filename" . '"');
8565                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
8566                 print "From: " . to_utf8($co{'author'}) . "\n";
8567                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
8568                 print "Subject: " . to_utf8($co{'title'}) . "\n";
8569
8570                 print "X-Git-Tag: $tagname\n" if $tagname;
8571                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8572
8573                 foreach my $line (@{$co{'comment'}}) {
8574                         print to_utf8($line) . "\n";
8575                 }
8576                 print "---\n\n";
8577         } elsif ($format eq 'patch') {
8578                 my $filename = basename($project) . "-$hash.patch";
8579
8580                 print $cgi->header(
8581                         -type => 'text/plain',
8582                         -charset => 'utf-8',
8583                         -expires => $expires,
8584                         -content_disposition => 'inline; filename="' . "$filename" . '"');
8585         }
8586
8587         # write patch
8588         if ($format eq 'html') {
8589                 my $use_parents = !defined $hash_parent ||
8590                         $hash_parent eq '-c' || $hash_parent eq '--cc';
8591                 git_difftree_body(\@difftree, $hash,
8592                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
8593                 print "<br/>\n";
8594
8595                 git_patchset_body($fd, $diff_style,
8596                                   \@difftree, $hash,
8597                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
8598                 close $fd;
8599                 print "</div>\n"; # class="page_body"
8600                 git_footer_html();
8601
8602         } elsif ($format eq 'plain') {
8603                 while (<$fd>) {
8604                         print to_utf8($_);
8605                 }
8606                 close $fd
8607                         or print "Reading git-diff-tree failed\n";
8608         } elsif ($format eq 'patch') {
8609                 while (<$fd>) {
8610                         print to_utf8($_);
8611                 }
8612                 close $fd
8613                         or print "Reading git-format-patch failed\n";
8614         }
8615 }
8616
8617 sub git_commitdiff_plain {
8618         git_commitdiff(-format => 'plain');
8619 }
8620
8621 # format-patch-style patches
8622 sub git_patch {
8623         git_commitdiff(-format => 'patch', -single => 1);
8624 }
8625
8626 sub git_patches {
8627         git_commitdiff(-format => 'patch');
8628 }
8629
8630 sub git_history {
8631         git_log_generic('history', \&git_history_body,
8632                         $hash_base, $hash_parent_base,
8633                         $file_name, $hash);
8634 }
8635
8636 sub git_search {
8637         $searchtype ||= 'commit';
8638
8639         # check if appropriate features are enabled
8640         gitweb_check_feature('search')
8641                 or die_error(403, "Search is disabled");
8642         if ($searchtype eq 'pickaxe') {
8643                 # pickaxe may take all resources of your box and run for several minutes
8644                 # with every query - so decide by yourself how public you make this feature
8645                 gitweb_check_feature('pickaxe')
8646                         or die_error(403, "Pickaxe search is disabled");
8647         }
8648         if ($searchtype eq 'grep') {
8649                 # grep search might be potentially CPU-intensive, too
8650                 gitweb_check_feature('grep')
8651                         or die_error(403, "Grep search is disabled");
8652         }
8653
8654         if (!defined $searchtext) {
8655                 die_error(400, "Text field is empty");
8656         }
8657         if (!defined $hash) {
8658                 $hash = git_get_head_hash($project);
8659         }
8660         my %co = parse_commit($hash);
8661         if (!%co) {
8662                 die_error(404, "Unknown commit object");
8663         }
8664         if (!defined $page) {
8665                 $page = 0;
8666         }
8667
8668         if ($searchtype eq 'commit' ||
8669             $searchtype eq 'author' ||
8670             $searchtype eq 'committer') {
8671                 git_search_message(%co);
8672         } elsif ($searchtype eq 'pickaxe') {
8673                 git_search_changes(%co);
8674         } elsif ($searchtype eq 'grep') {
8675                 git_search_files(%co);
8676         } else {
8677                 die_error(400, "Unknown search type");
8678         }
8679 }
8680
8681 sub git_search_help {
8682         git_header_html();
8683         git_print_page_nav('','', $hash,$hash,$hash);
8684         print <<EOT;
8685 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
8686 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
8687 the pattern entered is recognized as the POSIX extended
8688 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
8689 insensitive).</p>
8690 <dl>
8691 <dt><b>commit</b></dt>
8692 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
8693 EOT
8694         my $have_grep = gitweb_check_feature('grep');
8695         if ($have_grep) {
8696                 print <<EOT;
8697 <dt><b>grep</b></dt>
8698 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
8699     a different one) are searched for the given pattern. On large trees, this search can take
8700 a while and put some strain on the server, so please use it with some consideration. Note that
8701 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
8702 case-sensitive.</dd>
8703 EOT
8704         }
8705         print <<EOT;
8706 <dt><b>author</b></dt>
8707 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
8708 <dt><b>committer</b></dt>
8709 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
8710 EOT
8711         my $have_pickaxe = gitweb_check_feature('pickaxe');
8712         if ($have_pickaxe) {
8713                 print <<EOT;
8714 <dt><b>pickaxe</b></dt>
8715 <dd>All commits that caused the string to appear or disappear from any file (changes that
8716 added, removed or "modified" the string) will be listed. This search can take a while and
8717 takes a lot of strain on the server, so please use it wisely. Note that since you may be
8718 interested even in changes just changing the case as well, this search is case sensitive.</dd>
8719 EOT
8720         }
8721         print "</dl>\n";
8722         git_footer_html();
8723 }
8724
8725 sub git_shortlog {
8726         git_log_generic('shortlog', \&git_shortlog_body,
8727                         $hash, $hash_parent);
8728 }
8729
8730 ## ......................................................................
8731 ## feeds (RSS, Atom; OPML)
8732
8733 sub git_feed {
8734         my $format = shift || 'atom';
8735         my $have_blame = gitweb_check_feature('blame');
8736
8737         # Atom: http://www.atomenabled.org/developers/syndication/
8738         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
8739         if ($format ne 'rss' && $format ne 'atom') {
8740                 die_error(400, "Unknown web feed format");
8741         }
8742
8743         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
8744         my $head = $hash || 'HEAD';
8745         my @commitlist = parse_commits($head, 150, 0, $file_name);
8746
8747         my %latest_commit;
8748         my %latest_date;
8749         my $content_type = "application/$format+xml";
8750         if (defined $cgi->http('HTTP_ACCEPT') &&
8751                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
8752                 # browser (feed reader) prefers text/xml
8753                 $content_type = 'text/xml';
8754         }
8755         if (defined($commitlist[0])) {
8756                 %latest_commit = %{$commitlist[0]};
8757                 my $latest_epoch = $latest_commit{'committer_epoch'};
8758                 exit_if_unmodified_since($latest_epoch);
8759                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
8760         }
8761         print $cgi->header(
8762                 -type => $content_type,
8763                 -charset => 'utf-8',
8764                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
8765                 -status => '200 OK');
8766
8767         # Optimization: skip generating the body if client asks only
8768         # for Last-Modified date.
8769         return if ($cgi->request_method() eq 'HEAD');
8770
8771         # header variables
8772         my $title = "$site_name - $project/$action";
8773         my $feed_type = 'log';
8774         if (defined $hash) {
8775                 $title .= " - '$hash'";
8776                 $feed_type = 'branch log';
8777                 if (defined $file_name) {
8778                         $title .= " :: $file_name";
8779                         $feed_type = 'history';
8780                 }
8781         } elsif (defined $file_name) {
8782                 $title .= " - $file_name";
8783                 $feed_type = 'history';
8784         }
8785         $title .= " $feed_type";
8786         $title = esc_html($title);
8787         my $descr = git_get_project_description($project);
8788         if (defined $descr) {
8789                 $descr = esc_html($descr);
8790         } else {
8791                 $descr = "$project " .
8792                          ($format eq 'rss' ? 'RSS' : 'Atom') .
8793                          " feed";
8794         }
8795         my $owner = git_get_project_owner($project);
8796         $owner = esc_html($owner);
8797
8798         #header
8799         my $alt_url;
8800         if (defined $file_name) {
8801                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
8802         } elsif (defined $hash) {
8803                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
8804         } else {
8805                 $alt_url = href(-full=>1, action=>"summary");
8806         }
8807         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
8808         if ($format eq 'rss') {
8809                 print <<XML;
8810 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
8811 <channel>
8812 XML
8813                 print "<title>$title</title>\n" .
8814                       "<link>$alt_url</link>\n" .
8815                       "<description>$descr</description>\n" .
8816                       "<language>en</language>\n" .
8817                       # project owner is responsible for 'editorial' content
8818                       "<managingEditor>$owner</managingEditor>\n";
8819                 if (defined $logo || defined $favicon) {
8820                         # prefer the logo to the favicon, since RSS
8821                         # doesn't allow both
8822                         my $img = esc_url($logo || $favicon);
8823                         print "<image>\n" .
8824                               "<url>$img</url>\n" .
8825                               "<title>$title</title>\n" .
8826                               "<link>$alt_url</link>\n" .
8827                               "</image>\n";
8828                 }
8829                 if (%latest_date) {
8830                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
8831                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
8832                 }
8833                 print "<generator>gitweb v.$version/$git_version</generator>\n";
8834         } elsif ($format eq 'atom') {
8835                 print <<XML;
8836 <feed xmlns="http://www.w3.org/2005/Atom">
8837 XML
8838                 print "<title>$title</title>\n" .
8839                       "<subtitle>$descr</subtitle>\n" .
8840                       '<link rel="alternate" type="text/html" href="' .
8841                       $alt_url . '" />' . "\n" .
8842                       '<link rel="self" type="' . $content_type . '" href="' .
8843                       $cgi->self_url() . '" />' . "\n" .
8844                       "<id>" . href(-full=>1) . "</id>\n" .
8845                       # use project owner for feed author
8846                       "<author><name>$owner</name></author>\n";
8847                 if (defined $favicon) {
8848                         print "<icon>" . esc_url($favicon) . "</icon>\n";
8849                 }
8850                 if (defined $logo) {
8851                         # not twice as wide as tall: 72 x 27 pixels
8852                         print "<logo>" . esc_url($logo) . "</logo>\n";
8853                 }
8854                 if (! %latest_date) {
8855                         # dummy date to keep the feed valid until commits trickle in:
8856                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
8857                 } else {
8858                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
8859                 }
8860                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
8861         }
8862
8863         # contents
8864         for (my $i = 0; $i <= $#commitlist; $i++) {
8865                 my %co = %{$commitlist[$i]};
8866                 my $commit = $co{'id'};
8867                 # we read 150, we always show 30 and the ones more recent than 48 hours
8868                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
8869                         last;
8870                 }
8871                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
8872
8873                 # get list of changed files
8874                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8875                         $co{'parent'} || "--root",
8876                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
8877                         or next;
8878                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
8879                 close $fd
8880                         or next;
8881
8882                 # print element (entry, item)
8883                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
8884                 if ($format eq 'rss') {
8885                         print "<item>\n" .
8886                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
8887                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
8888                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
8889                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
8890                               "<link>$co_url</link>\n" .
8891                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
8892                               "<content:encoded>" .
8893                               "<![CDATA[\n";
8894                 } elsif ($format eq 'atom') {
8895                         print "<entry>\n" .
8896                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
8897                               "<updated>$cd{'iso-8601'}</updated>\n" .
8898                               "<author>\n" .
8899                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
8900                         if ($co{'author_email'}) {
8901                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
8902                         }
8903                         print "</author>\n" .
8904                               # use committer for contributor
8905                               "<contributor>\n" .
8906                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
8907                         if ($co{'committer_email'}) {
8908                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
8909                         }
8910                         print "</contributor>\n" .
8911                               "<published>$cd{'iso-8601'}</published>\n" .
8912                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
8913                               "<id>$co_url</id>\n" .
8914                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
8915                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
8916                 }
8917                 my $comment = $co{'comment'};
8918                 print "<pre>\n";
8919                 foreach my $line (@$comment) {
8920                         $line = esc_html($line);
8921                         print "$line\n";
8922                 }
8923                 print "</pre><ul>\n";
8924                 foreach my $difftree_line (@difftree) {
8925                         my %difftree = parse_difftree_raw_line($difftree_line);
8926                         next if !$difftree{'from_id'};
8927
8928                         my $file = $difftree{'file'} || $difftree{'to_file'};
8929
8930                         print "<li>" .
8931                               "[" .
8932                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
8933                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
8934                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
8935                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
8936                                       -title => "diff"}, 'D');
8937                         if ($have_blame) {
8938                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
8939                                                              file_name=>$file, hash_base=>$commit),
8940                                               -title => "blame"}, 'B');
8941                         }
8942                         # if this is not a feed of a file history
8943                         if (!defined $file_name || $file_name ne $file) {
8944                                 print $cgi->a({-href => href(-full=>1, action=>"history",
8945                                                              file_name=>$file, hash=>$commit),
8946                                               -title => "history"}, 'H');
8947                         }
8948                         $file = esc_path($file);
8949                         print "] ".
8950                               "$file</li>\n";
8951                 }
8952                 if ($format eq 'rss') {
8953                         print "</ul>]]>\n" .
8954                               "</content:encoded>\n" .
8955                               "</item>\n";
8956                 } elsif ($format eq 'atom') {
8957                         print "</ul>\n</div>\n" .
8958                               "</content>\n" .
8959                               "</entry>\n";
8960                 }
8961         }
8962
8963         # end of feed
8964         if ($format eq 'rss') {
8965                 print "</channel>\n</rss>\n";
8966         } elsif ($format eq 'atom') {
8967                 print "</feed>\n";
8968         }
8969 }
8970
8971 sub git_rss {
8972         git_feed('rss');
8973 }
8974
8975 sub git_atom {
8976         git_feed('atom');
8977 }
8978
8979 sub git_opml {
8980         my @list = git_get_projects_list($project_filter, $strict_export);
8981         if (!@list) {
8982                 die_error(404, "No projects found");
8983         }
8984
8985         print $cgi->header(
8986                 -type => 'text/xml',
8987                 -charset => 'utf-8',
8988                 -content_disposition => 'inline; filename="opml.xml"');
8989
8990         my $title = esc_html($site_name);
8991         my $filter = " within subdirectory ";
8992         if (defined $project_filter) {
8993                 $filter .= esc_html($project_filter);
8994         } else {
8995                 $filter = "";
8996         }
8997         print <<XML;
8998 <?xml version="1.0" encoding="utf-8"?>
8999 <opml version="1.0">
9000 <head>
9001   <title>$title OPML Export$filter</title>
9002 </head>
9003 <body>
9004 <outline text="git RSS feeds">
9005 XML
9006
9007         foreach my $pr (@list) {
9008                 my %proj = %$pr;
9009                 my $head = git_get_head_hash($proj{'path'});
9010                 if (!defined $head) {
9011                         next;
9012                 }
9013                 $git_dir = "$projectroot/$proj{'path'}";
9014                 my %co = parse_commit($head);
9015                 if (!%co) {
9016                         next;
9017                 }
9018
9019                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9020                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9021                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9022                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9023         }
9024         print <<XML;
9025 </outline>
9026 </body>
9027 </opml>
9028 XML
9029 }