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_file_date {
3725         my $file = shift;
3726         my $mtime = (stat("$projectroot/$project/$file"))[9];
3727         return () unless defined $mtime;
3728         my $tzoffset = timegm((localtime($mtime))[0..5]) - $mtime;
3729         my $tzstring = '+';
3730         if ($tzoffset <= 0) {
3731                 $tzstring = '-';
3732                 $tzoffset *= -1;
3733         }
3734         $tzoffset = int($tzoffset/60);
3735         $tzstring .= sprintf("%02d%02d", int($tzoffset/60), $tzoffset%60);
3736         return parse_date($mtime, $tzstring);
3737 }
3738
3739 sub parse_tag {
3740         my $tag_id = shift;
3741         my %tag;
3742         my @comment;
3743
3744         defined(my $fd = git_cmd_pipe "cat-file", "tag", $tag_id) or return;
3745         $tag{'id'} = $tag_id;
3746         while (my $line = to_utf8(scalar <$fd>)) {
3747                 chomp $line;
3748                 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
3749                         $tag{'object'} = $1;
3750                 } elsif ($line =~ m/^type (.+)$/) {
3751                         $tag{'type'} = $1;
3752                 } elsif ($line =~ m/^tag (.+)$/) {
3753                         $tag{'name'} = $1;
3754                 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
3755                         $tag{'author'} = $1;
3756                         $tag{'author_epoch'} = $2;
3757                         $tag{'author_tz'} = $3;
3758                         if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3759                                 $tag{'author_name'}  = $1;
3760                                 $tag{'author_email'} = $2;
3761                         } else {
3762                                 $tag{'author_name'} = $tag{'author'};
3763                         }
3764                 } elsif ($line =~ m/--BEGIN/) {
3765                         push @comment, $line;
3766                         last;
3767                 } elsif ($line eq "") {
3768                         last;
3769                 }
3770         }
3771         push @comment, map(to_utf8($_), <$fd>);
3772         $tag{'comment'} = \@comment;
3773         close $fd or return;
3774         if (!defined $tag{'name'}) {
3775                 return
3776         };
3777         return %tag
3778 }
3779
3780 sub parse_commit_text {
3781         my ($commit_text, $withparents) = @_;
3782         my @commit_lines = split '\n', $commit_text;
3783         my %co;
3784
3785         pop @commit_lines; # Remove '\0'
3786
3787         if (! @commit_lines) {
3788                 return;
3789         }
3790
3791         my $header = shift @commit_lines;
3792         if ($header !~ m/^[0-9a-fA-F]{40}/) {
3793                 return;
3794         }
3795         ($co{'id'}, my @parents) = split ' ', $header;
3796         while (my $line = shift @commit_lines) {
3797                 last if $line eq "\n";
3798                 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
3799                         $co{'tree'} = $1;
3800                 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
3801                         push @parents, $1;
3802                 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
3803                         $co{'author'} = to_utf8($1);
3804                         $co{'author_epoch'} = $2;
3805                         $co{'author_tz'} = $3;
3806                         if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3807                                 $co{'author_name'}  = $1;
3808                                 $co{'author_email'} = $2;
3809                         } else {
3810                                 $co{'author_name'} = $co{'author'};
3811                         }
3812                 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
3813                         $co{'committer'} = to_utf8($1);
3814                         $co{'committer_epoch'} = $2;
3815                         $co{'committer_tz'} = $3;
3816                         if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
3817                                 $co{'committer_name'}  = $1;
3818                                 $co{'committer_email'} = $2;
3819                         } else {
3820                                 $co{'committer_name'} = $co{'committer'};
3821                         }
3822                 }
3823         }
3824         if (!defined $co{'tree'}) {
3825                 return;
3826         };
3827         $co{'parents'} = \@parents;
3828         $co{'parent'} = $parents[0];
3829
3830         @commit_lines = map to_utf8($_), @commit_lines;
3831         foreach my $title (@commit_lines) {
3832                 $title =~ s/^    //;
3833                 if ($title ne "") {
3834                         $co{'title'} = chop_str($title, 80, 5);
3835                         # remove leading stuff of merges to make the interesting part visible
3836                         if (length($title) > 50) {
3837                                 $title =~ s/^Automatic //;
3838                                 $title =~ s/^merge (of|with) /Merge ... /i;
3839                                 if (length($title) > 50) {
3840                                         $title =~ s/(http|rsync):\/\///;
3841                                 }
3842                                 if (length($title) > 50) {
3843                                         $title =~ s/(master|www|rsync)\.//;
3844                                 }
3845                                 if (length($title) > 50) {
3846                                         $title =~ s/kernel.org:?//;
3847                                 }
3848                                 if (length($title) > 50) {
3849                                         $title =~ s/\/pub\/scm//;
3850                                 }
3851                         }
3852                         $co{'title_short'} = chop_str($title, 50, 5);
3853                         last;
3854                 }
3855         }
3856         if (! defined $co{'title'} || $co{'title'} eq "") {
3857                 $co{'title'} = $co{'title_short'} = '(no commit message)';
3858         }
3859         # remove added spaces
3860         foreach my $line (@commit_lines) {
3861                 $line =~ s/^    //;
3862         }
3863         $co{'comment'} = \@commit_lines;
3864
3865         my $age_epoch = $co{'committer_epoch'};
3866         $co{'age_epoch'} = $age_epoch;
3867         my $time_now = time;
3868         $co{'age_string'} = age_string($age_epoch, $time_now);
3869         $co{'age_string_date'} = age_string_date($age_epoch, $time_now);
3870         $co{'age_string_age'} = age_string_age($age_epoch, $time_now);
3871         return %co;
3872 }
3873
3874 sub parse_commit {
3875         my ($commit_id) = @_;
3876         my %co;
3877
3878         local $/ = "\0";
3879
3880         defined(my $fd = git_cmd_pipe "rev-list",
3881                 "--parents",
3882                 "--header",
3883                 "--max-count=1",
3884                 $commit_id,
3885                 "--")
3886                 or die_error(500, "Open git-rev-list failed");
3887         %co = parse_commit_text(<$fd>, 1);
3888         close $fd;
3889
3890         return %co;
3891 }
3892
3893 sub parse_commits {
3894         my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
3895         my @cos;
3896
3897         $maxcount ||= 1;
3898         $skip ||= 0;
3899
3900         local $/ = "\0";
3901
3902         defined(my $fd = git_cmd_pipe "rev-list",
3903                 "--header",
3904                 @args,
3905                 ("--max-count=" . $maxcount),
3906                 ("--skip=" . $skip),
3907                 @extra_options,
3908                 $commit_id,
3909                 "--",
3910                 ($filename ? ($filename) : ()))
3911                 or die_error(500, "Open git-rev-list failed");
3912         while (my $line = <$fd>) {
3913                 my %co = parse_commit_text($line);
3914                 push @cos, \%co;
3915         }
3916         close $fd;
3917
3918         return wantarray ? @cos : \@cos;
3919 }
3920
3921 # parse line of git-diff-tree "raw" output
3922 sub parse_difftree_raw_line {
3923         my $line = shift;
3924         my %res;
3925
3926         # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M   ls-files.c'
3927         # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M   rev-tree.c'
3928         if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
3929                 $res{'from_mode'} = $1;
3930                 $res{'to_mode'} = $2;
3931                 $res{'from_id'} = $3;
3932                 $res{'to_id'} = $4;
3933                 $res{'status'} = $5;
3934                 $res{'similarity'} = $6;
3935                 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
3936                         ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
3937                 } else {
3938                         $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
3939                 }
3940         }
3941         # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
3942         # combined diff (for merge commit)
3943         elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
3944                 $res{'nparents'}  = length($1);
3945                 $res{'from_mode'} = [ split(' ', $2) ];
3946                 $res{'to_mode'} = pop @{$res{'from_mode'}};
3947                 $res{'from_id'} = [ split(' ', $3) ];
3948                 $res{'to_id'} = pop @{$res{'from_id'}};
3949                 $res{'status'} = [ split('', $4) ];
3950                 $res{'to_file'} = unquote($5);
3951         }
3952         # 'c512b523472485aef4fff9e57b229d9d243c967f'
3953         elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
3954                 $res{'commit'} = $1;
3955         }
3956
3957         return wantarray ? %res : \%res;
3958 }
3959
3960 # wrapper: return parsed line of git-diff-tree "raw" output
3961 # (the argument might be raw line, or parsed info)
3962 sub parsed_difftree_line {
3963         my $line_or_ref = shift;
3964
3965         if (ref($line_or_ref) eq "HASH") {
3966                 # pre-parsed (or generated by hand)
3967                 return $line_or_ref;
3968         } else {
3969                 return parse_difftree_raw_line($line_or_ref);
3970         }
3971 }
3972
3973 # parse line of git-ls-tree output
3974 sub parse_ls_tree_line {
3975         my $line = shift;
3976         my %opts = @_;
3977         my %res;
3978
3979         if ($opts{'-l'}) {
3980                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa   16717  panic.c'
3981                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
3982
3983                 $res{'mode'} = $1;
3984                 $res{'type'} = $2;
3985                 $res{'hash'} = $3;
3986                 $res{'size'} = $4;
3987                 if ($opts{'-z'}) {
3988                         $res{'name'} = $5;
3989                 } else {
3990                         $res{'name'} = unquote($5);
3991                 }
3992         } else {
3993                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
3994                 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
3995
3996                 $res{'mode'} = $1;
3997                 $res{'type'} = $2;
3998                 $res{'hash'} = $3;
3999                 if ($opts{'-z'}) {
4000                         $res{'name'} = $4;
4001                 } else {
4002                         $res{'name'} = unquote($4);
4003                 }
4004         }
4005
4006         return wantarray ? %res : \%res;
4007 }
4008
4009 # generates _two_ hashes, references to which are passed as 2 and 3 argument
4010 sub parse_from_to_diffinfo {
4011         my ($diffinfo, $from, $to, @parents) = @_;
4012
4013         if ($diffinfo->{'nparents'}) {
4014                 # combined diff
4015                 $from->{'file'} = [];
4016                 $from->{'href'} = [];
4017                 fill_from_file_info($diffinfo, @parents)
4018                         unless exists $diffinfo->{'from_file'};
4019                 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
4020                         $from->{'file'}[$i] =
4021                                 defined $diffinfo->{'from_file'}[$i] ?
4022                                         $diffinfo->{'from_file'}[$i] :
4023                                         $diffinfo->{'to_file'};
4024                         if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
4025                                 $from->{'href'}[$i] = href(action=>"blob",
4026                                                            hash_base=>$parents[$i],
4027                                                            hash=>$diffinfo->{'from_id'}[$i],
4028                                                            file_name=>$from->{'file'}[$i]);
4029                         } else {
4030                                 $from->{'href'}[$i] = undef;
4031                         }
4032                 }
4033         } else {
4034                 # ordinary (not combined) diff
4035                 $from->{'file'} = $diffinfo->{'from_file'};
4036                 if ($diffinfo->{'status'} ne "A") { # not new (added) file
4037                         $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
4038                                                hash=>$diffinfo->{'from_id'},
4039                                                file_name=>$from->{'file'});
4040                 } else {
4041                         delete $from->{'href'};
4042                 }
4043         }
4044
4045         $to->{'file'} = $diffinfo->{'to_file'};
4046         if (!is_deleted($diffinfo)) { # file exists in result
4047                 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
4048                                      hash=>$diffinfo->{'to_id'},
4049                                      file_name=>$to->{'file'});
4050         } else {
4051                 delete $to->{'href'};
4052         }
4053 }
4054
4055 ## ......................................................................
4056 ## parse to array of hashes functions
4057
4058 sub git_get_heads_list {
4059         my ($limit, @classes) = @_;
4060         @classes = get_branch_refs() unless @classes;
4061         my @patterns = map { "refs/$_" } @classes;
4062         my @headslist;
4063
4064         defined(my $fd = git_cmd_pipe 'for-each-ref',
4065                 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
4066                 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
4067                 @patterns)
4068                 or return;
4069         while (my $line = to_utf8(scalar <$fd>)) {
4070                 my %ref_item;
4071
4072                 chomp $line;
4073                 my ($refinfo, $committerinfo) = split(/\0/, $line);
4074                 my ($hash, $name, $title) = split(' ', $refinfo, 3);
4075                 my ($committer, $epoch, $tz) =
4076                         ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
4077                 $ref_item{'fullname'}  = $name;
4078                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
4079                 $name =~ s!^refs/($strip_refs|remotes)/!!;
4080                 $ref_item{'name'} = $name;
4081                 # for refs neither in 'heads' nor 'remotes' we want to
4082                 # show their ref dir
4083                 my $ref_dir = (defined $1) ? $1 : '';
4084                 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
4085                     $ref_item{'name'} .= ' (' . $ref_dir . ')';
4086                 }
4087
4088                 $ref_item{'id'}    = $hash;
4089                 $ref_item{'title'} = $title || '(no commit message)';
4090                 $ref_item{'epoch'} = $epoch;
4091                 if ($epoch) {
4092                         $ref_item{'age'} = age_string($ref_item{'epoch'});
4093                 } else {
4094                         $ref_item{'age'} = "unknown";
4095                 }
4096
4097                 push @headslist, \%ref_item;
4098         }
4099         close $fd;
4100
4101         return wantarray ? @headslist : \@headslist;
4102 }
4103
4104 sub git_get_tags_list {
4105         my $limit = shift;
4106         my @tagslist;
4107
4108         defined(my $fd = git_cmd_pipe 'for-each-ref',
4109                 ($limit ? '--count='.($limit+1) : ()), '--sort=-creatordate',
4110                 '--format=%(objectname) %(objecttype) %(refname) '.
4111                 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
4112                 'refs/tags')
4113                 or return;
4114         while (my $line = to_utf8(scalar <$fd>)) {
4115                 my %ref_item;
4116
4117                 chomp $line;
4118                 my ($refinfo, $creatorinfo) = split(/\0/, $line);
4119                 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
4120                 my ($creator, $epoch, $tz) =
4121                         ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
4122                 $ref_item{'fullname'} = $name;
4123                 $name =~ s!^refs/tags/!!;
4124
4125                 $ref_item{'type'} = $type;
4126                 $ref_item{'id'} = $id;
4127                 $ref_item{'name'} = $name;
4128                 if ($type eq "tag") {
4129                         $ref_item{'subject'} = $title;
4130                         $ref_item{'reftype'} = $reftype;
4131                         $ref_item{'refid'}   = $refid;
4132                 } else {
4133                         $ref_item{'reftype'} = $type;
4134                         $ref_item{'refid'}   = $id;
4135                 }
4136
4137                 if ($type eq "tag" || $type eq "commit") {
4138                         $ref_item{'epoch'} = $epoch;
4139                         if ($epoch) {
4140                                 $ref_item{'age'} = age_string($ref_item{'epoch'});
4141                         } else {
4142                                 $ref_item{'age'} = "unknown";
4143                         }
4144                 }
4145
4146                 push @tagslist, \%ref_item;
4147         }
4148         close $fd;
4149
4150         return wantarray ? @tagslist : \@tagslist;
4151 }
4152
4153 ## ----------------------------------------------------------------------
4154 ## filesystem-related functions
4155
4156 sub get_file_owner {
4157         my $path = shift;
4158
4159         my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
4160         my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
4161         if (!defined $gcos) {
4162                 return undef;
4163         }
4164         my $owner = $gcos;
4165         $owner =~ s/[,;].*$//;
4166         return to_utf8($owner);
4167 }
4168
4169 # assume that file exists
4170 sub insert_file {
4171         my $filename = shift;
4172
4173         open my $fd, '<', $filename;
4174         while (<$fd>) {
4175                 print to_utf8($_);
4176         }
4177         close $fd;
4178 }
4179
4180 ## ......................................................................
4181 ## mimetype related functions
4182
4183 sub mimetype_guess_file {
4184         my $filename = shift;
4185         my $mimemap = shift;
4186         -r $mimemap or return undef;
4187
4188         my %mimemap;
4189         open(my $mh, '<', $mimemap) or return undef;
4190         while (<$mh>) {
4191                 next if m/^#/; # skip comments
4192                 my ($mimetype, @exts) = split(/\s+/);
4193                 foreach my $ext (@exts) {
4194                         $mimemap{$ext} = $mimetype;
4195                 }
4196         }
4197         close($mh);
4198
4199         $filename =~ /\.([^.]*)$/;
4200         return $mimemap{$1};
4201 }
4202
4203 sub mimetype_guess {
4204         my $filename = shift;
4205         my $mime;
4206         $filename =~ /\./ or return undef;
4207
4208         if ($mimetypes_file) {
4209                 my $file = $mimetypes_file;
4210                 if ($file !~ m!^/!) { # if it is relative path
4211                         # it is relative to project
4212                         $file = "$projectroot/$project/$file";
4213                 }
4214                 $mime = mimetype_guess_file($filename, $file);
4215         }
4216         $mime ||= mimetype_guess_file($filename, '/etc/mime.types');
4217         return $mime;
4218 }
4219
4220 sub blob_mimetype {
4221         my $fd = shift;
4222         my $filename = shift;
4223
4224         if ($filename) {
4225                 my $mime = mimetype_guess($filename);
4226                 $mime and return $mime;
4227         }
4228
4229         # just in case
4230         return $default_blob_plain_mimetype unless $fd;
4231
4232         if (-T $fd) {
4233                 return 'text/plain';
4234         } elsif (! $filename) {
4235                 return 'application/octet-stream';
4236         } elsif ($filename =~ m/\.png$/i) {
4237                 return 'image/png';
4238         } elsif ($filename =~ m/\.gif$/i) {
4239                 return 'image/gif';
4240         } elsif ($filename =~ m/\.jpe?g$/i) {
4241                 return 'image/jpeg';
4242         } else {
4243                 return 'application/octet-stream';
4244         }
4245 }
4246
4247 sub blob_contenttype {
4248         my ($fd, $file_name, $type) = @_;
4249
4250         $type ||= blob_mimetype($fd, $file_name);
4251         if ($type eq 'text/plain' && defined $default_text_plain_charset) {
4252                 $type .= "; charset=$default_text_plain_charset";
4253         }
4254
4255         return $type;
4256 }
4257
4258 # peek the first upto 128 bytes off a file handle
4259 sub peek128bytes {
4260         my $fd = shift;
4261
4262         use IO::Handle;
4263         use bytes;
4264
4265         my $prefix128;
4266         return '' unless $fd && read($fd, $prefix128, 128);
4267
4268         # In the general case, we're guaranteed only to be able to ungetc one
4269         # character (provided, of course, we actually got a character first).
4270         #
4271         # However, we know:
4272         #
4273         # 1) we are dealing with a :perlio layer since blob_mimetype will have
4274         #    already been called at least once on the file handle before us
4275         #
4276         # 2) we have an $fd positioned at the start of the input stream and
4277         #    therefore know we were positioned at a buffer boundary before
4278         #    reading the initial upto 128 bytes
4279         #
4280         # 3) the buffer size is at least 512 bytes
4281         #
4282         # 4) we are careful to only unget raw bytes
4283         #
4284         # 5) we are attempting to unget exactly the same number of bytes we got
4285         #
4286         # Given the above conditions we will ALWAYS be able to safely unget
4287         # the $prefix128 value we just got.
4288         #
4289         # In fact, we could read up to 511 bytes and still be sure.
4290         # (Reading 512 might pop us into the next internal buffer, but probably
4291         # not since that could break the always able to unget at least the one
4292         # you just got guarantee.)
4293
4294         map {$fd->ungetc(ord($_))} reverse(split //, $prefix128);
4295
4296         return $prefix128;
4297 }
4298
4299 # guess file syntax for syntax highlighting; return undef if no highlighting
4300 # the name of syntax can (in the future) depend on syntax highlighter used
4301 sub guess_file_syntax {
4302         my ($fd, $mimetype, $file_name) = @_;
4303         return undef unless $fd && defined $file_name &&
4304                 defined $mimetype && $mimetype =~ m!^text/.+!i;
4305         my $basename = basename($file_name, '.in');
4306         return $highlight_basename{$basename}
4307                 if exists $highlight_basename{$basename};
4308
4309         # Peek to see if there's a shebang or xml line.
4310         # We always operate on bytes when testing this.
4311         {
4312                 use bytes;
4313                 my $shebang = peek128bytes($fd);
4314                 if (length($shebang) >= 4 && $shebang =~ /^#!/) { # 4 would be '#!/x'
4315                         foreach my $key (keys %highlight_shebang) {
4316                                 my $ar = ref($highlight_shebang{$key}) ?
4317                                         $highlight_shebang{$key} :
4318                                         [$highlight_shebang{key}];
4319                                 map {return $key if $shebang =~ /$_/} @$ar;
4320                         }
4321                 }
4322                 return 'xml' if $shebang =~ m!^\s*<\?xml\s!; # "xml" must be lowercase
4323         }
4324
4325         $basename =~ /\.([^.]*)$/;
4326         my $ext = $1 or return undef;
4327         return $highlight_ext{$ext}
4328                 if exists $highlight_ext{$ext};
4329
4330         return undef;
4331 }
4332
4333 # run highlighter and return FD of its output,
4334 # or return original FD if no highlighting
4335 sub run_highlighter {
4336         my ($fd, $syntax) = @_;
4337         return $fd unless $fd && !eof($fd) && defined $highlight_bin && defined $syntax;
4338
4339         defined(my $hifd = cmd_pipe $posix_shell_bin, '-c',
4340                 quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
4341                 quote_command($highlight_bin).
4342                 " --replace-tabs=8 --fragment --syntax $syntax")
4343                 or die_error(500, "Couldn't open file or run syntax highlighter");
4344         if (eof $hifd) {
4345                 # just in case, should not happen as we tested !eof($fd) above
4346                 return $fd if close($hifd);
4347
4348                 # should not happen
4349                 !$! or die_error(500, "Couldn't close syntax highighter pipe");
4350
4351                 # leaving us with the only possibility a non-zero exit status (possibly a signal);
4352                 # instead of dying horribly on this, just skip the highlighting
4353                 # but do output a message about it to STDERR that will end up in the log
4354                 print STDERR "warning: skipping failed highlight for --syntax $syntax: ".
4355                         sprintf("child exit status 0x%x\n", $?);
4356                 return $fd
4357         }
4358         close $fd;
4359         return ($hifd, 1);
4360 }
4361
4362 ## ======================================================================
4363 ## functions printing HTML: header, footer, error page
4364
4365 sub get_page_title {
4366         my $title = to_utf8($site_name);
4367
4368         unless (defined $project) {
4369                 if (defined $project_filter) {
4370                         $title .= " - projects in '" . esc_path($project_filter) . "'";
4371                 }
4372                 return $title;
4373         }
4374         $title .= " - " . to_utf8($project);
4375
4376         return $title unless (defined $action);
4377         $title .= "/$action"; # $action is US-ASCII (7bit ASCII)
4378
4379         return $title unless (defined $file_name);
4380         $title .= " - " . esc_path($file_name);
4381         if ($action eq "tree" && $file_name !~ m|/$|) {
4382                 $title .= "/";
4383         }
4384
4385         return $title;
4386 }
4387
4388 sub get_content_type_html {
4389         # require explicit support from the UA if we are to send the page as
4390         # 'application/xhtml+xml', otherwise send it as plain old 'text/html'.
4391         # we have to do this because MSIE sometimes globs '*/*', pretending to
4392         # support xhtml+xml but choking when it gets what it asked for.
4393         if (defined $cgi->http('HTTP_ACCEPT') &&
4394             $cgi->http('HTTP_ACCEPT') =~ m/(,|;|\s|^)application\/xhtml\+xml(,|;|\s|$)/ &&
4395             $cgi->Accept('application/xhtml+xml') != 0) {
4396                 return 'application/xhtml+xml';
4397         } else {
4398                 return 'text/html';
4399         }
4400 }
4401
4402 sub print_feed_meta {
4403         if (defined $project) {
4404                 my %href_params = get_feed_info();
4405                 if (!exists $href_params{'-title'}) {
4406                         $href_params{'-title'} = 'log';
4407                 }
4408
4409                 foreach my $format (qw(RSS Atom)) {
4410                         my $type = lc($format);
4411                         my %link_attr = (
4412                                 '-rel' => 'alternate',
4413                                 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4414                                 '-type' => "application/$type+xml"
4415                         );
4416
4417                         $href_params{'extra_options'} = undef;
4418                         $href_params{'action'} = $type;
4419                         $link_attr{'-href'} = href(%href_params);
4420                         print "<link ".
4421                               "rel=\"$link_attr{'-rel'}\" ".
4422                               "title=\"$link_attr{'-title'}\" ".
4423                               "href=\"$link_attr{'-href'}\" ".
4424                               "type=\"$link_attr{'-type'}\" ".
4425                               "/>\n";
4426
4427                         $href_params{'extra_options'} = '--no-merges';
4428                         $link_attr{'-href'} = href(%href_params);
4429                         $link_attr{'-title'} .= ' (no merges)';
4430                         print "<link ".
4431                               "rel=\"$link_attr{'-rel'}\" ".
4432                               "title=\"$link_attr{'-title'}\" ".
4433                               "href=\"$link_attr{'-href'}\" ".
4434                               "type=\"$link_attr{'-type'}\" ".
4435                               "/>\n";
4436                 }
4437
4438         } else {
4439                 printf('<link rel="alternate" title="%s projects list" '.
4440                        'href="%s" type="text/plain; charset=utf-8" />'."\n",
4441                        esc_attr($site_name), href(project=>undef, action=>"project_index"));
4442                 printf('<link rel="alternate" title="%s projects feeds" '.
4443                        'href="%s" type="text/x-opml" />'."\n",
4444                        esc_attr($site_name), href(project=>undef, action=>"opml"));
4445         }
4446 }
4447
4448 sub print_header_links {
4449         my $status = shift;
4450
4451         # print out each stylesheet that exist, providing backwards capability
4452         # for those people who defined $stylesheet in a config file
4453         if (defined $stylesheet) {
4454                 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4455         } else {
4456                 foreach my $stylesheet (@stylesheets) {
4457                         next unless $stylesheet;
4458                         print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4459                 }
4460         }
4461         print_feed_meta()
4462                 if ($status eq '200 OK');
4463         if (defined $favicon) {
4464                 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4465         }
4466 }
4467
4468 sub print_nav_breadcrumbs_path {
4469         my $dirprefix = undef;
4470         while (my $part = shift) {
4471                 $dirprefix .= "/" if defined $dirprefix;
4472                 $dirprefix .= $part;
4473                 print $cgi->a({-href => href(project => undef,
4474                                              project_filter => $dirprefix,
4475                                              action => "project_list")},
4476                               esc_html($part)) . " / ";
4477         }
4478 }
4479
4480 sub print_nav_breadcrumbs {
4481         my %opts = @_;
4482
4483         for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4484                 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4485         }
4486         if (defined $project) {
4487                 my @dirname = split '/', $project;
4488                 my $projectbasename = pop @dirname;
4489                 print_nav_breadcrumbs_path(@dirname);
4490                 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4491                 if (defined $action) {
4492                         my $action_print = $action ;
4493                         if (defined $opts{-action_extra}) {
4494                                 $action_print = $cgi->a({-href => href(action=>$action)},
4495                                         $action);
4496                         }
4497                         print " / $action_print";
4498                 }
4499                 if (defined $opts{-action_extra}) {
4500                         print " / $opts{-action_extra}";
4501                 }
4502                 print "\n";
4503         } elsif (defined $project_filter) {
4504                 print_nav_breadcrumbs_path(split '/', $project_filter);
4505         }
4506 }
4507
4508 sub print_search_form {
4509         if (!defined $searchtext) {
4510                 $searchtext = "";
4511         }
4512         my $search_hash;
4513         if (defined $hash_base) {
4514                 $search_hash = $hash_base;
4515         } elsif (defined $hash) {
4516                 $search_hash = $hash;
4517         } else {
4518                 $search_hash = "HEAD";
4519         }
4520         my $action = $my_uri;
4521         my $use_pathinfo = gitweb_check_feature('pathinfo');
4522         if ($use_pathinfo) {
4523                 $action .= "/".esc_url($project);
4524         }
4525         print $cgi->start_form(-method => "get", -action => $action) .
4526               "<div class=\"search\">\n" .
4527               (!$use_pathinfo &&
4528               $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
4529               $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
4530               $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
4531               $cgi->popup_menu(-name => 'st', -default => 'commit',
4532                                -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
4533               " " . $cgi->a({-href => href(action=>"search_help"),
4534                              -title => "search help" }, "?") . " search:\n",
4535               $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
4536               "<span title=\"Extended regular expression\">" .
4537               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
4538                              -checked => $search_use_regexp) .
4539               "</span>" .
4540               "</div>" .
4541               $cgi->end_form() . "\n";
4542 }
4543
4544 sub git_header_html {
4545         my $status = shift || "200 OK";
4546         my $expires = shift;
4547         my %opts = @_;
4548
4549         my $title = get_page_title();
4550         my $content_type = get_content_type_html();
4551         print $cgi->header(-type=>$content_type, -charset => 'utf-8',
4552                            -status=> $status, -expires => $expires)
4553                 unless ($opts{'-no_http_header'});
4554         my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
4555         print <<EOF;
4556 <?xml version="1.0" encoding="utf-8"?>
4557 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
4558 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
4559 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
4560 <!-- git core binaries version $git_version -->
4561 <head>
4562 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
4563 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
4564 <meta name="robots" content="index, nofollow"/>
4565 <title>$title</title>
4566 EOF
4567         # the stylesheet, favicon etc urls won't work correctly with path_info
4568         # unless we set the appropriate base URL
4569         if ($ENV{'PATH_INFO'}) {
4570                 print "<base href=\"".esc_url($base_url)."\" />\n";
4571         }
4572         print_header_links($status);
4573
4574         if (defined $site_html_head_string) {
4575                 print to_utf8($site_html_head_string);
4576         }
4577
4578         print "</head>\n" .
4579               "<body>\n";
4580
4581         if (defined $site_header && -f $site_header) {
4582                 insert_file($site_header);
4583         }
4584
4585         print "<div class=\"page_header\">\n";
4586         if (defined $logo) {
4587                 print $cgi->a({-href => esc_url($logo_url),
4588                                -title => $logo_label},
4589                               $cgi->img({-src => esc_url($logo),
4590                                          -width => 72, -height => 27,
4591                                          -alt => "git",
4592                                          -class => "logo"}));
4593         }
4594         print_nav_breadcrumbs(%opts);
4595         print "</div>\n";
4596
4597         my $have_search = gitweb_check_feature('search');
4598         if (defined $project && $have_search) {
4599                 print_search_form();
4600         }
4601 }
4602
4603 sub git_footer_html {
4604         my $feed_class = 'rss_logo';
4605
4606         print "<div class=\"page_footer\">\n";
4607         if (defined $project) {
4608                 my $descr = git_get_project_description($project);
4609                 if (defined $descr) {
4610                         print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
4611                 }
4612
4613                 my %href_params = get_feed_info();
4614                 if (!%href_params) {
4615                         $feed_class .= ' generic';
4616                 }
4617                 $href_params{'-title'} ||= 'log';
4618
4619                 foreach my $format (qw(RSS Atom)) {
4620                         $href_params{'action'} = lc($format);
4621                         print $cgi->a({-href => href(%href_params),
4622                                       -title => "$href_params{'-title'} $format feed",
4623                                       -class => $feed_class}, $format)."\n";
4624                 }
4625
4626         } else {
4627                 print $cgi->a({-href => href(project=>undef, action=>"opml",
4628                                              project_filter => $project_filter),
4629                               -class => $feed_class}, "OPML") . " ";
4630                 print $cgi->a({-href => href(project=>undef, action=>"project_index",
4631                                              project_filter => $project_filter),
4632                               -class => $feed_class}, "TXT") . "\n";
4633         }
4634         print "</div>\n"; # class="page_footer"
4635
4636         if (defined $t0 && gitweb_check_feature('timed')) {
4637                 print "<div id=\"generating_info\">\n";
4638                 print 'This page took '.
4639                       '<span id="generating_time" class="time_span">'.
4640                       tv_interval($t0, [ gettimeofday() ]).
4641                       ' seconds </span>'.
4642                       ' and '.
4643                       '<span id="generating_cmd">'.
4644                       $number_of_git_cmds.
4645                       '</span> git commands '.
4646                       " to generate.\n";
4647                 print "</div>\n"; # class="page_footer"
4648         }
4649
4650         if (defined $site_footer && -f $site_footer) {
4651                 insert_file($site_footer);
4652         }
4653
4654         print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
4655         if (defined $action &&
4656             $action eq 'blame_incremental') {
4657                 print qq!<script type="text/javascript">\n!.
4658                       qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
4659                       qq!           "!. href() .qq!");\n!.
4660                       qq!</script>\n!;
4661         } else {
4662                 my ($jstimezone, $tz_cookie, $datetime_class) =
4663                         gitweb_get_feature('javascript-timezone');
4664
4665                 print qq!<script type="text/javascript">\n!.
4666                       qq!window.onload = function () {\n!;
4667                 if (gitweb_check_feature('javascript-actions')) {
4668                         print qq!       fixLinks();\n!;
4669                 }
4670                 if ($jstimezone && $tz_cookie && $datetime_class) {
4671                         print qq!       var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
4672                               qq!       onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
4673                 }
4674                 print qq!};\n!.
4675                       qq!</script>\n!;
4676         }
4677
4678         print "</body>\n" .
4679               "</html>";
4680 }
4681
4682 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
4683 # Example: die_error(404, 'Hash not found')
4684 # By convention, use the following status codes (as defined in RFC 2616):
4685 # 400: Invalid or missing CGI parameters, or
4686 #      requested object exists but has wrong type.
4687 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
4688 #      this server or project.
4689 # 404: Requested object/revision/project doesn't exist.
4690 # 500: The server isn't configured properly, or
4691 #      an internal error occurred (e.g. failed assertions caused by bugs), or
4692 #      an unknown error occurred (e.g. the git binary died unexpectedly).
4693 # 503: The server is currently unavailable (because it is overloaded,
4694 #      or down for maintenance).  Generally, this is a temporary state.
4695 sub die_error {
4696         my $status = shift || 500;
4697         my $error = esc_html(shift) || "Internal Server Error";
4698         my $extra = shift;
4699         my %opts = @_;
4700
4701         my %http_responses = (
4702                 400 => '400 Bad Request',
4703                 403 => '403 Forbidden',
4704                 404 => '404 Not Found',
4705                 500 => '500 Internal Server Error',
4706                 503 => '503 Service Unavailable',
4707         );
4708         git_header_html($http_responses{$status}, undef, %opts);
4709         print <<EOF;
4710 <div class="page_body">
4711 <br /><br />
4712 $status - $error
4713 <br />
4714 EOF
4715         if (defined $extra) {
4716                 print "<hr />\n" .
4717                       "$extra\n";
4718         }
4719         print "</div>\n";
4720
4721         git_footer_html();
4722         goto DONE_GITWEB
4723                 unless ($opts{'-error_handler'});
4724 }
4725
4726 ## ----------------------------------------------------------------------
4727 ## functions printing or outputting HTML: navigation
4728
4729 sub git_print_page_nav {
4730         my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
4731         $extra = '' if !defined $extra; # pager or formats
4732
4733         my @navs = qw(summary shortlog log commit commitdiff tree);
4734         if ($suppress) {
4735                 @navs = grep { $_ ne $suppress } @navs;
4736         }
4737
4738         my %arg = map { $_ => {action=>$_} } @navs;
4739         if (defined $head) {
4740                 for (qw(commit commitdiff)) {
4741                         $arg{$_}{'hash'} = $head;
4742                 }
4743                 if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
4744                         for (qw(shortlog log)) {
4745                                 $arg{$_}{'hash'} = $head;
4746                         }
4747                 }
4748         }
4749
4750         $arg{'tree'}{'hash'} = $treehead if defined $treehead;
4751         $arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
4752
4753         my @actions = gitweb_get_feature('actions');
4754         my %repl = (
4755                 '%' => '%',
4756                 'n' => $project,         # project name
4757                 'f' => $git_dir,         # project path within filesystem
4758                 'h' => $treehead || '',  # current hash ('h' parameter)
4759                 'b' => $treebase || '',  # hash base ('hb' parameter)
4760         );
4761         while (@actions) {
4762                 my ($label, $link, $pos) = splice(@actions,0,3);
4763                 # insert
4764                 @navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
4765                 # munch munch
4766                 $link =~ s/%([%nfhb])/$repl{$1}/g;
4767                 $arg{$label}{'_href'} = $link;
4768         }
4769
4770         print "<div class=\"page_nav\">\n" .
4771                 (join " | ",
4772                  map { $_ eq $current ?
4773                        $_ : $cgi->a({-href => ($arg{$_}{_href} ? $arg{$_}{_href} : href(%{$arg{$_}}))}, "$_")
4774                  } @navs);
4775         print "<br/>\n$extra<br/>\n" .
4776               "</div>\n";
4777 }
4778
4779 # returns a submenu for the nagivation of the refs views (tags, heads,
4780 # remotes) with the current view disabled and the remotes view only
4781 # available if the feature is enabled
4782 sub format_ref_views {
4783         my ($current) = @_;
4784         my @ref_views = qw{tags heads};
4785         push @ref_views, 'remotes' if gitweb_check_feature('remote_heads');
4786         return join " | ", map {
4787                 $_ eq $current ? $_ :
4788                 $cgi->a({-href => href(action=>$_)}, $_)
4789         } @ref_views
4790 }
4791
4792 sub format_paging_nav {
4793         my ($action, $page, $has_next_link) = @_;
4794         my $paging_nav;
4795
4796
4797         if ($page > 0) {
4798                 $paging_nav .=
4799                         $cgi->a({-href => href(-replay=>1, page=>undef)}, "first") .
4800                         " &sdot; " .
4801                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
4802                                  -accesskey => "p", -title => "Alt-p"}, "prev");
4803         } else {
4804                 $paging_nav .= "first &sdot; prev";
4805         }
4806
4807         if ($has_next_link) {
4808                 $paging_nav .= " &sdot; " .
4809                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
4810                                  -accesskey => "n", -title => "Alt-n"}, "next");
4811         } else {
4812                 $paging_nav .= " &sdot; next";
4813         }
4814
4815         return $paging_nav;
4816 }
4817
4818 ## ......................................................................
4819 ## functions printing or outputting HTML: div
4820
4821 sub git_print_header_div {
4822         my ($action, $title, $hash, $hash_base) = @_;
4823         my %args = ();
4824
4825         $args{'action'} = $action;
4826         $args{'hash'} = $hash if $hash;
4827         $args{'hash_base'} = $hash_base if $hash_base;
4828
4829         print "<div class=\"header\">\n" .
4830               $cgi->a({-href => href(%args), -class => "title"},
4831               $title ? $title : $action) .
4832               "\n</div>\n";
4833 }
4834
4835 sub format_repo_url {
4836         my ($name, $url) = @_;
4837         return "<tr class=\"metadata_url\"><td>$name</td><td>$url</td></tr>\n";
4838 }
4839
4840 # Group output by placing it in a DIV element and adding a header.
4841 # Options for start_div() can be provided by passing a hash reference as the
4842 # first parameter to the function.
4843 # Options to git_print_header_div() can be provided by passing an array
4844 # reference. This must follow the options to start_div if they are present.
4845 # The content can be a scalar, which is output as-is, a scalar reference, which
4846 # is output after html escaping, an IO handle passed either as *handle or
4847 # *handle{IO}, or a function reference. In the latter case all following
4848 # parameters will be taken as argument to the content function call.
4849 sub git_print_section {
4850         my ($div_args, $header_args, $content);
4851         my $arg = shift;
4852         if (ref($arg) eq 'HASH') {
4853                 $div_args = $arg;
4854                 $arg = shift;
4855         }
4856         if (ref($arg) eq 'ARRAY') {
4857                 $header_args = $arg;
4858                 $arg = shift;
4859         }
4860         $content = $arg;
4861
4862         print $cgi->start_div($div_args);
4863         git_print_header_div(@$header_args);
4864
4865         if (ref($content) eq 'CODE') {
4866                 $content->(@_);
4867         } elsif (ref($content) eq 'SCALAR') {
4868                 print esc_html($$content);
4869         } elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
4870                 while (<$content>) {
4871                         print to_utf8($_);
4872                 }
4873         } elsif (!ref($content) && defined($content)) {
4874                 print $content;
4875         }
4876
4877         print $cgi->end_div;
4878 }
4879
4880 sub format_timestamp_html {
4881         my $date = shift;
4882         my $useatnight = shift;
4883         defined($useatnight) or $useatnight = 1;
4884         my $strtime = $date->{'rfc2822'};
4885
4886         my (undef, undef, $datetime_class) =
4887                 gitweb_get_feature('javascript-timezone');
4888         if ($datetime_class) {
4889                 $strtime = qq!<span class="$datetime_class">$strtime</span>!;
4890         }
4891
4892         my $localtime_format = '(%02d:%02d %s)';
4893         if ($useatnight && $date->{'hour_local'} < 6) {
4894                 $localtime_format = '(<span class="atnight">%02d:%02d</span> %s)';
4895         }
4896         $strtime .= ' ' .
4897                     sprintf($localtime_format,
4898                             $date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
4899
4900         return $strtime;
4901 }
4902
4903 # Outputs the author name and date in long form
4904 sub git_print_authorship {
4905         my $co = shift;
4906         my %opts = @_;
4907         my $tag = $opts{-tag} || 'div';
4908         my $author = $co->{'author_name'};
4909
4910         my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
4911         print "<$tag class=\"author_date\">" .
4912               format_search_author($author, "author", esc_html($author)) .
4913               " [".format_timestamp_html(\%ad)."]".
4914               git_get_avatar($co->{'author_email'}, -pad_before => 1) .
4915               "</$tag>\n";
4916 }
4917
4918 # Outputs table rows containing the full author or committer information,
4919 # in the format expected for 'commit' view (& similar).
4920 # Parameters are a commit hash reference, followed by the list of people
4921 # to output information for. If the list is empty it defaults to both
4922 # author and committer.
4923 sub git_print_authorship_rows {
4924         my $co = shift;
4925         # too bad we can't use @people = @_ || ('author', 'committer')
4926         my @people = @_;
4927         @people = ('author', 'committer') unless @people;
4928         foreach my $who (@people) {
4929                 my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
4930                 print "<tr><td>$who</td><td>" .
4931                       format_search_author($co->{"${who}_name"}, $who,
4932                                            esc_html($co->{"${who}_name"})) . " " .
4933                       format_search_author($co->{"${who}_email"}, $who,
4934                                            esc_html("<" . $co->{"${who}_email"} . ">")) .
4935                       "</td><td rowspan=\"2\">" .
4936                       git_get_avatar($co->{"${who}_email"}, -size => 'double') .
4937                       "</td></tr>\n" .
4938                       "<tr>" .
4939                       "<td></td><td>" .
4940                       format_timestamp_html(\%wd) .
4941                       "</td>" .
4942                       "</tr>\n";
4943         }
4944 }
4945
4946 sub git_print_page_path {
4947         my $name = shift;
4948         my $type = shift;
4949         my $hb = shift;
4950
4951
4952         print "<div class=\"page_path\">";
4953         print $cgi->a({-href => href(action=>"tree", hash_base=>$hb),
4954                       -title => 'tree root'}, to_utf8("[$project]"));
4955         print " / ";
4956         if (defined $name) {
4957                 my @dirname = split '/', $name;
4958                 my $basename = pop @dirname;
4959                 my $fullname = '';
4960
4961                 foreach my $dir (@dirname) {
4962                         $fullname .= ($fullname ? '/' : '') . $dir;
4963                         print $cgi->a({-href => href(action=>"tree", file_name=>$fullname,
4964                                                      hash_base=>$hb),
4965                                       -title => $fullname}, esc_path($dir));
4966                         print " / ";
4967                 }
4968                 if (defined $type && $type eq 'blob') {
4969                         print $cgi->a({-href => href(action=>"blob_plain", file_name=>$file_name,
4970                                                      hash_base=>$hb),
4971                                       -title => $name}, esc_path($basename));
4972                 } elsif (defined $type && $type eq 'tree') {
4973                         print $cgi->a({-href => href(action=>"tree", file_name=>$file_name,
4974                                                      hash_base=>$hb),
4975                                       -title => $name}, esc_path($basename));
4976                         print " / ";
4977                 } else {
4978                         print esc_path($basename);
4979                 }
4980         }
4981         print "<br/></div>\n";
4982 }
4983
4984 sub git_print_log {
4985         my $log = shift;
4986         my %opts = @_;
4987
4988         if ($opts{'-remove_title'}) {
4989                 # remove title, i.e. first line of log
4990                 shift @$log;
4991         }
4992         # remove leading empty lines
4993         while (defined $log->[0] && $log->[0] eq "") {
4994                 shift @$log;
4995         }
4996
4997         # print log
4998         my $skip_blank_line = 0;
4999         foreach my $line (@$log) {
5000                 if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
5001                         if (! $opts{'-remove_signoff'}) {
5002                                 print "<span class=\"signoff\">" . esc_html($line) . "</span><br/>\n";
5003                                 $skip_blank_line = 1;
5004                         }
5005                         next;
5006                 }
5007
5008                 if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
5009                         if (! $opts{'-remove_signoff'}) {
5010                                 print "<span class=\"signoff\">" . esc_html($1) . ": " .
5011                                         "<a href=\"" . esc_html($2) . "\">" . esc_html($2) . "</a>" .
5012                                         "</span><br/>\n";
5013                                 $skip_blank_line = 1;
5014                         }
5015                         next;
5016                 }
5017
5018                 # print only one empty line
5019                 # do not print empty line after signoff
5020                 if ($line eq "") {
5021                         next if ($skip_blank_line);
5022                         $skip_blank_line = 1;
5023                 } else {
5024                         $skip_blank_line = 0;
5025                 }
5026
5027                 print format_log_line_html($line) . "<br/>\n";
5028         }
5029
5030         if ($opts{'-final_empty_line'}) {
5031                 # end with single empty line
5032                 print "<br/>\n" unless $skip_blank_line;
5033         }
5034 }
5035
5036 # return link target (what link points to)
5037 sub git_get_link_target {
5038         my $hash = shift;
5039         my $link_target;
5040
5041         # read link
5042         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
5043                 or return;
5044         {
5045                 local $/ = undef;
5046                 $link_target = to_utf8(scalar <$fd>);
5047         }
5048         close $fd
5049                 or return;
5050
5051         return $link_target;
5052 }
5053
5054 # given link target, and the directory (basedir) the link is in,
5055 # return target of link relative to top directory (top tree);
5056 # return undef if it is not possible (including absolute links).
5057 sub normalize_link_target {
5058         my ($link_target, $basedir) = @_;
5059
5060         # absolute symlinks (beginning with '/') cannot be normalized
5061         return if (substr($link_target, 0, 1) eq '/');
5062
5063         # normalize link target to path from top (root) tree (dir)
5064         my $path;
5065         if ($basedir) {
5066                 $path = $basedir . '/' . $link_target;
5067         } else {
5068                 # we are in top (root) tree (dir)
5069                 $path = $link_target;
5070         }
5071
5072         # remove //, /./, and /../
5073         my @path_parts;
5074         foreach my $part (split('/', $path)) {
5075                 # discard '.' and ''
5076                 next if (!$part || $part eq '.');
5077                 # handle '..'
5078                 if ($part eq '..') {
5079                         if (@path_parts) {
5080                                 pop @path_parts;
5081                         } else {
5082                                 # link leads outside repository (outside top dir)
5083                                 return;
5084                         }
5085                 } else {
5086                         push @path_parts, $part;
5087                 }
5088         }
5089         $path = join('/', @path_parts);
5090
5091         return $path;
5092 }
5093
5094 # print tree entry (row of git_tree), but without encompassing <tr> element
5095 sub git_print_tree_entry {
5096         my ($t, $basedir, $hash_base, $have_blame) = @_;
5097
5098         my %base_key = ();
5099         $base_key{'hash_base'} = $hash_base if defined $hash_base;
5100
5101         # The format of a table row is: mode list link.  Where mode is
5102         # the mode of the entry, list is the name of the entry, an href,
5103         # and link is the action links of the entry.
5104
5105         print "<td class=\"mode\">" . mode_str($t->{'mode'}) . "</td>\n";
5106         if (exists $t->{'size'}) {
5107                 print "<td class=\"size\">$t->{'size'}</td>\n";
5108         }
5109         if ($t->{'type'} eq "blob") {
5110                 print "<td class=\"list\">" .
5111                         $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5112                                                file_name=>"$basedir$t->{'name'}", %base_key),
5113                                 -class => "list"}, esc_path($t->{'name'}));
5114                 if (S_ISLNK(oct $t->{'mode'})) {
5115                         my $link_target = git_get_link_target($t->{'hash'});
5116                         if ($link_target) {
5117                                 my $norm_target = normalize_link_target($link_target, $basedir);
5118                                 if (defined $norm_target) {
5119                                         print " -> " .
5120                                               $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
5121                                                                      file_name=>$norm_target),
5122                                                        -title => $norm_target}, esc_path($link_target));
5123                                 } else {
5124                                         print " -> " . esc_path($link_target);
5125                                 }
5126                         }
5127                 }
5128                 print "</td>\n";
5129                 print "<td class=\"link\">";
5130                 print $cgi->a({-href => href(action=>"blob", hash=>$t->{'hash'},
5131                                              file_name=>"$basedir$t->{'name'}", %base_key)},
5132                               "blob");
5133                 if ($have_blame) {
5134                         print " | " .
5135                               $cgi->a({-href => href(action=>"blame", hash=>$t->{'hash'},
5136                                                      file_name=>"$basedir$t->{'name'}", %base_key)},
5137                                       "blame");
5138                 }
5139                 if (defined $hash_base) {
5140                         print " | " .
5141                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5142                                                      hash=>$t->{'hash'}, file_name=>"$basedir$t->{'name'}")},
5143                                       "history");
5144                 }
5145                 print " | " .
5146                         $cgi->a({-href => href(action=>"blob_plain", hash_base=>$hash_base,
5147                                                file_name=>"$basedir$t->{'name'}")},
5148                                 "raw");
5149                 print "</td>\n";
5150
5151         } elsif ($t->{'type'} eq "tree") {
5152                 print "<td class=\"list\">";
5153                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5154                                              file_name=>"$basedir$t->{'name'}",
5155                                              %base_key)},
5156                               esc_path($t->{'name'}));
5157                 print "</td>\n";
5158                 print "<td class=\"link\">";
5159                 print $cgi->a({-href => href(action=>"tree", hash=>$t->{'hash'},
5160                                              file_name=>"$basedir$t->{'name'}",
5161                                              %base_key)},
5162                               "tree");
5163                 if (defined $hash_base) {
5164                         print " | " .
5165                               $cgi->a({-href => href(action=>"history", hash_base=>$hash_base,
5166                                                      file_name=>"$basedir$t->{'name'}")},
5167                                       "history");
5168                 }
5169                 print "</td>\n";
5170         } else {
5171                 # unknown object: we can only present history for it
5172                 # (this includes 'commit' object, i.e. submodule support)
5173                 print "<td class=\"list\">" .
5174                       esc_path($t->{'name'}) .
5175                       "</td>\n";
5176                 print "<td class=\"link\">";
5177                 if (defined $hash_base) {
5178                         print $cgi->a({-href => href(action=>"history",
5179                                                      hash_base=>$hash_base,
5180                                                      file_name=>"$basedir$t->{'name'}")},
5181                                       "history");
5182                 }
5183                 print "</td>\n";
5184         }
5185 }
5186
5187 ## ......................................................................
5188 ## functions printing large fragments of HTML
5189
5190 # get pre-image filenames for merge (combined) diff
5191 sub fill_from_file_info {
5192         my ($diff, @parents) = @_;
5193
5194         $diff->{'from_file'} = [ ];
5195         $diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
5196         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5197                 if ($diff->{'status'}[$i] eq 'R' ||
5198                     $diff->{'status'}[$i] eq 'C') {
5199                         $diff->{'from_file'}[$i] =
5200                                 git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
5201                 }
5202         }
5203
5204         return $diff;
5205 }
5206
5207 # is current raw difftree line of file deletion
5208 sub is_deleted {
5209         my $diffinfo = shift;
5210
5211         return $diffinfo->{'to_id'} eq ('0' x 40);
5212 }
5213
5214 # does patch correspond to [previous] difftree raw line
5215 # $diffinfo  - hashref of parsed raw diff format
5216 # $patchinfo - hashref of parsed patch diff format
5217 #              (the same keys as in $diffinfo)
5218 sub is_patch_split {
5219         my ($diffinfo, $patchinfo) = @_;
5220
5221         return defined $diffinfo && defined $patchinfo
5222                 && $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
5223 }
5224
5225
5226 sub git_difftree_body {
5227         my ($difftree, $hash, @parents) = @_;
5228         my ($parent) = $parents[0];
5229         my $have_blame = gitweb_check_feature('blame');
5230         print "<div class=\"list_head\">\n";
5231         if ($#{$difftree} > 10) {
5232                 print(($#{$difftree} + 1) . " files changed:\n");
5233         }
5234         print "</div>\n";
5235
5236         print "<table class=\"" .
5237               (@parents > 1 ? "combined " : "") .
5238               "diff_tree\">\n";
5239
5240         # header only for combined diff in 'commitdiff' view
5241         my $has_header = @$difftree && @parents > 1 && $action eq 'commitdiff';
5242         if ($has_header) {
5243                 # table header
5244                 print "<thead><tr>\n" .
5245                        "<th></th><th></th>\n"; # filename, patchN link
5246                 for (my $i = 0; $i < @parents; $i++) {
5247                         my $par = $parents[$i];
5248                         print "<th>" .
5249                               $cgi->a({-href => href(action=>"commitdiff",
5250                                                      hash=>$hash, hash_parent=>$par),
5251                                        -title => 'commitdiff to parent number ' .
5252                                                   ($i+1) . ': ' . substr($par,0,7)},
5253                                       $i+1) .
5254                               "&nbsp;</th>\n";
5255                 }
5256                 print "</tr></thead>\n<tbody>\n";
5257         }
5258
5259         my $alternate = 1;
5260         my $patchno = 0;
5261         foreach my $line (@{$difftree}) {
5262                 my $diff = parsed_difftree_line($line);
5263
5264                 if ($alternate) {
5265                         print "<tr class=\"dark\">\n";
5266                 } else {
5267                         print "<tr class=\"light\">\n";
5268                 }
5269                 $alternate ^= 1;
5270
5271                 if (exists $diff->{'nparents'}) { # combined diff
5272
5273                         fill_from_file_info($diff, @parents)
5274                                 unless exists $diff->{'from_file'};
5275
5276                         if (!is_deleted($diff)) {
5277                                 # file exists in the result (child) commit
5278                                 print "<td>" .
5279                                       $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5280                                                              file_name=>$diff->{'to_file'},
5281                                                              hash_base=>$hash),
5282                                               -class => "list"}, esc_path($diff->{'to_file'})) .
5283                                       "</td>\n";
5284                         } else {
5285                                 print "<td>" .
5286                                       esc_path($diff->{'to_file'}) .
5287                                       "</td>\n";
5288                         }
5289
5290                         if ($action eq 'commitdiff') {
5291                                 # link to patch
5292                                 $patchno++;
5293                                 print "<td class=\"link\">" .
5294                                       $cgi->a({-href => href(-anchor=>"patch$patchno")},
5295                                               "patch") .
5296                                       " | " .
5297                                       "</td>\n";
5298                         }
5299
5300                         my $has_history = 0;
5301                         my $not_deleted = 0;
5302                         for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
5303                                 my $hash_parent = $parents[$i];
5304                                 my $from_hash = $diff->{'from_id'}[$i];
5305                                 my $from_path = $diff->{'from_file'}[$i];
5306                                 my $status = $diff->{'status'}[$i];
5307
5308                                 $has_history ||= ($status ne 'A');
5309                                 $not_deleted ||= ($status ne 'D');
5310
5311                                 if ($status eq 'A') {
5312                                         print "<td  class=\"link\" align=\"right\"> | </td>\n";
5313                                 } elsif ($status eq 'D') {
5314                                         print "<td class=\"link\">" .
5315                                               $cgi->a({-href => href(action=>"blob",
5316                                                                      hash_base=>$hash,
5317                                                                      hash=>$from_hash,
5318                                                                      file_name=>$from_path)},
5319                                                       "blob" . ($i+1)) .
5320                                               " | </td>\n";
5321                                 } else {
5322                                         if ($diff->{'to_id'} eq $from_hash) {
5323                                                 print "<td class=\"link nochange\">";
5324                                         } else {
5325                                                 print "<td class=\"link\">";
5326                                         }
5327                                         print $cgi->a({-href => href(action=>"blobdiff",
5328                                                                      hash=>$diff->{'to_id'},
5329                                                                      hash_parent=>$from_hash,
5330                                                                      hash_base=>$hash,
5331                                                                      hash_parent_base=>$hash_parent,
5332                                                                      file_name=>$diff->{'to_file'},
5333                                                                      file_parent=>$from_path)},
5334                                                       "diff" . ($i+1)) .
5335                                               " | </td>\n";
5336                                 }
5337                         }
5338
5339                         print "<td class=\"link\">";
5340                         if ($not_deleted) {
5341                                 print $cgi->a({-href => href(action=>"blob",
5342                                                              hash=>$diff->{'to_id'},
5343                                                              file_name=>$diff->{'to_file'},
5344                                                              hash_base=>$hash)},
5345                                               "blob");
5346                                 print " | " if ($has_history);
5347                         }
5348                         if ($has_history) {
5349                                 print $cgi->a({-href => href(action=>"history",
5350                                                              file_name=>$diff->{'to_file'},
5351                                                              hash_base=>$hash)},
5352                                               "history");
5353                         }
5354                         print "</td>\n";
5355
5356                         print "</tr>\n";
5357                         next; # instead of 'else' clause, to avoid extra indent
5358                 }
5359                 # else ordinary diff
5360
5361                 my ($to_mode_oct, $to_mode_str, $to_file_type);
5362                 my ($from_mode_oct, $from_mode_str, $from_file_type);
5363                 if ($diff->{'to_mode'} ne ('0' x 6)) {
5364                         $to_mode_oct = oct $diff->{'to_mode'};
5365                         if (S_ISREG($to_mode_oct)) { # only for regular file
5366                                 $to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
5367                         }
5368                         $to_file_type = file_type($diff->{'to_mode'});
5369                 }
5370                 if ($diff->{'from_mode'} ne ('0' x 6)) {
5371                         $from_mode_oct = oct $diff->{'from_mode'};
5372                         if (S_ISREG($from_mode_oct)) { # only for regular file
5373                                 $from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
5374                         }
5375                         $from_file_type = file_type($diff->{'from_mode'});
5376                 }
5377
5378                 if ($diff->{'status'} eq "A") { # created
5379                         my $mode_chng = "<span class=\"file_status new\">[new $to_file_type";
5380                         $mode_chng   .= " with mode: $to_mode_str" if $to_mode_str;
5381                         $mode_chng   .= "]</span>";
5382                         print "<td>";
5383                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5384                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5385                                       -class => "list"}, esc_path($diff->{'file'}));
5386                         print "</td>\n";
5387                         print "<td>$mode_chng</td>\n";
5388                         print "<td class=\"link\">";
5389                         if ($action eq 'commitdiff') {
5390                                 # link to patch
5391                                 $patchno++;
5392                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5393                                               "patch") .
5394                                       " | ";
5395                         }
5396                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5397                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5398                                       "blob");
5399                         print "</td>\n";
5400
5401                 } elsif ($diff->{'status'} eq "D") { # deleted
5402                         my $mode_chng = "<span class=\"file_status deleted\">[deleted $from_file_type]</span>";
5403                         print "<td>";
5404                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5405                                                      hash_base=>$parent, file_name=>$diff->{'file'}),
5406                                        -class => "list"}, esc_path($diff->{'file'}));
5407                         print "</td>\n";
5408                         print "<td>$mode_chng</td>\n";
5409                         print "<td class=\"link\">";
5410                         if ($action eq 'commitdiff') {
5411                                 # link to patch
5412                                 $patchno++;
5413                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5414                                               "patch") .
5415                                       " | ";
5416                         }
5417                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'from_id'},
5418                                                      hash_base=>$parent, file_name=>$diff->{'file'})},
5419                                       "blob") . " | ";
5420                         if ($have_blame) {
5421                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$parent,
5422                                                              file_name=>$diff->{'file'})},
5423                                               "blame") . " | ";
5424                         }
5425                         print $cgi->a({-href => href(action=>"history", hash_base=>$parent,
5426                                                      file_name=>$diff->{'file'})},
5427                                       "history");
5428                         print "</td>\n";
5429
5430                 } elsif ($diff->{'status'} eq "M" || $diff->{'status'} eq "T") { # modified, or type changed
5431                         my $mode_chnge = "";
5432                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5433                                 $mode_chnge = "<span class=\"file_status mode_chnge\">[changed";
5434                                 if ($from_file_type ne $to_file_type) {
5435                                         $mode_chnge .= " from $from_file_type to $to_file_type";
5436                                 }
5437                                 if (($from_mode_oct & 0777) != ($to_mode_oct & 0777)) {
5438                                         if ($from_mode_str && $to_mode_str) {
5439                                                 $mode_chnge .= " mode: $from_mode_str->$to_mode_str";
5440                                         } elsif ($to_mode_str) {
5441                                                 $mode_chnge .= " mode: $to_mode_str";
5442                                         }
5443                                 }
5444                                 $mode_chnge .= "]</span>\n";
5445                         }
5446                         print "<td>";
5447                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5448                                                      hash_base=>$hash, file_name=>$diff->{'file'}),
5449                                       -class => "list"}, esc_path($diff->{'file'}));
5450                         print "</td>\n";
5451                         print "<td>$mode_chnge</td>\n";
5452                         print "<td class=\"link\">";
5453                         if ($action eq 'commitdiff') {
5454                                 # link to patch
5455                                 $patchno++;
5456                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5457                                               "patch") .
5458                                       " | ";
5459                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5460                                 # "commit" view and modified file (not onlu mode changed)
5461                                 print $cgi->a({-href => href(action=>"blobdiff",
5462                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5463                                                              hash_base=>$hash, hash_parent_base=>$parent,
5464                                                              file_name=>$diff->{'file'})},
5465                                               "diff") .
5466                                       " | ";
5467                         }
5468                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5469                                                      hash_base=>$hash, file_name=>$diff->{'file'})},
5470                                        "blob") . " | ";
5471                         if ($have_blame) {
5472                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5473                                                              file_name=>$diff->{'file'})},
5474                                               "blame") . " | ";
5475                         }
5476                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5477                                                      file_name=>$diff->{'file'})},
5478                                       "history");
5479                         print "</td>\n";
5480
5481                 } elsif ($diff->{'status'} eq "R" || $diff->{'status'} eq "C") { # renamed or copied
5482                         my %status_name = ('R' => 'moved', 'C' => 'copied');
5483                         my $nstatus = $status_name{$diff->{'status'}};
5484                         my $mode_chng = "";
5485                         if ($diff->{'from_mode'} != $diff->{'to_mode'}) {
5486                                 # mode also for directories, so we cannot use $to_mode_str
5487                                 $mode_chng = sprintf(", mode: %04o", $to_mode_oct & 0777);
5488                         }
5489                         print "<td>" .
5490                               $cgi->a({-href => href(action=>"blob", hash_base=>$hash,
5491                                                      hash=>$diff->{'to_id'}, file_name=>$diff->{'to_file'}),
5492                                       -class => "list"}, esc_path($diff->{'to_file'})) . "</td>\n" .
5493                               "<td><span class=\"file_status $nstatus\">[$nstatus from " .
5494                               $cgi->a({-href => href(action=>"blob", hash_base=>$parent,
5495                                                      hash=>$diff->{'from_id'}, file_name=>$diff->{'from_file'}),
5496                                       -class => "list"}, esc_path($diff->{'from_file'})) .
5497                               " with " . (int $diff->{'similarity'}) . "% similarity$mode_chng]</span></td>\n" .
5498                               "<td class=\"link\">";
5499                         if ($action eq 'commitdiff') {
5500                                 # link to patch
5501                                 $patchno++;
5502                                 print $cgi->a({-href => href(-anchor=>"patch$patchno")},
5503                                               "patch") .
5504                                       " | ";
5505                         } elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
5506                                 # "commit" view and modified file (not only pure rename or copy)
5507                                 print $cgi->a({-href => href(action=>"blobdiff",
5508                                                              hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
5509                                                              hash_base=>$hash, hash_parent_base=>$parent,
5510                                                              file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
5511                                               "diff") .
5512                                       " | ";
5513                         }
5514                         print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
5515                                                      hash_base=>$parent, file_name=>$diff->{'to_file'})},
5516                                       "blob") . " | ";
5517                         if ($have_blame) {
5518                                 print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
5519                                                              file_name=>$diff->{'to_file'})},
5520                                               "blame") . " | ";
5521                         }
5522                         print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
5523                                                     file_name=>$diff->{'to_file'})},
5524                                       "history");
5525                         print "</td>\n";
5526
5527                 } # we should not encounter Unmerged (U) or Unknown (X) status
5528                 print "</tr>\n";
5529         }
5530         print "</tbody>" if $has_header;
5531         print "</table>\n";
5532 }
5533
5534 # Print context lines and then rem/add lines in a side-by-side manner.
5535 sub print_sidebyside_diff_lines {
5536         my ($ctx, $rem, $add) = @_;
5537
5538         # print context block before add/rem block
5539         if (@$ctx) {
5540                 print join '',
5541                         '<div class="chunk_block ctx">',
5542                                 '<div class="old">',
5543                                 @$ctx,
5544                                 '</div>',
5545                                 '<div class="new">',
5546                                 @$ctx,
5547                                 '</div>',
5548                         '</div>';
5549         }
5550
5551         if (!@$add) {
5552                 # pure removal
5553                 print join '',
5554                         '<div class="chunk_block rem">',
5555                                 '<div class="old">',
5556                                 @$rem,
5557                                 '</div>',
5558                         '</div>';
5559         } elsif (!@$rem) {
5560                 # pure addition
5561                 print join '',
5562                         '<div class="chunk_block add">',
5563                                 '<div class="new">',
5564                                 @$add,
5565                                 '</div>',
5566                         '</div>';
5567         } else {
5568                 print join '',
5569                         '<div class="chunk_block chg">',
5570                                 '<div class="old">',
5571                                 @$rem,
5572                                 '</div>',
5573                                 '<div class="new">',
5574                                 @$add,
5575                                 '</div>',
5576                         '</div>';
5577         }
5578 }
5579
5580 # Print context lines and then rem/add lines in inline manner.
5581 sub print_inline_diff_lines {
5582         my ($ctx, $rem, $add) = @_;
5583
5584         print @$ctx, @$rem, @$add;
5585 }
5586
5587 # Format removed and added line, mark changed part and HTML-format them.
5588 # Implementation is based on contrib/diff-highlight
5589 sub format_rem_add_lines_pair {
5590         my ($rem, $add, $num_parents) = @_;
5591
5592         # We need to untabify lines before split()'ing them;
5593         # otherwise offsets would be invalid.
5594         chomp $rem;
5595         chomp $add;
5596         $rem = untabify($rem);
5597         $add = untabify($add);
5598
5599         my @rem = split(//, $rem);
5600         my @add = split(//, $add);
5601         my ($esc_rem, $esc_add);
5602         # Ignore leading +/- characters for each parent.
5603         my ($prefix_len, $suffix_len) = ($num_parents, 0);
5604         my ($prefix_has_nonspace, $suffix_has_nonspace);
5605
5606         my $shorter = (@rem < @add) ? @rem : @add;
5607         while ($prefix_len < $shorter) {
5608                 last if ($rem[$prefix_len] ne $add[$prefix_len]);
5609
5610                 $prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
5611                 $prefix_len++;
5612         }
5613
5614         while ($prefix_len + $suffix_len < $shorter) {
5615                 last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
5616
5617                 $suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
5618                 $suffix_len++;
5619         }
5620
5621         # Mark lines that are different from each other, but have some common
5622         # part that isn't whitespace.  If lines are completely different, don't
5623         # mark them because that would make output unreadable, especially if
5624         # diff consists of multiple lines.
5625         if ($prefix_has_nonspace || $suffix_has_nonspace) {
5626                 $esc_rem = esc_html_hl_regions($rem, 'marked',
5627                         [$prefix_len, @rem - $suffix_len], -nbsp=>1);
5628                 $esc_add = esc_html_hl_regions($add, 'marked',
5629                         [$prefix_len, @add - $suffix_len], -nbsp=>1);
5630         } else {
5631                 $esc_rem = esc_html($rem, -nbsp=>1);
5632                 $esc_add = esc_html($add, -nbsp=>1);
5633         }
5634
5635         return format_diff_line(\$esc_rem, 'rem'),
5636                format_diff_line(\$esc_add, 'add');
5637 }
5638
5639 # HTML-format diff context, removed and added lines.
5640 sub format_ctx_rem_add_lines {
5641         my ($ctx, $rem, $add, $num_parents) = @_;
5642         my (@new_ctx, @new_rem, @new_add);
5643         my $can_highlight = 0;
5644         my $is_combined = ($num_parents > 1);
5645
5646         # Highlight if every removed line has a corresponding added line.
5647         if (@$add > 0 && @$add == @$rem) {
5648                 $can_highlight = 1;
5649
5650                 # Highlight lines in combined diff only if the chunk contains
5651                 # diff between the same version, e.g.
5652                 #
5653                 #    - a
5654                 #   -  b
5655                 #    + c
5656                 #   +  d
5657                 #
5658                 # Otherwise the highlightling would be confusing.
5659                 if ($is_combined) {
5660                         for (my $i = 0; $i < @$add; $i++) {
5661                                 my $prefix_rem = substr($rem->[$i], 0, $num_parents);
5662                                 my $prefix_add = substr($add->[$i], 0, $num_parents);
5663
5664                                 $prefix_rem =~ s/-/+/g;
5665
5666                                 if ($prefix_rem ne $prefix_add) {
5667                                         $can_highlight = 0;
5668                                         last;
5669                                 }
5670                         }
5671                 }
5672         }
5673
5674         if ($can_highlight) {
5675                 for (my $i = 0; $i < @$add; $i++) {
5676                         my ($line_rem, $line_add) = format_rem_add_lines_pair(
5677                                 $rem->[$i], $add->[$i], $num_parents);
5678                         push @new_rem, $line_rem;
5679                         push @new_add, $line_add;
5680                 }
5681         } else {
5682                 @new_rem = map { format_diff_line($_, 'rem') } @$rem;
5683                 @new_add = map { format_diff_line($_, 'add') } @$add;
5684         }
5685
5686         @new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
5687
5688         return (\@new_ctx, \@new_rem, \@new_add);
5689 }
5690
5691 # Print context lines and then rem/add lines.
5692 sub print_diff_lines {
5693         my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
5694         my $is_combined = $num_parents > 1;
5695
5696         ($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
5697                 $num_parents);
5698
5699         if ($diff_style eq 'sidebyside' && !$is_combined) {
5700                 print_sidebyside_diff_lines($ctx, $rem, $add);
5701         } else {
5702                 # default 'inline' style and unknown styles
5703                 print_inline_diff_lines($ctx, $rem, $add);
5704         }
5705 }
5706
5707 sub print_diff_chunk {
5708         my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
5709         my (@ctx, @rem, @add);
5710
5711         # The class of the previous line.
5712         my $prev_class = '';
5713
5714         return unless @chunk;
5715
5716         # incomplete last line might be among removed or added lines,
5717         # or both, or among context lines: find which
5718         for (my $i = 1; $i < @chunk; $i++) {
5719                 if ($chunk[$i][0] eq 'incomplete') {
5720                         $chunk[$i][0] = $chunk[$i-1][0];
5721                 }
5722         }
5723
5724         # guardian
5725         push @chunk, ["", ""];
5726
5727         foreach my $line_info (@chunk) {
5728                 my ($class, $line) = @$line_info;
5729
5730                 # print chunk headers
5731                 if ($class && $class eq 'chunk_header') {
5732                         print format_diff_line($line, $class, $from, $to);
5733                         next;
5734                 }
5735
5736                 ## print from accumulator when have some add/rem lines or end
5737                 # of chunk (flush context lines), or when have add and rem
5738                 # lines and new block is reached (otherwise add/rem lines could
5739                 # be reordered)
5740                 if (!$class || ((@rem || @add) && $class eq 'ctx') ||
5741                     (@rem && @add && $class ne $prev_class)) {
5742                         print_diff_lines(\@ctx, \@rem, \@add,
5743                                          $diff_style, $num_parents);
5744                         @ctx = @rem = @add = ();
5745                 }
5746
5747                 ## adding lines to accumulator
5748                 # guardian value
5749                 last unless $line;
5750                 # rem, add or change
5751                 if ($class eq 'rem') {
5752                         push @rem, $line;
5753                 } elsif ($class eq 'add') {
5754                         push @add, $line;
5755                 }
5756                 # context line
5757                 if ($class eq 'ctx') {
5758                         push @ctx, $line;
5759                 }
5760
5761                 $prev_class = $class;
5762         }
5763 }
5764
5765 sub git_patchset_body {
5766         my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
5767         my ($hash_parent) = $hash_parents[0];
5768
5769         my $is_combined = (@hash_parents > 1);
5770         my $patch_idx = 0;
5771         my $patch_number = 0;
5772         my $patch_line;
5773         my $diffinfo;
5774         my $to_name;
5775         my (%from, %to);
5776         my @chunk; # for side-by-side diff
5777
5778         print "<div class=\"patchset\">\n";
5779
5780         # skip to first patch
5781         while ($patch_line = to_utf8(scalar <$fd>)) {
5782                 chomp $patch_line;
5783
5784                 last if ($patch_line =~ m/^diff /);
5785         }
5786
5787  PATCH:
5788         while ($patch_line) {
5789
5790                 # parse "git diff" header line
5791                 if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
5792                         # $1 is from_name, which we do not use
5793                         $to_name = unquote($2);
5794                         $to_name =~ s!^b/!!;
5795                 } elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
5796                         # $1 is 'cc' or 'combined', which we do not use
5797                         $to_name = unquote($2);
5798                 } else {
5799                         $to_name = undef;
5800                 }
5801
5802                 # check if current patch belong to current raw line
5803                 # and parse raw git-diff line if needed
5804                 if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
5805                         # this is continuation of a split patch
5806                         print "<div class=\"patch cont\">\n";
5807                 } else {
5808                         # advance raw git-diff output if needed
5809                         $patch_idx++ if defined $diffinfo;
5810
5811                         # read and prepare patch information
5812                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5813
5814                         # compact combined diff output can have some patches skipped
5815                         # find which patch (using pathname of result) we are at now;
5816                         if ($is_combined) {
5817                                 while ($to_name ne $diffinfo->{'to_file'}) {
5818                                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
5819                                               format_diff_cc_simplified($diffinfo, @hash_parents) .
5820                                               "</div>\n";  # class="patch"
5821
5822                                         $patch_idx++;
5823                                         $patch_number++;
5824
5825                                         last if $patch_idx > $#$difftree;
5826                                         $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5827                                 }
5828                         }
5829
5830                         # modifies %from, %to hashes
5831                         parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
5832
5833                         # this is first patch for raw difftree line with $patch_idx index
5834                         # we index @$difftree array from 0, but number patches from 1
5835                         print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n";
5836                 }
5837
5838                 # git diff header
5839                 #assert($patch_line =~ m/^diff /) if DEBUG;
5840                 #assert($patch_line !~ m!$/$!) if DEBUG; # is chomp-ed
5841                 $patch_number++;
5842                 # print "git diff" header
5843                 print format_git_diff_header_line($patch_line, $diffinfo,
5844                                                   \%from, \%to);
5845
5846                 # print extended diff header
5847                 print "<div class=\"diff extended_header\">\n";
5848         EXTENDED_HEADER:
5849                 while ($patch_line = to_utf8(scalar<$fd>)) {
5850                         chomp $patch_line;
5851
5852                         last EXTENDED_HEADER if ($patch_line =~ m/^--- |^diff /);
5853
5854                         print format_extended_diff_header_line($patch_line, $diffinfo,
5855                                                                \%from, \%to);
5856                 }
5857                 print "</div>\n"; # class="diff extended_header"
5858
5859                 # from-file/to-file diff header
5860                 if (! $patch_line) {
5861                         print "</div>\n"; # class="patch"
5862                         last PATCH;
5863                 }
5864                 next PATCH if ($patch_line =~ m/^diff /);
5865                 #assert($patch_line =~ m/^---/) if DEBUG;
5866
5867                 my $last_patch_line = $patch_line;
5868                 $patch_line = to_utf8(scalar <$fd>);
5869                 chomp $patch_line;
5870                 #assert($patch_line =~ m/^\+\+\+/) if DEBUG;
5871
5872                 print format_diff_from_to_header($last_patch_line, $patch_line,
5873                                                  $diffinfo, \%from, \%to,
5874                                                  @hash_parents);
5875
5876                 # the patch itself
5877         LINE:
5878                 while ($patch_line = to_utf8(scalar <$fd>)) {
5879                         chomp $patch_line;
5880
5881                         next PATCH if ($patch_line =~ m/^diff /);
5882
5883                         my $class = diff_line_class($patch_line, \%from, \%to);
5884
5885                         if ($class eq 'chunk_header') {
5886                                 print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
5887                                 @chunk = ();
5888                         }
5889
5890                         push @chunk, [ $class, $patch_line ];
5891                 }
5892
5893         } continue {
5894                 if (@chunk) {
5895                         print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
5896                         @chunk = ();
5897                 }
5898                 print "</div>\n"; # class="patch"
5899         }
5900
5901         # for compact combined (--cc) format, with chunk and patch simplification
5902         # the patchset might be empty, but there might be unprocessed raw lines
5903         for (++$patch_idx if $patch_number > 0;
5904              $patch_idx < @$difftree;
5905              ++$patch_idx) {
5906                 # read and prepare patch information
5907                 $diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
5908
5909                 # generate anchor for "patch" links in difftree / whatchanged part
5910                 print "<div class=\"patch\" id=\"patch". ($patch_idx+1) ."\">\n" .
5911                       format_diff_cc_simplified($diffinfo, @hash_parents) .
5912                       "</div>\n";  # class="patch"
5913
5914                 $patch_number++;
5915         }
5916
5917         if ($patch_number == 0) {
5918                 if (@hash_parents > 1) {
5919                         print "<div class=\"diff nodifferences\">Trivial merge</div>\n";
5920                 } else {
5921                         print "<div class=\"diff nodifferences\">No differences found</div>\n";
5922                 }
5923         }
5924
5925         print "</div>\n"; # class="patchset"
5926 }
5927
5928 # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
5929
5930 sub git_project_search_form {
5931         my ($searchtext, $search_use_regexp) = @_;
5932
5933         my $limit = '';
5934         if ($project_filter) {
5935                 $limit = " in '$project_filter'";
5936         }
5937
5938         print "<div class=\"projsearch\">\n";
5939         print $cgi->start_form(-method => 'get', -action => $my_uri) .
5940               $cgi->hidden(-name => 'a', -value => 'project_list')  . "\n";
5941         print $cgi->hidden(-name => 'pf', -value => $project_filter). "\n"
5942                 if (defined $project_filter);
5943         print $cgi->textfield(-name => 's', -value => $searchtext,
5944                               -title => "Search project by name and description$limit",
5945                               -size => 60) . "\n" .
5946               "<span title=\"Extended regular expression\">" .
5947               $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
5948                              -checked => $search_use_regexp) .
5949               "</span>\n" .
5950               $cgi->submit(-name => 'btnS', -value => 'Search') .
5951               $cgi->end_form() . "\n" .
5952               "<span class=\"projectlist_link\">" .
5953               $cgi->a({-href => href(project => undef, searchtext => undef,
5954                                      action => 'project_list',
5955                                      project_filter => $project_filter)},
5956                       esc_html("List all projects$limit")) . "</span><br />\n";
5957         print "<span class=\"projectlist_link\">" .
5958               $cgi->a({-href => href(project => undef, searchtext => undef,
5959                                      action => 'project_list',
5960                                      project_filter => undef)},
5961                       esc_html("List all projects")) . "</span>\n" if $project_filter;
5962         print "</div>\n";
5963 }
5964
5965 # entry for given @keys needs filling if at least one of keys in list
5966 # is not present in %$project_info
5967 sub project_info_needs_filling {
5968         my ($project_info, @keys) = @_;
5969
5970         # return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
5971         foreach my $key (@keys) {
5972                 if (!exists $project_info->{$key}) {
5973                         return 1;
5974                 }
5975         }
5976         return;
5977 }
5978
5979 sub git_cache_file_format {
5980         return GITWEB_CACHE_FORMAT .
5981                 (gitweb_check_feature('forks') ? " (forks)" : "");
5982 }
5983
5984 sub git_retrieve_cache_file {
5985         my $cache_file = shift;
5986
5987         use Storable qw(retrieve);
5988
5989         if ((my $dump = eval { retrieve($cache_file) })) {
5990                 return $$dump[1] if
5991                         ref($dump) eq 'ARRAY' &&
5992                         @$dump == 2 &&
5993                         ref($$dump[1]) eq 'ARRAY' &&
5994                         @{$$dump[1]} == 2 &&
5995                         ref(${$$dump[1]}[0]) eq 'ARRAY' &&
5996                         ref(${$$dump[1]}[1]) eq 'HASH' &&
5997                         $$dump[0] eq git_cache_file_format();
5998         }
5999
6000         return undef;
6001 }
6002
6003 sub git_store_cache_file {
6004         my ($cache_file, $cachedata) = @_;
6005
6006         use File::Basename qw(dirname);
6007         use File::stat;
6008         use POSIX qw(:fcntl_h);
6009         use Storable qw(store_fd);
6010
6011         my $result = undef;
6012         my $cache_d = dirname($cache_file);
6013         my $mask = umask();
6014         umask($mask & ~0070) if $cache_grpshared;
6015         if ((-d $cache_d || mkdir($cache_d, $cache_grpshared ? 0770 : 0700)) &&
6016             sysopen(my $fd, "$cache_file.lock", O_WRONLY|O_CREAT|O_EXCL, $cache_grpshared ? 0660 : 0600)) {
6017                 store_fd([git_cache_file_format(), $cachedata], $fd);
6018                 close $fd;
6019                 rename "$cache_file.lock", $cache_file;
6020                 $result = stat($cache_file)->mtime;
6021         }
6022         umask($mask) if $cache_grpshared;
6023         return $result;
6024 }
6025
6026 sub verify_cached_project {
6027         my ($hashref, $path) = @_;
6028         return undef unless $path;
6029         delete $$hashref{$path}, return undef unless is_valid_project($path);
6030         return $$hashref{$path} if exists $$hashref{$path};
6031
6032         # A valid project was requested but it's not yet in the cache
6033         # Manufacture a minimal project entry (path, name, description)
6034         # Also provide age, but only if it's available via $lastactivity_file
6035
6036         my %proj = ('path' => $path);
6037         my $val = git_get_project_description($path);
6038         defined $val or $val = '';
6039         $proj{'descr_long'} = $val;
6040         $proj{'descr'} = chop_str($val, $projects_list_description_width, 5);
6041         unless ($omit_owner) {
6042                 $val = git_get_project_owner($path);
6043                 defined $val or $val = '';
6044                 $proj{'owner'} = $val;
6045         }
6046         unless ($omit_age_column) {
6047                 ($val) = git_get_last_activity($path, 1);
6048                 $proj{'age_epoch'} = $val if defined $val;
6049         }
6050         $$hashref{$path} = \%proj;
6051         return \%proj;
6052 }
6053
6054 sub git_filter_cached_projects {
6055         my ($cache, $projlist, $verify) = @_;
6056         my $hashref = $$cache[1];
6057         my $sub = $verify ?
6058                 sub {verify_cached_project($hashref, $_[0])} :
6059                 sub {$$hashref{$_[0]}};
6060         return map {
6061                 my $c = &$sub($_->{'path'});
6062                 defined $c ? ($_ = $c) : ()
6063         } @$projlist;
6064 }
6065
6066 # fills project list info (age, description, owner, category, forks, etc.)
6067 # for each project in the list, removing invalid projects from
6068 # returned list, or fill only specified info.
6069 #
6070 # Invalid projects are removed from the returned list if and only if you
6071 # ask 'age_epoch' to be filled, because they are the only fields
6072 # that run unconditionally git command that requires repository, and
6073 # therefore do always check if project repository is invalid.
6074 #
6075 # USAGE:
6076 # * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
6077 #   ensures that 'descr_long' and 'ctags' fields are filled
6078 # * @project_list = fill_project_list_info(\@project_list)
6079 #   ensures that all fields are filled (and invalid projects removed)
6080 #
6081 # NOTE: modifies $projlist, but does not remove entries from it
6082 sub fill_project_list_info {
6083         my ($projlist, @wanted_keys) = @_;
6084
6085         my $rebuild = @wanted_keys && $wanted_keys[0] eq 'rebuild-cache' && shift @wanted_keys;
6086         return fill_project_list_info_uncached($projlist, @wanted_keys)
6087                 unless $projlist_cache_lifetime && $projlist_cache_lifetime > 0;
6088
6089         use File::stat;
6090
6091         my $cache_lifetime = $rebuild ? 0 : $projlist_cache_lifetime;
6092         my $cache_file = "$cache_dir/$projlist_cache_name";
6093
6094         my @projects;
6095         my $stale = 0;
6096         my $now = time();
6097         my $cache_mtime;
6098         if ($cache_lifetime && -f $cache_file) {
6099                 $cache_mtime = stat($cache_file)->mtime;
6100                 $cache_dump = undef if $cache_mtime &&
6101                         (!$cache_dump_mtime || $cache_dump_mtime != $cache_mtime);
6102         }
6103         if (defined $cache_mtime && # caching is on and $cache_file exists
6104             $cache_mtime + $cache_lifetime*60 > $now &&
6105             ($cache_dump || ($cache_dump = git_retrieve_cache_file($cache_file)))) {
6106                 # Cache hit.
6107                 $cache_dump_mtime = $cache_mtime;
6108                 $stale = $now - $cache_mtime;
6109                 my $verify = ($action eq 'summary' || $action eq 'forks') &&
6110                         gitweb_check_feature('forks');
6111                 @projects = git_filter_cached_projects($cache_dump, $projlist, $verify);
6112
6113         } else { # Cache miss.
6114                 if (defined $cache_mtime) {
6115                         # Postpone timeout by two minutes so that we get
6116                         # enough time to do our job, or to be more exact
6117                         # make cache expire after two minutes from now.
6118                         my $time = $now - $cache_lifetime*60 + 120;
6119                         utime $time, $time, $cache_file;
6120                 }
6121                 my @all_projects = git_get_projects_list();
6122                 my %all_projects_filled = map { ( $_->{'path'} => $_ ) }
6123                         fill_project_list_info_uncached(\@all_projects);
6124                 map { $all_projects_filled{$_->{'path'}} = $_ }
6125                         filter_forks_from_projects_list([values(%all_projects_filled)])
6126                         if gitweb_check_feature('forks');
6127                 $cache_dump = [[sort {$a->{'path'} cmp $b->{'path'}} values(%all_projects_filled)],
6128                                \%all_projects_filled];
6129                 $cache_dump_mtime = git_store_cache_file($cache_file, $cache_dump);
6130                 @projects = git_filter_cached_projects($cache_dump, $projlist);
6131         }
6132
6133         if ($cache_lifetime && $stale > 0) {
6134                 print "<div class=\"stale_info\">Cached version (${stale}s old)</div>\n"
6135                         unless $shown_stale_message;
6136                 $shown_stale_message = 1;
6137         }
6138
6139         return @projects;
6140 }
6141
6142 sub fill_project_list_info_uncached {
6143         my ($projlist, @wanted_keys) = @_;
6144         my @projects;
6145         my $filter_set = sub { return @_; };
6146         if (@wanted_keys) {
6147                 my %wanted_keys = map { $_ => 1 } @wanted_keys;
6148                 $filter_set = sub { return grep { $wanted_keys{$_} } @_; };
6149         }
6150
6151         my $show_ctags = gitweb_check_feature('ctags');
6152  PROJECT:
6153         foreach my $pr (@$projlist) {
6154                 if (project_info_needs_filling($pr, $filter_set->('age_epoch'))) {
6155                         my (@activity) = git_get_last_activity($pr->{'path'});
6156                         unless (@activity) {
6157                                 next PROJECT;
6158                         }
6159                         ($pr->{'age_epoch'}) = @activity;
6160                 }
6161                 if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
6162                         my $descr = git_get_project_description($pr->{'path'}) || "";
6163                         $descr = to_utf8($descr);
6164                         $pr->{'descr_long'} = $descr;
6165                         $pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
6166                 }
6167                 if (project_info_needs_filling($pr, $filter_set->('owner'))) {
6168                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
6169                 }
6170                 if ($show_ctags &&
6171                     project_info_needs_filling($pr, $filter_set->('ctags'))) {
6172                         $pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
6173                 }
6174                 if ($projects_list_group_categories &&
6175                     project_info_needs_filling($pr, $filter_set->('category'))) {
6176                         my $cat = git_get_project_category($pr->{'path'}) ||
6177                                                            $project_list_default_category;
6178                         $pr->{'category'} = to_utf8($cat);
6179                 }
6180
6181                 push @projects, $pr;
6182         }
6183
6184         return @projects;
6185 }
6186
6187 sub sort_projects_list {
6188         my ($projlist, $order) = @_;
6189
6190         sub order_str {
6191                 my $key = shift;
6192                 return sub { $a->{$key} cmp $b->{$key} };
6193         }
6194
6195         sub order_reverse_num_then_undef {
6196                 my $key = shift;
6197                 return sub {
6198                         defined $a->{$key} ?
6199                                 (defined $b->{$key} ? $b->{$key} <=> $a->{$key} : -1) :
6200                                 (defined $b->{$key} ? 1 : 0)
6201                 };
6202         }
6203
6204         my %orderings = (
6205                 project => order_str('path'),
6206                 descr => order_str('descr_long'),
6207                 owner => order_str('owner'),
6208                 age => order_reverse_num_then_undef('age_epoch'),
6209         );
6210
6211         my $ordering = $orderings{$order};
6212         return defined $ordering ? sort $ordering @$projlist : @$projlist;
6213 }
6214
6215 # returns a hash of categories, containing the list of project
6216 # belonging to each category
6217 sub build_projlist_by_category {
6218         my ($projlist, $from, $to) = @_;
6219         my %categories;
6220
6221         $from = 0 unless defined $from;
6222         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6223
6224         for (my $i = $from; $i <= $to; $i++) {
6225                 my $pr = $projlist->[$i];
6226                 push @{$categories{ $pr->{'category'} }}, $pr;
6227         }
6228
6229         return wantarray ? %categories : \%categories;
6230 }
6231
6232 # print 'sort by' <th> element, generating 'sort by $name' replay link
6233 # if that order is not selected
6234 sub print_sort_th {
6235         print format_sort_th(@_);
6236 }
6237
6238 sub format_sort_th {
6239         my ($name, $order, $header) = @_;
6240         my $sort_th = "";
6241         $header ||= ucfirst($name);
6242
6243         if ($order eq $name) {
6244                 $sort_th .= "<th>$header</th>\n";
6245         } else {
6246                 $sort_th .= "<th>" .
6247                             $cgi->a({-href => href(-replay=>1, order=>$name),
6248                                      -class => "header"}, $header) .
6249                             "</th>\n";
6250         }
6251
6252         return $sort_th;
6253 }
6254
6255 sub git_project_list_rows {
6256         my ($projlist, $from, $to, $check_forks) = @_;
6257
6258         $from = 0 unless defined $from;
6259         $to = $#$projlist if (!defined $to || $#$projlist < $to);
6260
6261         my $now = time;
6262         my $alternate = 1;
6263         for (my $i = $from; $i <= $to; $i++) {
6264                 my $pr = $projlist->[$i];
6265
6266                 if ($alternate) {
6267                         print "<tr class=\"dark\">\n";
6268                 } else {
6269                         print "<tr class=\"light\">\n";
6270                 }
6271                 $alternate ^= 1;
6272
6273                 if ($check_forks) {
6274                         print "<td>";
6275                         if ($pr->{'forks'}) {
6276                                 my $nforks = scalar @{$pr->{'forks'}};
6277                                 if ($nforks > 0) {
6278                                         print $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks"),
6279                                                        -title => "$nforks forks"}, "+");
6280                                 } else {
6281                                         print $cgi->span({-title => "$nforks forks"}, "+");
6282                                 }
6283                         }
6284                         print "</td>\n";
6285                 }
6286                 print "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6287                                         -class => "list"},
6288                                        esc_html_match_hl($pr->{'path'}, $search_regexp)) .
6289                       "</td>\n" .
6290                       "<td>" . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary"),
6291                                         -class => "list",
6292                                         -title => $pr->{'descr_long'}},
6293                                         $search_regexp
6294                                         ? esc_html_match_hl_chopped($pr->{'descr_long'},
6295                                                                     $pr->{'descr'}, $search_regexp)
6296                                         : esc_html($pr->{'descr'})) .
6297                       "</td>\n";
6298                 unless ($omit_owner) {
6299                         print "<td><i>" . chop_and_escape_str($pr->{'owner'}, 15) . "</i></td>\n";
6300                 }
6301                 unless ($omit_age_column) {
6302                         my ($age_epoch, $age_string) = ($pr->{'age_epoch'});
6303                         $age_string = defined $age_epoch ? age_string($age_epoch, $now) : "No commits";
6304                         print "<td class=\"". age_class($age_epoch, $now) . "\">" . $age_string . "</td>\n";
6305                 }
6306                 print"<td class=\"link\">" .
6307                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"summary")}, "summary")   . " | " .
6308                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"shortlog")}, "shortlog") . " | " .
6309                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"log")}, "log") . " | " .
6310                       $cgi->a({-href => href(project=>$pr->{'path'}, action=>"tree")}, "tree") .
6311                       ($pr->{'forks'} ? " | " . $cgi->a({-href => href(project=>$pr->{'path'}, action=>"forks")}, "forks") : '') .
6312                       "</td>\n" .
6313                       "</tr>\n";
6314         }
6315 }
6316
6317 sub git_project_list_body {
6318         # actually uses global variable $project
6319         my ($projlist, $order, $from, $to, $extra, $no_header, $ctags_action) = @_;
6320         my @projects = @$projlist;
6321
6322         my $check_forks = gitweb_check_feature('forks');
6323         my $show_ctags  = gitweb_check_feature('ctags');
6324         my $tagfilter = $show_ctags ? $input_params{'ctag_filter'} : undef;
6325         $check_forks = undef
6326                 if ($tagfilter || $search_regexp);
6327
6328         # filtering out forks before filling info allows to do less work
6329         @projects = filter_forks_from_projects_list(\@projects)
6330                 if ($check_forks);
6331         # search_projects_list pre-fills required info
6332         @projects = search_projects_list(\@projects,
6333                                          'search_regexp' => $search_regexp,
6334                                          'tagfilter'  => $tagfilter)
6335                 if ($tagfilter || $search_regexp);
6336         # fill the rest
6337         my @all_fields = ('descr', 'descr_long', 'ctags', 'category');
6338         push @all_fields, 'age_epoch' unless($omit_age_column);
6339         push @all_fields, 'owner' unless($omit_owner);
6340         @projects = fill_project_list_info(\@projects, @all_fields);
6341
6342         $order ||= $default_projects_order;
6343         $from = 0 unless defined $from;
6344         $to = $#projects if (!defined $to || $#projects < $to);
6345
6346         # short circuit
6347         if ($from > $to) {
6348                 print "<center>\n".
6349                       "<b>No such projects found</b><br />\n".
6350                       "Click ".$cgi->a({-href=>href(project=>undef,action=>'project_list')},"here")." to view all projects<br />\n".
6351                       "</center>\n<br />\n";
6352                 return;
6353         }
6354
6355         @projects = sort_projects_list(\@projects, $order);
6356
6357         if ($show_ctags) {
6358                 my $ctags = git_gather_all_ctags(\@projects);
6359                 my $cloud = git_populate_project_tagcloud($ctags, $ctags_action||'project_list');
6360                 print git_show_project_tagcloud($cloud, 64);
6361         }
6362
6363         print "<table class=\"project_list\">\n";
6364         unless ($no_header) {
6365                 print "<tr>\n";
6366                 if ($check_forks) {
6367                         print "<th></th>\n";
6368                 }
6369                 print_sort_th('project', $order, 'Project');
6370                 print_sort_th('descr', $order, 'Description');
6371                 print_sort_th('owner', $order, 'Owner') unless $omit_owner;
6372                 print_sort_th('age', $order, 'Last Change') unless $omit_age_column;
6373                 print "<th></th>\n" . # for links
6374                       "</tr>\n";
6375         }
6376
6377         if ($projects_list_group_categories) {
6378                 # only display categories with projects in the $from-$to window
6379                 @projects = sort {$a->{'category'} cmp $b->{'category'}} @projects[$from..$to];
6380                 my %categories = build_projlist_by_category(\@projects, $from, $to);
6381                 foreach my $cat (sort keys %categories) {
6382                         unless ($cat eq "") {
6383                                 print "<tr>\n";
6384                                 if ($check_forks) {
6385                                         print "<td></td>\n";
6386                                 }
6387                                 print "<td class=\"category\" colspan=\"5\">".esc_html($cat)."</td>\n";
6388                                 print "</tr>\n";
6389                         }
6390
6391                         git_project_list_rows($categories{$cat}, undef, undef, $check_forks);
6392                 }
6393         } else {
6394                 git_project_list_rows(\@projects, $from, $to, $check_forks);
6395         }
6396
6397         if (defined $extra) {
6398                 print "<tr>\n";
6399                 if ($check_forks) {
6400                         print "<td></td>\n";
6401                 }
6402                 print "<td colspan=\"5\">$extra</td>\n" .
6403                       "</tr>\n";
6404         }
6405         print "</table>\n";
6406 }
6407
6408 sub git_log_body {
6409         # uses global variable $project
6410         my ($commitlist, $from, $to, $refs, $extra) = @_;
6411
6412         $from = 0 unless defined $from;
6413         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6414
6415         for (my $i = 0; $i <= $to; $i++) {
6416                 my %co = %{$commitlist->[$i]};
6417                 next if !%co;
6418                 my $commit = $co{'id'};
6419                 my $ref = format_ref_marker($refs, $commit);
6420                 git_print_header_div('commit',
6421                                "<span class=\"age\">$co{'age_string'}</span>" .
6422                                esc_html($co{'title'}) . $ref,
6423                                $commit);
6424                 print "<div class=\"title_text\">\n" .
6425                       "<div class=\"log_link\">\n" .
6426                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") .
6427                       " | " .
6428                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") .
6429                       " | " .
6430                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree") .
6431                       "<br/>\n" .
6432                       "</div>\n";
6433                       git_print_authorship(\%co, -tag => 'span');
6434                       print "<br/>\n</div>\n";
6435
6436                 print "<div class=\"log_body\">\n";
6437                 git_print_log($co{'comment'}, -final_empty_line=> 1);
6438                 print "</div>\n";
6439         }
6440         if ($extra) {
6441                 print "<div class=\"page_nav\">\n";
6442                 print "$extra\n";
6443                 print "</div>\n";
6444         }
6445 }
6446
6447 sub git_shortlog_body {
6448         # uses global variable $project
6449         my ($commitlist, $from, $to, $refs, $extra) = @_;
6450
6451         $from = 0 unless defined $from;
6452         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6453
6454         print "<table class=\"shortlog\">\n";
6455         my $alternate = 1;
6456         for (my $i = $from; $i <= $to; $i++) {
6457                 my %co = %{$commitlist->[$i]};
6458                 my $commit = $co{'id'};
6459                 my $ref = format_ref_marker($refs, $commit);
6460                 if ($alternate) {
6461                         print "<tr class=\"dark\">\n";
6462                 } else {
6463                         print "<tr class=\"light\">\n";
6464                 }
6465                 $alternate ^= 1;
6466                 # git_summary() used print "<td><i>$co{'age_string'}</i></td>\n" .
6467                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6468                       format_author_html('td', \%co, 10) . "<td>";
6469                 print format_subject_html($co{'title'}, $co{'title_short'},
6470                                           href(action=>"commit", hash=>$commit), $ref);
6471                 print "</td>\n" .
6472                       "<td class=\"link\">" .
6473                       $cgi->a({-href => href(action=>"commit", hash=>$commit)}, "commit") . " | " .
6474                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff") . " | " .
6475                       $cgi->a({-href => href(action=>"tree", hash=>$commit, hash_base=>$commit)}, "tree");
6476                 my $snapshot_links = format_snapshot_links($commit);
6477                 if (defined $snapshot_links) {
6478                         print " | " . $snapshot_links;
6479                 }
6480                 print "</td>\n" .
6481                       "</tr>\n";
6482         }
6483         if (defined $extra) {
6484                 print "<tr>\n" .
6485                       "<td colspan=\"4\">$extra</td>\n" .
6486                       "</tr>\n";
6487         }
6488         print "</table>\n";
6489 }
6490
6491 sub git_history_body {
6492         # Warning: assumes constant type (blob or tree) during history
6493         my ($commitlist, $from, $to, $refs, $extra,
6494             $file_name, $file_hash, $ftype) = @_;
6495
6496         $from = 0 unless defined $from;
6497         $to = $#{$commitlist} unless (defined $to && $to <= $#{$commitlist});
6498
6499         print "<table class=\"history\">\n";
6500         my $alternate = 1;
6501         for (my $i = $from; $i <= $to; $i++) {
6502                 my %co = %{$commitlist->[$i]};
6503                 if (!%co) {
6504                         next;
6505                 }
6506                 my $commit = $co{'id'};
6507
6508                 my $ref = format_ref_marker($refs, $commit);
6509
6510                 if ($alternate) {
6511                         print "<tr class=\"dark\">\n";
6512                 } else {
6513                         print "<tr class=\"light\">\n";
6514                 }
6515                 $alternate ^= 1;
6516                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6517         # shortlog:   format_author_html('td', \%co, 10)
6518                       format_author_html('td', \%co, 15, 3) . "<td>";
6519                 # originally git_history used chop_str($co{'title'}, 50)
6520                 print format_subject_html($co{'title'}, $co{'title_short'},
6521                                           href(action=>"commit", hash=>$commit), $ref);
6522                 print "</td>\n" .
6523                       "<td class=\"link\">" .
6524                       $cgi->a({-href => href(action=>$ftype, hash_base=>$commit, file_name=>$file_name)}, $ftype) . " | " .
6525                       $cgi->a({-href => href(action=>"commitdiff", hash=>$commit)}, "commitdiff");
6526
6527                 if ($ftype eq 'blob') {
6528                         my $blob_current = $file_hash;
6529                         my $blob_parent  = git_get_hash_by_path($commit, $file_name);
6530                         if (defined $blob_current && defined $blob_parent &&
6531                                         $blob_current ne $blob_parent) {
6532                                 print " | " .
6533                                         $cgi->a({-href => href(action=>"blobdiff",
6534                                                                hash=>$blob_current, hash_parent=>$blob_parent,
6535                                                                hash_base=>$hash_base, hash_parent_base=>$commit,
6536                                                                file_name=>$file_name)},
6537                                                 "diff to current");
6538                         }
6539                 }
6540                 print "</td>\n" .
6541                       "</tr>\n";
6542         }
6543         if (defined $extra) {
6544                 print "<tr>\n" .
6545                       "<td colspan=\"4\">$extra</td>\n" .
6546                       "</tr>\n";
6547         }
6548         print "</table>\n";
6549 }
6550
6551 sub git_tags_body {
6552         # uses global variable $project
6553         my ($taglist, $from, $to, $extra) = @_;
6554         $from = 0 unless defined $from;
6555         $to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
6556
6557         print "<table class=\"tags\">\n";
6558         my $alternate = 1;
6559         for (my $i = $from; $i <= $to; $i++) {
6560                 my $entry = $taglist->[$i];
6561                 my %tag = %$entry;
6562                 my $comment = $tag{'subject'};
6563                 my $comment_short;
6564                 if (defined $comment) {
6565                         $comment_short = chop_str($comment, 30, 5);
6566                 }
6567                 if ($alternate) {
6568                         print "<tr class=\"dark\">\n";
6569                 } else {
6570                         print "<tr class=\"light\">\n";
6571                 }
6572                 $alternate ^= 1;
6573                 if (defined $tag{'age'}) {
6574                         print "<td><i>$tag{'age'}</i></td>\n";
6575                 } else {
6576                         print "<td></td>\n";
6577                 }
6578                 print "<td>" .
6579                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'}),
6580                                -class => "list name"}, esc_html($tag{'name'})) .
6581                       "</td>\n" .
6582                       "<td>";
6583                 if (defined $comment) {
6584                         print format_subject_html($comment, $comment_short,
6585                                                   href(action=>"tag", hash=>$tag{'id'}));
6586                 }
6587                 print "</td>\n" .
6588                       "<td class=\"selflink\">";
6589                 if ($tag{'type'} eq "tag") {
6590                         print $cgi->a({-href => href(action=>"tag", hash=>$tag{'id'})}, "tag");
6591                 } else {
6592                         print "&nbsp;";
6593                 }
6594                 print "</td>\n" .
6595                       "<td class=\"link\">" . " | " .
6596                       $cgi->a({-href => href(action=>$tag{'reftype'}, hash=>$tag{'refid'})}, $tag{'reftype'});
6597                 if ($tag{'reftype'} eq "commit") {
6598                         print " | " . $cgi->a({-href => href(action=>"shortlog", hash=>$tag{'fullname'})}, "shortlog") .
6599                               " | " . $cgi->a({-href => href(action=>"log", hash=>$tag{'fullname'})}, "log");
6600                 } elsif ($tag{'reftype'} eq "blob") {
6601                         print " | " . $cgi->a({-href => href(action=>"blob_plain", hash=>$tag{'refid'})}, "raw");
6602                 }
6603                 print "</td>\n" .
6604                       "</tr>";
6605         }
6606         if (defined $extra) {
6607                 print "<tr>\n" .
6608                       "<td colspan=\"5\">$extra</td>\n" .
6609                       "</tr>\n";
6610         }
6611         print "</table>\n";
6612 }
6613
6614 sub git_heads_body {
6615         # uses global variable $project
6616         my ($headlist, $head_at, $from, $to, $extra) = @_;
6617         $from = 0 unless defined $from;
6618         $to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
6619
6620         print "<table class=\"heads\">\n";
6621         my $alternate = 1;
6622         for (my $i = $from; $i <= $to; $i++) {
6623                 my $entry = $headlist->[$i];
6624                 my %ref = %$entry;
6625                 my $curr = defined $head_at && $ref{'id'} eq $head_at;
6626                 if ($alternate) {
6627                         print "<tr class=\"dark\">\n";
6628                 } else {
6629                         print "<tr class=\"light\">\n";
6630                 }
6631                 $alternate ^= 1;
6632                 print "<td><i>$ref{'age'}</i></td>\n" .
6633                       ($curr ? "<td class=\"current_head\">" : "<td>") .
6634                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'}),
6635                                -class => "list name"},esc_html($ref{'name'})) .
6636                       "</td>\n" .
6637                       "<td class=\"link\">" .
6638                       $cgi->a({-href => href(action=>"shortlog", hash=>$ref{'fullname'})}, "shortlog") . " | " .
6639                       $cgi->a({-href => href(action=>"log", hash=>$ref{'fullname'})}, "log") . " | " .
6640                       $cgi->a({-href => href(action=>"tree", hash=>$ref{'fullname'}, hash_base=>$ref{'fullname'})}, "tree") .
6641                       "</td>\n" .
6642                       "</tr>";
6643         }
6644         if (defined $extra) {
6645                 print "<tr>\n" .
6646                       "<td colspan=\"3\">$extra</td>\n" .
6647                       "</tr>\n";
6648         }
6649         print "</table>\n";
6650 }
6651
6652 # Display a single remote block
6653 sub git_remote_block {
6654         my ($remote, $rdata, $limit, $head) = @_;
6655
6656         my $heads = $rdata->{'heads'};
6657         my $fetch = $rdata->{'fetch'};
6658         my $push = $rdata->{'push'};
6659
6660         my $urls_table = "<table class=\"projects_list\">\n" ;
6661
6662         if (defined $fetch) {
6663                 if ($fetch eq $push) {
6664                         $urls_table .= format_repo_url("URL", $fetch);
6665                 } else {
6666                         $urls_table .= format_repo_url("Fetch URL", $fetch);
6667                         $urls_table .= format_repo_url("Push URL", $push) if defined $push;
6668                 }
6669         } elsif (defined $push) {
6670                 $urls_table .= format_repo_url("Push URL", $push);
6671         } else {
6672                 $urls_table .= format_repo_url("", "No remote URL");
6673         }
6674
6675         $urls_table .= "</table>\n";
6676
6677         my $dots;
6678         if (defined $limit && $limit < @$heads) {
6679                 $dots = $cgi->a({-href => href(action=>"remotes", hash=>$remote)}, "...");
6680         }
6681
6682         print $urls_table;
6683         git_heads_body($heads, $head, 0, $limit, $dots);
6684 }
6685
6686 # Display a list of remote names with the respective fetch and push URLs
6687 sub git_remotes_list {
6688         my ($remotedata, $limit) = @_;
6689         print "<table class=\"heads\">\n";
6690         my $alternate = 1;
6691         my @remotes = sort keys %$remotedata;
6692
6693         my $limited = $limit && $limit < @remotes;
6694
6695         $#remotes = $limit - 1 if $limited;
6696
6697         while (my $remote = shift @remotes) {
6698                 my $rdata = $remotedata->{$remote};
6699                 my $fetch = $rdata->{'fetch'};
6700                 my $push = $rdata->{'push'};
6701                 if ($alternate) {
6702                         print "<tr class=\"dark\">\n";
6703                 } else {
6704                         print "<tr class=\"light\">\n";
6705                 }
6706                 $alternate ^= 1;
6707                 print "<td>" .
6708                       $cgi->a({-href=> href(action=>'remotes', hash=>$remote),
6709                                -class=> "list name"},esc_html($remote)) .
6710                       "</td>";
6711                 print "<td class=\"link\">" .
6712                       (defined $fetch ? $cgi->a({-href=> $fetch}, "fetch") : "fetch") .
6713                       " | " .
6714                       (defined $push ? $cgi->a({-href=> $push}, "push") : "push") .
6715                       "</td>";
6716
6717                 print "</tr>\n";
6718         }
6719
6720         if ($limited) {
6721                 print "<tr>\n" .
6722                       "<td colspan=\"3\">" .
6723                       $cgi->a({-href => href(action=>"remotes")}, "...") .
6724                       "</td>\n" . "</tr>\n";
6725         }
6726
6727         print "</table>";
6728 }
6729
6730 # Display remote heads grouped by remote, unless there are too many
6731 # remotes, in which case we only display the remote names
6732 sub git_remotes_body {
6733         my ($remotedata, $limit, $head) = @_;
6734         if ($limit and $limit < keys %$remotedata) {
6735                 git_remotes_list($remotedata, $limit);
6736         } else {
6737                 fill_remote_heads($remotedata);
6738                 while (my ($remote, $rdata) = each %$remotedata) {
6739                         git_print_section({-class=>"remote", -id=>$remote},
6740                                 ["remotes", $remote, $remote], sub {
6741                                         git_remote_block($remote, $rdata, $limit, $head);
6742                                 });
6743                 }
6744         }
6745 }
6746
6747 sub git_search_message {
6748         my %co = @_;
6749
6750         my $greptype;
6751         if ($searchtype eq 'commit') {
6752                 $greptype = "--grep=";
6753         } elsif ($searchtype eq 'author') {
6754                 $greptype = "--author=";
6755         } elsif ($searchtype eq 'committer') {
6756                 $greptype = "--committer=";
6757         }
6758         $greptype .= $searchtext;
6759         my @commitlist = parse_commits($hash, 101, (100 * $page), undef,
6760                                        $greptype, '--regexp-ignore-case',
6761                                        $search_use_regexp ? '--extended-regexp' : '--fixed-strings');
6762
6763         my $paging_nav = '';
6764         if ($page > 0) {
6765                 $paging_nav .=
6766                         $cgi->a({-href => href(-replay=>1, page=>undef)},
6767                                 "first") .
6768                         " &sdot; " .
6769                         $cgi->a({-href => href(-replay=>1, page=>$page-1),
6770                                  -accesskey => "p", -title => "Alt-p"}, "prev");
6771         } else {
6772                 $paging_nav .= "first &sdot; prev";
6773         }
6774         my $next_link = '';
6775         if ($#commitlist >= 100) {
6776                 $next_link =
6777                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
6778                                  -accesskey => "n", -title => "Alt-n"}, "next");
6779                 $paging_nav .= " &sdot; $next_link";
6780         } else {
6781                 $paging_nav .= " &sdot; next";
6782         }
6783
6784         git_header_html();
6785
6786         git_print_page_nav('','', $hash,$co{'tree'},$hash, $paging_nav);
6787         git_print_header_div('commit', esc_html($co{'title'}), $hash);
6788         if ($page == 0 && !@commitlist) {
6789                 print "<p>No match.</p>\n";
6790         } else {
6791                 git_search_grep_body(\@commitlist, 0, 99, $next_link);
6792         }
6793
6794         git_footer_html();
6795 }
6796
6797 sub git_search_changes {
6798         my %co = @_;
6799
6800         local $/ = "\n";
6801         defined(my $fd = git_cmd_pipe '--no-pager', 'log', @diff_opts,
6802                 '--pretty=format:%H', '--no-abbrev', '--raw', "-S$searchtext",
6803                 ($search_use_regexp ? '--pickaxe-regex' : ()))
6804                         or die_error(500, "Open git-log failed");
6805
6806         git_header_html();
6807
6808         git_print_page_nav('','', $hash,$co{'tree'},$hash);
6809         git_print_header_div('commit', esc_html($co{'title'}), $hash);
6810
6811         print "<table class=\"pickaxe search\">\n";
6812         my $alternate = 1;
6813         undef %co;
6814         my @files;
6815         while (my $line = to_utf8(scalar <$fd>)) {
6816                 chomp $line;
6817                 next unless $line;
6818
6819                 my %set = parse_difftree_raw_line($line);
6820                 if (defined $set{'commit'}) {
6821                         # finish previous commit
6822                         if (%co) {
6823                                 print "</td>\n" .
6824                                       "<td class=\"link\">" .
6825                                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
6826                                               "commit") .
6827                                       " | " .
6828                                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
6829                                                              hash_base=>$co{'id'})},
6830                                               "tree") .
6831                                       "</td>\n" .
6832                                       "</tr>\n";
6833                         }
6834
6835                         if ($alternate) {
6836                                 print "<tr class=\"dark\">\n";
6837                         } else {
6838                                 print "<tr class=\"light\">\n";
6839                         }
6840                         $alternate ^= 1;
6841                         %co = parse_commit($set{'commit'});
6842                         my $author = chop_and_escape_str($co{'author_name'}, 15, 5);
6843                         print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6844                               "<td><i>$author</i></td>\n" .
6845                               "<td>" .
6846                               $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
6847                                       -class => "list subject"},
6848                                       chop_and_escape_str($co{'title'}, 50) . "<br/>");
6849                 } elsif (defined $set{'to_id'}) {
6850                         next if ($set{'to_id'} =~ m/^0{40}$/);
6851
6852                         print $cgi->a({-href => href(action=>"blob", hash_base=>$co{'id'},
6853                                                      hash=>$set{'to_id'}, file_name=>$set{'to_file'}),
6854                                       -class => "list"},
6855                                       "<span class=\"match\">" . esc_path($set{'file'}) . "</span>") .
6856                               "<br/>\n";
6857                 }
6858         }
6859         close $fd;
6860
6861         # finish last commit (warning: repetition!)
6862         if (%co) {
6863                 print "</td>\n" .
6864                       "<td class=\"link\">" .
6865                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})},
6866                               "commit") .
6867                       " | " .
6868                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'},
6869                                              hash_base=>$co{'id'})},
6870                               "tree") .
6871                       "</td>\n" .
6872                       "</tr>\n";
6873         }
6874
6875         print "</table>\n";
6876
6877         git_footer_html();
6878 }
6879
6880 sub git_search_files {
6881         my %co = @_;
6882
6883         local $/ = "\n";
6884         defined(my $fd = git_cmd_pipe 'grep', '-n', '-z',
6885                 $search_use_regexp ? ('-E', '-i') : '-F',
6886                 $searchtext, $co{'tree'})
6887                         or die_error(500, "Open git-grep failed");
6888
6889         git_header_html();
6890
6891         git_print_page_nav('','', $hash,$co{'tree'},$hash);
6892         git_print_header_div('commit', esc_html($co{'title'}), $hash);
6893
6894         print "<table class=\"grep_search\">\n";
6895         my $alternate = 1;
6896         my $matches = 0;
6897         my $lastfile = '';
6898         my $file_href;
6899         while (my $line = to_utf8(scalar <$fd>)) {
6900                 chomp $line;
6901                 my ($file, $lno, $ltext, $binary);
6902                 last if ($matches++ > 1000);
6903                 if ($line =~ /^Binary file (.+) matches$/) {
6904                         $file = $1;
6905                         $binary = 1;
6906                 } else {
6907                         ($file, $lno, $ltext) = split(/\0/, $line, 3);
6908                         $file =~ s/^$co{'tree'}://;
6909                 }
6910                 if ($file ne $lastfile) {
6911                         $lastfile and print "</td></tr>\n";
6912                         if ($alternate++) {
6913                                 print "<tr class=\"dark\">\n";
6914                         } else {
6915                                 print "<tr class=\"light\">\n";
6916                         }
6917                         $file_href = href(action=>"blob", hash_base=>$co{'id'},
6918                                           file_name=>$file);
6919                         print "<td class=\"list\">".
6920                                 $cgi->a({-href => $file_href, -class => "list"}, esc_path($file));
6921                         print "</td><td>\n";
6922                         $lastfile = $file;
6923                 }
6924                 if ($binary) {
6925                         print "<div class=\"binary\">Binary file</div>\n";
6926                 } else {
6927                         $ltext = untabify($ltext);
6928                         if ($ltext =~ m/^(.*)($search_regexp)(.*)$/i) {
6929                                 $ltext = esc_html($1, -nbsp=>1);
6930                                 $ltext .= '<span class="match">';
6931                                 $ltext .= esc_html($2, -nbsp=>1);
6932                                 $ltext .= '</span>';
6933                                 $ltext .= esc_html($3, -nbsp=>1);
6934                         } else {
6935                                 $ltext = esc_html($ltext, -nbsp=>1);
6936                         }
6937                         print "<div class=\"pre\">" .
6938                                 $cgi->a({-href => $file_href.'#l'.$lno,
6939                                         -class => "linenr"}, sprintf('%4i', $lno)) .
6940                                 ' ' .  $ltext . "</div>\n";
6941                 }
6942         }
6943         if ($lastfile) {
6944                 print "</td></tr>\n";
6945                 if ($matches > 1000) {
6946                         print "<div class=\"diff nodifferences\">Too many matches, listing trimmed</div>\n";
6947                 }
6948         } else {
6949                 print "<div class=\"diff nodifferences\">No matches found</div>\n";
6950         }
6951         close $fd;
6952
6953         print "</table>\n";
6954
6955         git_footer_html();
6956 }
6957
6958 sub git_search_grep_body {
6959         my ($commitlist, $from, $to, $extra) = @_;
6960         $from = 0 unless defined $from;
6961         $to = $#{$commitlist} if (!defined $to || $#{$commitlist} < $to);
6962
6963         print "<table class=\"commit_search\">\n";
6964         my $alternate = 1;
6965         for (my $i = $from; $i <= $to; $i++) {
6966                 my %co = %{$commitlist->[$i]};
6967                 if (!%co) {
6968                         next;
6969                 }
6970                 my $commit = $co{'id'};
6971                 if ($alternate) {
6972                         print "<tr class=\"dark\">\n";
6973                 } else {
6974                         print "<tr class=\"light\">\n";
6975                 }
6976                 $alternate ^= 1;
6977                 print "<td title=\"$co{'age_string_age'}\"><i>$co{'age_string_date'}</i></td>\n" .
6978                       format_author_html('td', \%co, 15, 5) .
6979                       "<td>" .
6980                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'}),
6981                                -class => "list subject"},
6982                               chop_and_escape_str($co{'title'}, 50) . "<br/>");
6983                 my $comment = $co{'comment'};
6984                 foreach my $line (@$comment) {
6985                         if ($line =~ m/^(.*?)($search_regexp)(.*)$/i) {
6986                                 my ($lead, $match, $trail) = ($1, $2, $3);
6987                                 $match = chop_str($match, 70, 5, 'center');
6988                                 my $contextlen = int((80 - length($match))/2);
6989                                 $contextlen = 30 if ($contextlen > 30);
6990                                 $lead  = chop_str($lead,  $contextlen, 10, 'left');
6991                                 $trail = chop_str($trail, $contextlen, 10, 'right');
6992
6993                                 $lead  = esc_html($lead);
6994                                 $match = esc_html($match);
6995                                 $trail = esc_html($trail);
6996
6997                                 print "$lead<span class=\"match\">$match</span>$trail<br />";
6998                         }
6999                 }
7000                 print "</td>\n" .
7001                       "<td class=\"link\">" .
7002                       $cgi->a({-href => href(action=>"commit", hash=>$co{'id'})}, "commit") .
7003                       " | " .
7004                       $cgi->a({-href => href(action=>"commitdiff", hash=>$co{'id'})}, "commitdiff") .
7005                       " | " .
7006                       $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$co{'id'})}, "tree");
7007                 print "</td>\n" .
7008                       "</tr>\n";
7009         }
7010         if (defined $extra) {
7011                 print "<tr>\n" .
7012                       "<td colspan=\"3\">$extra</td>\n" .
7013                       "</tr>\n";
7014         }
7015         print "</table>\n";
7016 }
7017
7018 ## ======================================================================
7019 ## ======================================================================
7020 ## actions
7021
7022 sub git_project_list_load {
7023         my $empty_list_ok = shift;
7024         my $order = $input_params{'order'};
7025         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7026                 die_error(400, "Unknown order parameter");
7027         }
7028
7029         my @list = git_get_projects_list($project_filter, $strict_export);
7030         if (!@list) {
7031                 die_error(404, "No projects found") unless $empty_list_ok;
7032         }
7033
7034         return (\@list, $order);
7035 }
7036
7037 sub git_frontpage {
7038         my ($projlist, $order);
7039
7040         if ($frontpage_no_project_list) {
7041                 $project = undef;
7042                 $project_filter = undef;
7043         } else {
7044                 ($projlist, $order) = git_project_list_load(1);
7045         }
7046         git_header_html();
7047         if (defined $home_text && -f $home_text) {
7048                 print "<div class=\"index_include\">\n";
7049                 insert_file($home_text);
7050                 print "</div>\n";
7051         }
7052         git_project_search_form($searchtext, $search_use_regexp);
7053         if ($frontpage_no_project_list) {
7054                 my $show_ctags = gitweb_check_feature('ctags');
7055                 if ($frontpage_no_project_list == 1 and $show_ctags) {
7056                         my @projects = git_get_projects_list($project_filter, $strict_export);
7057                         @projects = filter_forks_from_projects_list(\@projects) if gitweb_check_feature('forks');
7058                         @projects = fill_project_list_info(\@projects, 'ctags');
7059                         my $ctags = git_gather_all_ctags(\@projects);
7060                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7061                         print git_show_project_tagcloud($cloud, 64);
7062                 }
7063         } else {
7064                 git_project_list_body($projlist, $order);
7065         }
7066         git_footer_html();
7067 }
7068
7069 sub git_project_list {
7070         my ($projlist, $order) = git_project_list_load();
7071         git_header_html();
7072         if (!$frontpage_no_project_list && defined $home_text && -f $home_text) {
7073                 print "<div class=\"index_include\">\n";
7074                 insert_file($home_text);
7075                 print "</div>\n";
7076         }
7077         git_project_search_form();
7078         git_project_list_body($projlist, $order);
7079         git_footer_html();
7080 }
7081
7082 sub git_forks {
7083         my $order = $input_params{'order'};
7084         if (defined $order && $order !~ m/none|project|descr|owner|age/) {
7085                 die_error(400, "Unknown order parameter");
7086         }
7087
7088         my $filter = $project;
7089         $filter =~ s/\.git$//;
7090         my @list = git_get_projects_list($filter);
7091         if (!@list) {
7092                 die_error(404, "No forks found");
7093         }
7094
7095         git_header_html();
7096         git_print_page_nav('','');
7097         git_print_header_div('summary', "$project forks");
7098         git_project_list_body(\@list, $order, undef, undef, undef, undef, 'forks');
7099         git_footer_html();
7100 }
7101
7102 sub git_project_index {
7103         my @projects = git_get_projects_list($project_filter, $strict_export);
7104         if (!@projects) {
7105                 die_error(404, "No projects found");
7106         }
7107
7108         print $cgi->header(
7109                 -type => 'text/plain',
7110                 -charset => 'utf-8',
7111                 -content_disposition => 'inline; filename="index.aux"');
7112
7113         foreach my $pr (@projects) {
7114                 if (!exists $pr->{'owner'}) {
7115                         $pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
7116                 }
7117
7118                 my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
7119                 # quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
7120                 $path  =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7121                 $owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
7122                 $path  =~ s/ /\+/g;
7123                 $owner =~ s/ /\+/g;
7124
7125                 print "$path $owner\n";
7126         }
7127 }
7128
7129 sub git_summary {
7130         my $descr = git_get_project_description($project) || "none";
7131         my %co = parse_commit("HEAD");
7132         my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
7133         my $head = $co{'id'};
7134         my $remote_heads = gitweb_check_feature('remote_heads');
7135
7136         my $owner = git_get_project_owner($project);
7137         my $homepage = git_get_project_config('homepage');
7138         my $base_url = git_get_project_config('baseurl');
7139
7140         my $refs = git_get_references();
7141         # These get_*_list functions return one more to allow us to see if
7142         # there are more ...
7143         my @taglist  = git_get_tags_list(16);
7144         my @headlist = git_get_heads_list(16);
7145         my %remotedata = $remote_heads ? git_get_remotes_list() : ();
7146         my @forklist;
7147         my $check_forks = gitweb_check_feature('forks');
7148
7149         if ($check_forks) {
7150                 # find forks of a project
7151                 my $filter = $project;
7152                 $filter =~ s/\.git$//;
7153                 @forklist = git_get_projects_list($filter);
7154                 # filter out forks of forks
7155                 @forklist = filter_forks_from_projects_list(\@forklist)
7156                         if (@forklist);
7157         }
7158
7159         git_header_html();
7160         git_print_page_nav('summary','', $head);
7161
7162         print "<div class=\"title\">&nbsp;</div>\n";
7163         print "<table class=\"projects_list\">\n" .
7164               "<tr id=\"metadata_desc\"><td>description</td><td>" . esc_html($descr) . "</td></tr>\n";
7165         if ($homepage) {
7166                 print "<tr id=\"metadata_homepage\"><td>homepage&#160;URL</td><td>" . $cgi->a({-href => $homepage}, $homepage) . "</td></tr>\n";
7167         }
7168         if ($base_url) {
7169                 print "<tr id=\"metadata_baseurl\"><td>repository&#160;URL</td><td>" . esc_html($base_url) . "</td></tr>\n";
7170         }
7171         if ($owner and not $omit_owner) {
7172                 print  "<tr id=\"metadata_owner\"><td>owner</td><td>" . esc_html($owner) . "</td></tr>\n";
7173         }
7174         if (defined $cd{'rfc2822'}) {
7175                 print "<tr id=\"metadata_lchange\"><td>last&#160;change</td>" .
7176                       "<td>".format_timestamp_html(\%cd)."</td></tr>\n";
7177         }
7178         my %rd = parse_file_date('.last_refresh');
7179         if (defined $rd{'rfc2822'}) {
7180                 print "<tr id=\"metadata_lrefresh\"><td>last&#160;refresh</td>" .
7181                       "<td>".format_timestamp_html(\%rd,0)."</td></tr>\n";
7182         }
7183
7184         # use per project git URL list in $projectroot/$project/cloneurl
7185         # or make project git URL from git base URL and project name
7186         my $url_tag = $base_url ? "mirror&#160;URL" : "URL";
7187         my @url_list = git_get_project_url_list($project);
7188         @url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
7189         foreach my $git_url (@url_list) {
7190                 next unless $git_url;
7191                 print format_repo_url($url_tag, $git_url);
7192                 $url_tag = "";
7193         }
7194
7195         # Tag cloud
7196         my $show_ctags = gitweb_check_feature('ctags');
7197         if ($show_ctags) {
7198                 my $ctags = git_get_project_ctags($project);
7199                 if (%$ctags || $show_ctags !~ /^\d+$/) {
7200                         # without ability to add tags, don't show if there are none
7201                         my $cloud = git_populate_project_tagcloud($ctags, 'project_list');
7202                         print "<tr id=\"metadata_ctags\">" .
7203                               "<td style=\"vertical-align:middle\">content&#160;tags<br />";
7204                         print "</td>\n<td>" unless %$ctags;
7205                         print "<form action=\"$show_ctags\" method=\"post\" style=\"white-space:nowrap\">" .
7206                               "<input type=\"hidden\" name=\"p\" value=\"$project\"/>" .
7207                               "add: <input type=\"text\" name=\"t\" size=\"8\" /></form>"
7208                               unless $show_ctags =~ /^\d+$/;
7209                         print "</td>\n<td>" if %$ctags;
7210                         print git_show_project_tagcloud($cloud, 48)."</td>" .
7211                               "</tr>\n";
7212                 }
7213         }
7214
7215         print "</table>\n";
7216
7217         # If XSS prevention is on, we don't include README.html.
7218         # TODO: Allow a readme in some safe format.
7219         if (!$prevent_xss && -s "$projectroot/$project/README.html") {
7220                 print "<div class=\"title\">readme</div>\n" .
7221                       "<div class=\"readme\">\n";
7222                 insert_file("$projectroot/$project/README.html");
7223                 print "\n</div>\n"; # class="readme"
7224         }
7225
7226         # we need to request one more than 16 (0..15) to check if
7227         # those 16 are all
7228         my @commitlist = $head ? parse_commits($head, 17) : ();
7229         if (@commitlist) {
7230                 git_print_header_div('shortlog');
7231                 git_shortlog_body(\@commitlist, 0, 15, $refs,
7232                                   $#commitlist <=  15 ? undef :
7233                                   $cgi->a({-href => href(action=>"shortlog")}, "..."));
7234         }
7235
7236         if (@taglist) {
7237                 git_print_header_div('tags');
7238                 git_tags_body(\@taglist, 0, 15,
7239                               $#taglist <=  15 ? undef :
7240                               $cgi->a({-href => href(action=>"tags")}, "..."));
7241         }
7242
7243         if (@headlist) {
7244                 git_print_header_div('heads');
7245                 git_heads_body(\@headlist, $head, 0, 15,
7246                                $#headlist <= 15 ? undef :
7247                                $cgi->a({-href => href(action=>"heads")}, "..."));
7248         }
7249
7250         if (%remotedata) {
7251                 git_print_header_div('remotes');
7252                 git_remotes_body(\%remotedata, 15, $head);
7253         }
7254
7255         if (@forklist) {
7256                 git_print_header_div('forks');
7257                 git_project_list_body(\@forklist, 'age', 0, 15,
7258                                       $#forklist <= 15 ? undef :
7259                                       $cgi->a({-href => href(action=>"forks")}, "..."),
7260                                       'no_header', 'forks');
7261         }
7262
7263         git_footer_html();
7264 }
7265
7266 sub git_tag {
7267         my %tag = parse_tag($hash);
7268
7269         if (! %tag) {
7270                 die_error(404, "Unknown tag object");
7271         }
7272
7273         my $head = git_get_head_hash($project);
7274         git_header_html();
7275         git_print_page_nav('','', $head,undef,$head);
7276         git_print_header_div('commit', esc_html($tag{'name'}), $hash);
7277         print "<div class=\"title_text\">\n" .
7278               "<table class=\"object_header\">\n" .
7279               "<tr>\n" .
7280               "<td>object</td>\n" .
7281               "<td>" . $cgi->a({-class => "list", -href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7282                                $tag{'object'}) . "</td>\n" .
7283               "<td class=\"link\">" . $cgi->a({-href => href(action=>$tag{'type'}, hash=>$tag{'object'})},
7284                                               $tag{'type'}) . "</td>\n" .
7285               "</tr>\n";
7286         if (defined($tag{'author'})) {
7287                 git_print_authorship_rows(\%tag, 'author');
7288         }
7289         print "</table>\n\n" .
7290               "</div>\n";
7291         print "<div class=\"page_body\">";
7292         my $comment = $tag{'comment'};
7293         foreach my $line (@$comment) {
7294                 chomp $line;
7295                 print esc_html($line, -nbsp=>1) . "<br/>\n";
7296         }
7297         print "</div>\n";
7298         git_footer_html();
7299 }
7300
7301 sub git_blame_common {
7302         my $format = shift || 'porcelain';
7303         if ($format eq 'porcelain' && $input_params{'javascript'}) {
7304                 $format = 'incremental';
7305                 $action = 'blame_incremental'; # for page title etc
7306         }
7307
7308         # permissions
7309         gitweb_check_feature('blame')
7310                 or die_error(403, "Blame view not allowed");
7311
7312         # error checking
7313         die_error(400, "No file name given") unless $file_name;
7314         $hash_base ||= git_get_head_hash($project);
7315         die_error(404, "Couldn't find base commit") unless $hash_base;
7316         my %co = parse_commit($hash_base)
7317                 or die_error(404, "Commit not found");
7318         my $ftype = "blob";
7319         if (!defined $hash) {
7320                 $hash = git_get_hash_by_path($hash_base, $file_name, "blob")
7321                         or die_error(404, "Error looking up file");
7322         } else {
7323                 $ftype = git_get_type($hash);
7324                 if ($ftype !~ "blob") {
7325                         die_error(400, "Object is not a blob");
7326                 }
7327         }
7328
7329         my $fd;
7330         if ($format eq 'incremental') {
7331                 # get file contents (as base)
7332                 defined($fd = git_cmd_pipe 'cat-file', 'blob', $hash)
7333                         or die_error(500, "Open git-cat-file failed");
7334         } elsif ($format eq 'data') {
7335                 # run git-blame --incremental
7336                 defined($fd = git_cmd_pipe "blame", "--incremental",
7337                         $hash_base, "--", $file_name)
7338                         or die_error(500, "Open git-blame --incremental failed");
7339         } else {
7340                 # run git-blame --porcelain
7341                 defined($fd = git_cmd_pipe "blame", '-p',
7342                         $hash_base, '--', $file_name)
7343                         or die_error(500, "Open git-blame --porcelain failed");
7344         }
7345
7346         # incremental blame data returns early
7347         if ($format eq 'data') {
7348                 print $cgi->header(
7349                         -type=>"text/plain", -charset => "utf-8",
7350                         -status=> "200 OK");
7351                 local $| = 1; # output autoflush
7352                 while (<$fd>) {
7353                         print to_utf8($_);
7354                 }
7355                 close $fd
7356                         or print "ERROR $!\n";
7357
7358                 print 'END';
7359                 if (defined $t0 && gitweb_check_feature('timed')) {
7360                         print ' '.
7361                               tv_interval($t0, [ gettimeofday() ]).
7362                               ' '.$number_of_git_cmds;
7363                 }
7364                 print "\n";
7365
7366                 return;
7367         }
7368
7369         # page header
7370         git_header_html();
7371         my $formats_nav =
7372                 $cgi->a({-href => href(action=>"blob", -replay=>1)},
7373                         "blob") .
7374                 " | ";
7375         if ($format eq 'incremental') {
7376                 $formats_nav .=
7377                         $cgi->a({-href => href(action=>"blame", javascript=>0, -replay=>1)},
7378                                 "blame") . " (non-incremental)";
7379         } else {
7380                 $formats_nav .=
7381                         $cgi->a({-href => href(action=>"blame_incremental", -replay=>1)},
7382                                 "blame") . " (incremental)";
7383         }
7384         $formats_nav .=
7385                 " | " .
7386                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7387                         "history") .
7388                 " | " .
7389                 $cgi->a({-href => href(action=>$action, file_name=>$file_name)},
7390                         "HEAD");
7391         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7392         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7393         git_print_page_path($file_name, $ftype, $hash_base);
7394
7395         # page body
7396         if ($format eq 'incremental') {
7397                 print "<noscript>\n<div class=\"error\"><center><b>\n".
7398                       "This page requires JavaScript to run.\n Use ".
7399                       $cgi->a({-href => href(action=>'blame',javascript=>0,-replay=>1)},
7400                               'this page').
7401                       " instead.\n".
7402                       "</b></center></div>\n</noscript>\n";
7403
7404                 print qq!<div id="progress_bar" style="width: 100%; background-color: yellow"></div>\n!;
7405         }
7406
7407         print qq!<div class="page_body">\n!;
7408         print qq!<div id="progress_info">... / ...</div>\n!
7409                 if ($format eq 'incremental');
7410         print qq!<table id="blame_table" class="blame" width="100%">\n!.
7411               #qq!<col width="5.5em" /><col width="2.5em" /><col width="*" />\n!.
7412               qq!<thead>\n!.
7413               qq!<tr><th>Commit</th><th>Line</th><th>Data</th></tr>\n!.
7414               qq!</thead>\n!.
7415               qq!<tbody>\n!;
7416
7417         my @rev_color = qw(light dark);
7418         my $num_colors = scalar(@rev_color);
7419         my $current_color = 0;
7420
7421         if ($format eq 'incremental') {
7422                 my $color_class = $rev_color[$current_color];
7423
7424                 #contents of a file
7425                 my $linenr = 0;
7426         LINE:
7427                 while (my $line = to_utf8(scalar <$fd>)) {
7428                         chomp $line;
7429                         $linenr++;
7430
7431                         print qq!<tr id="l$linenr" class="$color_class">!.
7432                               qq!<td class="sha1"><a href=""> </a></td>!.
7433                               qq!<td class="linenr">!.
7434                               qq!<a class="linenr" href="">$linenr</a></td>!;
7435                         print qq!<td class="pre">! . esc_html($line) . "</td>\n";
7436                         print qq!</tr>\n!;
7437                 }
7438
7439         } else { # porcelain, i.e. ordinary blame
7440                 my %metainfo = (); # saves information about commits
7441
7442                 # blame data
7443         LINE:
7444                 while (my $line = to_utf8(scalar <$fd>)) {
7445                         chomp $line;
7446                         # the header: <SHA-1> <src lineno> <dst lineno> [<lines in group>]
7447                         # no <lines in group> for subsequent lines in group of lines
7448                         my ($full_rev, $orig_lineno, $lineno, $group_size) =
7449                            ($line =~ /^([0-9a-f]{40}) (\d+) (\d+)(?: (\d+))?$/);
7450                         if (!exists $metainfo{$full_rev}) {
7451                                 $metainfo{$full_rev} = { 'nprevious' => 0 };
7452                         }
7453                         my $meta = $metainfo{$full_rev};
7454                         my $data;
7455                         while ($data = to_utf8(scalar <$fd>)) {
7456                                 chomp $data;
7457                                 last if ($data =~ s/^\t//); # contents of line
7458                                 if ($data =~ /^(\S+)(?: (.*))?$/) {
7459                                         $meta->{$1} = $2 unless exists $meta->{$1};
7460                                 }
7461                                 if ($data =~ /^previous /) {
7462                                         $meta->{'nprevious'}++;
7463                                 }
7464                         }
7465                         my $short_rev = substr($full_rev, 0, 8);
7466                         my $author = $meta->{'author'};
7467                         my %date =
7468                                 parse_date($meta->{'author-time'}, $meta->{'author-tz'});
7469                         my $date = $date{'iso-tz'};
7470                         if ($group_size) {
7471                                 $current_color = ($current_color + 1) % $num_colors;
7472                         }
7473                         my $tr_class = $rev_color[$current_color];
7474                         $tr_class .= ' boundary' if (exists $meta->{'boundary'});
7475                         $tr_class .= ' no-previous' if ($meta->{'nprevious'} == 0);
7476                         $tr_class .= ' multiple-previous' if ($meta->{'nprevious'} > 1);
7477                         print "<tr id=\"l$lineno\" class=\"$tr_class\">\n";
7478                         if ($group_size) {
7479                                 print "<td class=\"sha1\"";
7480                                 print " title=\"". esc_html($author) . ", $date\"";
7481                                 print " rowspan=\"$group_size\"" if ($group_size > 1);
7482                                 print ">";
7483                                 print $cgi->a({-href => href(action=>"commit",
7484                                                              hash=>$full_rev,
7485                                                              file_name=>$file_name)},
7486                                               esc_html($short_rev));
7487                                 if ($group_size >= 2) {
7488                                         my @author_initials = ($author =~ /\b([[:upper:]])\B/g);
7489                                         if (@author_initials) {
7490                                                 print "<br />" .
7491                                                       esc_html(join('', @author_initials));
7492                                                 #           or join('.', ...)
7493                                         }
7494                                 }
7495                                 print "</td>\n";
7496                         }
7497                         # 'previous' <sha1 of parent commit> <filename at commit>
7498                         if (exists $meta->{'previous'} &&
7499                             $meta->{'previous'} =~ /^([a-fA-F0-9]{40}) (.*)$/) {
7500                                 $meta->{'parent'} = $1;
7501                                 $meta->{'file_parent'} = unquote($2);
7502                         }
7503                         my $linenr_commit =
7504                                 exists($meta->{'parent'}) ?
7505                                 $meta->{'parent'} : $full_rev;
7506                         my $linenr_filename =
7507                                 exists($meta->{'file_parent'}) ?
7508                                 $meta->{'file_parent'} : unquote($meta->{'filename'});
7509                         my $blamed = href(action => 'blame',
7510                                           file_name => $linenr_filename,
7511                                           hash_base => $linenr_commit);
7512                         print "<td class=\"linenr\">";
7513                         print $cgi->a({ -href => "$blamed#l$orig_lineno",
7514                                         -class => "linenr" },
7515                                       esc_html($lineno));
7516                         print "</td>";
7517                         print "<td class=\"pre\">" . esc_html($data) . "</td>\n";
7518                         print "</tr>\n";
7519                 } # end while
7520
7521         }
7522
7523         # footer
7524         print "</tbody>\n".
7525               "</table>\n"; # class="blame"
7526         print "</div>\n";   # class="blame_body"
7527         close $fd
7528                 or print "Reading blob failed\n";
7529
7530         git_footer_html();
7531 }
7532
7533 sub git_blame {
7534         git_blame_common();
7535 }
7536
7537 sub git_blame_incremental {
7538         git_blame_common('incremental');
7539 }
7540
7541 sub git_blame_data {
7542         git_blame_common('data');
7543 }
7544
7545 sub git_tags {
7546         my $head = git_get_head_hash($project);
7547         git_header_html();
7548         git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
7549         git_print_header_div('summary', $project);
7550
7551         my @tagslist = git_get_tags_list();
7552         if (@tagslist) {
7553                 git_tags_body(\@tagslist);
7554         }
7555         git_footer_html();
7556 }
7557
7558 sub git_heads {
7559         my $head = git_get_head_hash($project);
7560         git_header_html();
7561         git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
7562         git_print_header_div('summary', $project);
7563
7564         my @headslist = git_get_heads_list();
7565         if (@headslist) {
7566                 git_heads_body(\@headslist, $head);
7567         }
7568         git_footer_html();
7569 }
7570
7571 # used both for single remote view and for list of all the remotes
7572 sub git_remotes {
7573         gitweb_check_feature('remote_heads')
7574                 or die_error(403, "Remote heads view is disabled");
7575
7576         my $head = git_get_head_hash($project);
7577         my $remote = $input_params{'hash'};
7578
7579         my $remotedata = git_get_remotes_list($remote);
7580         die_error(500, "Unable to get remote information") unless defined $remotedata;
7581
7582         unless (%$remotedata) {
7583                 die_error(404, defined $remote ?
7584                         "Remote $remote not found" :
7585                         "No remotes found");
7586         }
7587
7588         git_header_html(undef, undef, -action_extra => $remote);
7589         git_print_page_nav('', '',  $head, undef, $head,
7590                 format_ref_views($remote ? '' : 'remotes'));
7591
7592         fill_remote_heads($remotedata);
7593         if (defined $remote) {
7594                 git_print_header_div('remotes', "$remote remote for $project");
7595                 git_remote_block($remote, $remotedata->{$remote}, undef, $head);
7596         } else {
7597                 git_print_header_div('summary', "$project remotes");
7598                 git_remotes_body($remotedata, undef, $head);
7599         }
7600
7601         git_footer_html();
7602 }
7603
7604 sub git_blob_plain {
7605         my $type = shift;
7606         my $expires;
7607
7608         if (!defined $hash) {
7609                 if (defined $file_name) {
7610                         my $base = $hash_base || git_get_head_hash($project);
7611                         $hash = git_get_hash_by_path($base, $file_name, "blob")
7612                                 or die_error(404, "Cannot find file");
7613                 } else {
7614                         die_error(400, "No file name defined");
7615                 }
7616         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7617                 # blobs defined by non-textual hash id's can be cached
7618                 $expires = "+1d";
7619         }
7620
7621         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
7622                 or die_error(500, "Open git-cat-file blob '$hash' failed");
7623         binmode($fd);
7624
7625         # content-type (can include charset)
7626         $type = blob_contenttype($fd, $file_name, $type);
7627
7628         # "save as" filename, even when no $file_name is given
7629         my $save_as = "$hash";
7630         if (defined $file_name) {
7631                 $save_as = $file_name;
7632         } elsif ($type =~ m/^text\//) {
7633                 $save_as .= '.txt';
7634         }
7635
7636         # With XSS prevention on, blobs of all types except a few known safe
7637         # ones are served with "Content-Disposition: attachment" to make sure
7638         # they don't run in our security domain.  For certain image types,
7639         # blob view writes an <img> tag referring to blob_plain view, and we
7640         # want to be sure not to break that by serving the image as an
7641         # attachment (though Firefox 3 doesn't seem to care).
7642         my $sandbox = $prevent_xss &&
7643                 $type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
7644
7645         # serve text/* as text/plain
7646         if ($prevent_xss &&
7647             ($type =~ m!^text/[a-z]+\b(.*)$! ||
7648              ($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
7649                 my $rest = $1;
7650                 $rest = defined $rest ? $rest : '';
7651                 $type = "text/plain$rest";
7652         }
7653
7654         print $cgi->header(
7655                 -type => $type,
7656                 -expires => $expires,
7657                 -content_disposition =>
7658                         ($sandbox ? 'attachment' : 'inline')
7659                         . '; filename="' . $save_as . '"');
7660         binmode STDOUT, ':raw';
7661         $fcgi_raw_mode = 1;
7662         my $buf;
7663         while (read($fd, $buf, 32768)) {
7664                 print $buf;
7665         }
7666         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
7667         $fcgi_raw_mode = 0;
7668         close $fd;
7669 }
7670
7671 sub git_blob {
7672         my $expires;
7673
7674         if (!defined $hash) {
7675                 if (defined $file_name) {
7676                         my $base = $hash_base || git_get_head_hash($project);
7677                         $hash = git_get_hash_by_path($base, $file_name, "blob")
7678                                 or die_error(404, "Cannot find file");
7679                 } else {
7680                         die_error(400, "No file name defined");
7681                 }
7682         } elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
7683                 # blobs defined by non-textual hash id's can be cached
7684                 $expires = "+1d";
7685         }
7686
7687         my $have_blame = gitweb_check_feature('blame');
7688         defined(my $fd = git_cmd_pipe "cat-file", "blob", $hash)
7689                 or die_error(500, "Couldn't cat $file_name, $hash");
7690         my $mimetype = blob_mimetype($fd, $file_name);
7691         # use 'blob_plain' (aka 'raw') view for files that cannot be displayed
7692         if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
7693                 close $fd;
7694                 return git_blob_plain($mimetype);
7695         }
7696         # we can have blame only for text/* mimetype
7697         $have_blame &&= ($mimetype =~ m!^text/!);
7698
7699         my $highlight = gitweb_check_feature('highlight') && defined $highlight_bin;
7700         my $syntax = guess_file_syntax($fd, $mimetype, $file_name) if $highlight;
7701         my $highlight_mode_active;
7702         ($fd, $highlight_mode_active) = run_highlighter($fd, $syntax) if $syntax;
7703
7704         git_header_html(undef, $expires);
7705         my $formats_nav = '';
7706         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7707                 if (defined $file_name) {
7708                         if ($have_blame) {
7709                                 $formats_nav .=
7710                                         $cgi->a({-href => href(action=>"blame", -replay=>1)},
7711                                                 "blame") .
7712                                         " | ";
7713                         }
7714                         $formats_nav .=
7715                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7716                                         "history") .
7717                                 " | " .
7718                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
7719                                         "raw") .
7720                                 " | " .
7721                                 $cgi->a({-href => href(action=>"blob",
7722                                                        hash_base=>"HEAD", file_name=>$file_name)},
7723                                         "HEAD");
7724                 } else {
7725                         $formats_nav .=
7726                                 $cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
7727                                         "raw");
7728                 }
7729                 git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
7730                 git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
7731         } else {
7732                 print "<div class=\"page_nav\">\n" .
7733                       "<br/><br/></div>\n" .
7734                       "<div class=\"title\">".esc_html($hash)."</div>\n";
7735         }
7736         git_print_page_path($file_name, "blob", $hash_base);
7737         print "<div class=\"page_body\">\n";
7738         if ($mimetype =~ m!^image/!) {
7739                 print qq!<img class="blob" type="!.esc_attr($mimetype).qq!"!;
7740                 if ($file_name) {
7741                         print qq! alt="!.esc_attr($file_name).qq!" title="!.esc_attr($file_name).qq!"!;
7742                 }
7743                 print qq! src="! .
7744                       href(action=>"blob_plain", hash=>$hash,
7745                            hash_base=>$hash_base, file_name=>$file_name) .
7746                       qq!" />\n!;
7747         } else {
7748                 my $nr;
7749                 while (my $line = to_utf8(scalar <$fd>)) {
7750                         chomp $line;
7751                         $nr++;
7752                         $line = untabify($line);
7753                         printf qq!<div class="pre"><a id="l%i" href="%s#l%i" class="linenr">%4i</a> %s</div>\n!,
7754                                $nr, esc_attr(href(-replay => 1)), $nr, $nr,
7755                                $highlight_mode_active ? sanitize($line) : esc_html($line, -nbsp=>1);
7756                 }
7757         }
7758         close $fd
7759                 or print "Reading blob failed.\n";
7760         print "</div>";
7761         git_footer_html();
7762 }
7763
7764 sub git_tree {
7765         if (!defined $hash_base) {
7766                 $hash_base = "HEAD";
7767         }
7768         if (!defined $hash) {
7769                 if (defined $file_name) {
7770                         $hash = git_get_hash_by_path($hash_base, $file_name, "tree");
7771                 } else {
7772                         $hash = $hash_base;
7773                 }
7774         }
7775         die_error(404, "No such tree") unless defined($hash);
7776
7777         my $show_sizes = gitweb_check_feature('show-sizes');
7778         my $have_blame = gitweb_check_feature('blame');
7779
7780         my @entries = ();
7781         {
7782                 local $/ = "\0";
7783                 defined(my $fd = git_cmd_pipe "ls-tree", '-z',
7784                         ($show_sizes ? '-l' : ()), @extra_options, $hash)
7785                         or die_error(500, "Open git-ls-tree failed");
7786                 @entries = map { chomp; to_utf8($_) } <$fd>;
7787                 close $fd
7788                         or die_error(404, "Reading tree failed");
7789         }
7790
7791         my $refs = git_get_references();
7792         my $ref = format_ref_marker($refs, $hash_base);
7793         git_header_html();
7794         my $basedir = '';
7795         if (defined $hash_base && (my %co = parse_commit($hash_base))) {
7796                 my @views_nav = ();
7797                 if (defined $file_name) {
7798                         push @views_nav,
7799                                 $cgi->a({-href => href(action=>"history", -replay=>1)},
7800                                         "history"),
7801                                 $cgi->a({-href => href(action=>"tree",
7802                                                        hash_base=>"HEAD", file_name=>$file_name)},
7803                                         "HEAD"),
7804                 }
7805                 my $snapshot_links = format_snapshot_links($hash);
7806                 if (defined $snapshot_links) {
7807                         # FIXME: Should be available when we have no hash base as well.
7808                         push @views_nav, $snapshot_links;
7809                 }
7810                 git_print_page_nav('tree','', $hash_base, undef, undef,
7811                                    join(' | ', @views_nav));
7812                 git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash_base);
7813         } else {
7814                 undef $hash_base;
7815                 print "<div class=\"page_nav\">\n";
7816                 print "<br/><br/></div>\n";
7817                 print "<div class=\"title\">".esc_html($hash)."</div>\n";
7818         }
7819         if (defined $file_name) {
7820                 $basedir = $file_name;
7821                 if ($basedir ne '' && substr($basedir, -1) ne '/') {
7822                         $basedir .= '/';
7823                 }
7824                 git_print_page_path($file_name, 'tree', $hash_base);
7825         }
7826         print "<div class=\"page_body\">\n";
7827         print "<table class=\"tree\">\n";
7828         my $alternate = 1;
7829         # '..' (top directory) link if possible
7830         if (defined $hash_base &&
7831             defined $file_name && $file_name =~ m![^/]+$!) {
7832                 if ($alternate) {
7833                         print "<tr class=\"dark\">\n";
7834                 } else {
7835                         print "<tr class=\"light\">\n";
7836                 }
7837                 $alternate ^= 1;
7838
7839                 my $up = $file_name;
7840                 $up =~ s!/?[^/]+$!!;
7841                 undef $up unless $up;
7842                 # based on git_print_tree_entry
7843                 print '<td class="mode">' . mode_str('040000') . "</td>\n";
7844                 print '<td class="size">&nbsp;</td>'."\n" if $show_sizes;
7845                 print '<td class="list">';
7846                 print $cgi->a({-href => href(action=>"tree",
7847                                              hash_base=>$hash_base,
7848                                              file_name=>$up)},
7849                               "..");
7850                 print "</td>\n";
7851                 print "<td class=\"link\"></td>\n";
7852
7853                 print "</tr>\n";
7854         }
7855         foreach my $line (@entries) {
7856                 my %t = parse_ls_tree_line($line, -z => 1, -l => $show_sizes);
7857
7858                 if ($alternate) {
7859                         print "<tr class=\"dark\">\n";
7860                 } else {
7861                         print "<tr class=\"light\">\n";
7862                 }
7863                 $alternate ^= 1;
7864
7865                 git_print_tree_entry(\%t, $basedir, $hash_base, $have_blame);
7866
7867                 print "</tr>\n";
7868         }
7869         print "</table>\n" .
7870               "</div>";
7871         git_footer_html();
7872 }
7873
7874 sub sanitize_for_filename {
7875     my $name = shift;
7876
7877     $name =~ s!/!-!g;
7878     $name =~ s/[^[:alnum:]_.-]//g;
7879
7880     return $name;
7881 }
7882
7883 sub snapshot_name {
7884         my ($project, $hash) = @_;
7885
7886         # path/to/project.git  -> project
7887         # path/to/project/.git -> project
7888         my $name = to_utf8($project);
7889         $name =~ s,([^/])/*\.git$,$1,;
7890         $name = sanitize_for_filename(basename($name));
7891
7892         my $ver = $hash;
7893         if ($hash =~ /^[0-9a-fA-F]+$/) {
7894                 # shorten SHA-1 hash
7895                 my $full_hash = git_get_full_hash($project, $hash);
7896                 if ($full_hash =~ /^$hash/ && length($hash) > 7) {
7897                         $ver = git_get_short_hash($project, $hash);
7898                 }
7899         } elsif ($hash =~ m!^refs/tags/(.*)$!) {
7900                 # tags don't need shortened SHA-1 hash
7901                 $ver = $1;
7902         } else {
7903                 # branches and other need shortened SHA-1 hash
7904                 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
7905                 if ($hash =~ m!^refs/($strip_refs|remotes)/(.*)$!) {
7906                         my $ref_dir = (defined $1) ? $1 : '';
7907                         $ver = $2;
7908
7909                         $ref_dir = sanitize_for_filename($ref_dir);
7910                         # for refs neither in heads nor remotes we want to
7911                         # add a ref dir to archive name
7912                         if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
7913                                 $ver = $ref_dir . '-' . $ver;
7914                         }
7915                 }
7916                 $ver .= '-' . git_get_short_hash($project, $hash);
7917         }
7918         # special case of sanitization for filename - we change
7919         # slashes to dots instead of dashes
7920         # in case of hierarchical branch names
7921         $ver =~ s!/!.!g;
7922         $ver =~ s/[^[:alnum:]_.-]//g;
7923
7924         # name = project-version_string
7925         $name = "$name-$ver";
7926
7927         return wantarray ? ($name, $name) : $name;
7928 }
7929
7930 sub exit_if_unmodified_since {
7931         my ($latest_epoch) = @_;
7932         our $cgi;
7933
7934         my $if_modified = $cgi->http('IF_MODIFIED_SINCE');
7935         if (defined $if_modified) {
7936                 my $since;
7937                 if (eval { require HTTP::Date; 1; }) {
7938                         $since = HTTP::Date::str2time($if_modified);
7939                 } elsif (eval { require Time::ParseDate; 1; }) {
7940                         $since = Time::ParseDate::parsedate($if_modified, GMT => 1);
7941                 }
7942                 if (defined $since && $latest_epoch <= $since) {
7943                         my %latest_date = parse_date($latest_epoch);
7944                         print $cgi->header(
7945                                 -last_modified => $latest_date{'rfc2822'},
7946                                 -status => '304 Not Modified');
7947                         goto DONE_GITWEB;
7948                 }
7949         }
7950 }
7951
7952 sub git_snapshot {
7953         my $format = $input_params{'snapshot_format'};
7954         if (!@snapshot_fmts) {
7955                 die_error(403, "Snapshots not allowed");
7956         }
7957         # default to first supported snapshot format
7958         $format ||= $snapshot_fmts[0];
7959         if ($format !~ m/^[a-z0-9]+$/) {
7960                 die_error(400, "Invalid snapshot format parameter");
7961         } elsif (!exists($known_snapshot_formats{$format})) {
7962                 die_error(400, "Unknown snapshot format");
7963         } elsif ($known_snapshot_formats{$format}{'disabled'}) {
7964                 die_error(403, "Snapshot format not allowed");
7965         } elsif (!grep($_ eq $format, @snapshot_fmts)) {
7966                 die_error(403, "Unsupported snapshot format");
7967         }
7968
7969         my $type = git_get_type("$hash^{}");
7970         if (!$type) {
7971                 die_error(404, 'Object does not exist');
7972         }  elsif ($type eq 'blob') {
7973                 die_error(400, 'Object is not a tree-ish');
7974         }
7975
7976         my ($name, $prefix) = snapshot_name($project, $hash);
7977         my $filename = "$name$known_snapshot_formats{$format}{'suffix'}";
7978
7979         my %co = parse_commit($hash);
7980         exit_if_unmodified_since($co{'committer_epoch'}) if %co;
7981
7982         my @cmd = (
7983                 git_cmd(), 'archive',
7984                 "--format=$known_snapshot_formats{$format}{'format'}",
7985                 "--prefix=$prefix/", $hash);
7986         if (exists $known_snapshot_formats{$format}{'compressor'}) {
7987                 @cmd = ($posix_shell_bin, '-c', quote_command(@cmd) .
7988                         ' | ' . quote_command(@{$known_snapshot_formats{$format}{'compressor'}}));
7989         }
7990
7991         $filename =~ s/(["\\])/\\$1/g;
7992         my %latest_date;
7993         if (%co) {
7994                 %latest_date = parse_date($co{'committer_epoch'}, $co{'committer_tz'});
7995         }
7996
7997         print $cgi->header(
7998                 -type => $known_snapshot_formats{$format}{'type'},
7999                 -content_disposition => 'inline; filename="' . $filename . '"',
8000                 %co ? (-last_modified => $latest_date{'rfc2822'}) : (),
8001                 -status => '200 OK');
8002
8003         defined(my $fd = cmd_pipe @cmd)
8004                 or die_error(500, "Execute git-archive failed");
8005         binmode($fd);
8006         binmode STDOUT, ':raw';
8007         $fcgi_raw_mode = 1;
8008         my $buf;
8009         while (read($fd, $buf, 32768)) {
8010                 print $buf;
8011         }
8012         binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
8013         $fcgi_raw_mode = 0;
8014         close $fd;
8015 }
8016
8017 sub git_log_generic {
8018         my ($fmt_name, $body_subr, $base, $parent, $file_name, $file_hash) = @_;
8019
8020         my $head = git_get_head_hash($project);
8021         if (!defined $base) {
8022                 $base = $head;
8023         }
8024         if (!defined $page) {
8025                 $page = 0;
8026         }
8027         my $refs = git_get_references();
8028
8029         my $commit_hash = $base;
8030         if (defined $parent) {
8031                 $commit_hash = "$parent..$base";
8032         }
8033         my @commitlist =
8034                 parse_commits($commit_hash, 101, (100 * $page),
8035                               defined $file_name ? ($file_name, "--full-history") : ());
8036
8037         my $ftype;
8038         if (!defined $file_hash && defined $file_name) {
8039                 # some commits could have deleted file in question,
8040                 # and not have it in tree, but one of them has to have it
8041                 for (my $i = 0; $i < @commitlist; $i++) {
8042                         $file_hash = git_get_hash_by_path($commitlist[$i]{'id'}, $file_name);
8043                         last if defined $file_hash;
8044                 }
8045         }
8046         if (defined $file_hash) {
8047                 $ftype = git_get_type($file_hash);
8048         }
8049         if (defined $file_name && !defined $ftype) {
8050                 die_error(500, "Unknown type of object");
8051         }
8052         my %co;
8053         if (defined $file_name) {
8054                 %co = parse_commit($base)
8055                         or die_error(404, "Unknown commit object");
8056         }
8057
8058
8059         my $paging_nav = format_paging_nav($fmt_name, $page, $#commitlist >= 100);
8060         my $next_link = '';
8061         if ($#commitlist >= 100) {
8062                 $next_link =
8063                         $cgi->a({-href => href(-replay=>1, page=>$page+1),
8064                                  -accesskey => "n", -title => "Alt-n"}, "next");
8065         }
8066         my $patch_max = gitweb_get_feature('patches');
8067         if ($patch_max && !defined $file_name) {
8068                 if ($patch_max < 0 || @commitlist <= $patch_max) {
8069                         $paging_nav .= " &sdot; " .
8070                                 $cgi->a({-href => href(action=>"patches", -replay=>1)},
8071                                         "patches");
8072                 }
8073         }
8074
8075         git_header_html();
8076         git_print_page_nav($fmt_name,'', $hash,$hash,$hash, $paging_nav);
8077         if (defined $file_name) {
8078                 git_print_header_div('commit', esc_html($co{'title'}), $base);
8079         } else {
8080                 git_print_header_div('summary', $project)
8081         }
8082         git_print_page_path($file_name, $ftype, $hash_base)
8083                 if (defined $file_name);
8084
8085         $body_subr->(\@commitlist, 0, 99, $refs, $next_link,
8086                      $file_name, $file_hash, $ftype);
8087
8088         git_footer_html();
8089 }
8090
8091 sub git_log {
8092         git_log_generic('log', \&git_log_body,
8093                         $hash, $hash_parent);
8094 }
8095
8096 sub git_commit {
8097         $hash ||= $hash_base || "HEAD";
8098         my %co = parse_commit($hash)
8099             or die_error(404, "Unknown commit object");
8100
8101         my $parent  = $co{'parent'};
8102         my $parents = $co{'parents'}; # listref
8103
8104         # we need to prepare $formats_nav before any parameter munging
8105         my $formats_nav;
8106         if (!defined $parent) {
8107                 # --root commitdiff
8108                 $formats_nav .= '(initial)';
8109         } elsif (@$parents == 1) {
8110                 # single parent commit
8111                 $formats_nav .=
8112                         '(parent: ' .
8113                         $cgi->a({-href => href(action=>"commit",
8114                                                hash=>$parent)},
8115                                 esc_html(substr($parent, 0, 7))) .
8116                         ')';
8117         } else {
8118                 # merge commit
8119                 $formats_nav .=
8120                         '(merge: ' .
8121                         join(' ', map {
8122                                 $cgi->a({-href => href(action=>"commit",
8123                                                        hash=>$_)},
8124                                         esc_html(substr($_, 0, 7)));
8125                         } @$parents ) .
8126                         ')';
8127         }
8128         if (gitweb_check_feature('patches') && @$parents <= 1) {
8129                 $formats_nav .= " | " .
8130                         $cgi->a({-href => href(action=>"patch", -replay=>1)},
8131                                 "patch");
8132         }
8133
8134         if (!defined $parent) {
8135                 $parent = "--root";
8136         }
8137         my @difftree;
8138         defined(my $fd = git_cmd_pipe "diff-tree", '-r', "--no-commit-id",
8139                 @diff_opts,
8140                 (@$parents <= 1 ? $parent : '-c'),
8141                 $hash, "--")
8142                 or die_error(500, "Open git-diff-tree failed");
8143         @difftree = map { chomp; to_utf8($_) } <$fd>;
8144         close $fd or die_error(404, "Reading git-diff-tree failed");
8145
8146         # non-textual hash id's can be cached
8147         my $expires;
8148         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8149                 $expires = "+1d";
8150         }
8151         my $refs = git_get_references();
8152         my $ref = format_ref_marker($refs, $co{'id'});
8153
8154         git_header_html(undef, $expires);
8155         git_print_page_nav('commit', '',
8156                            $hash, $co{'tree'}, $hash,
8157                            $formats_nav);
8158
8159         if (defined $co{'parent'}) {
8160                 git_print_header_div('commitdiff', esc_html($co{'title'}) . $ref, $hash);
8161         } else {
8162                 git_print_header_div('tree', esc_html($co{'title'}) . $ref, $co{'tree'}, $hash);
8163         }
8164         print "<div class=\"title_text\">\n" .
8165               "<table class=\"object_header\">\n";
8166         git_print_authorship_rows(\%co);
8167         print "<tr><td>commit</td><td class=\"sha1\">$co{'id'}</td></tr>\n";
8168         print "<tr>" .
8169               "<td>tree</td>" .
8170               "<td class=\"sha1\">" .
8171               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash),
8172                        class => "list"}, $co{'tree'}) .
8173               "</td>" .
8174               "<td class=\"link\">" .
8175               $cgi->a({-href => href(action=>"tree", hash=>$co{'tree'}, hash_base=>$hash)},
8176                       "tree");
8177         my $snapshot_links = format_snapshot_links($hash);
8178         if (defined $snapshot_links) {
8179                 print " | " . $snapshot_links;
8180         }
8181         print "</td>" .
8182               "</tr>\n";
8183
8184         foreach my $par (@$parents) {
8185                 print "<tr>" .
8186                       "<td>parent</td>" .
8187                       "<td class=\"sha1\">" .
8188                       $cgi->a({-href => href(action=>"commit", hash=>$par),
8189                                class => "list"}, $par) .
8190                       "</td>" .
8191                       "<td class=\"link\">" .
8192                       $cgi->a({-href => href(action=>"commit", hash=>$par)}, "commit") .
8193                       " | " .
8194                       $cgi->a({-href => href(action=>"commitdiff", hash=>$hash, hash_parent=>$par)}, "diff") .
8195                       "</td>" .
8196                       "</tr>\n";
8197         }
8198         print "</table>".
8199               "</div>\n";
8200
8201         print "<div class=\"page_body\">\n";
8202         git_print_log($co{'comment'});
8203         print "</div>\n";
8204
8205         git_difftree_body(\@difftree, $hash, @$parents);
8206
8207         git_footer_html();
8208 }
8209
8210 sub git_object {
8211         # object is defined by:
8212         # - hash or hash_base alone
8213         # - hash_base and file_name
8214         my $type;
8215
8216         # - hash or hash_base alone
8217         if ($hash || ($hash_base && !defined $file_name)) {
8218                 my $object_id = $hash || $hash_base;
8219
8220                 defined(my $fd = git_cmd_pipe 'cat-file', '-t', $object_id)
8221                         or die_error(404, "Object does not exist");
8222                 $type = <$fd>;
8223                 chomp $type;
8224                 close $fd
8225                         or die_error(404, "Object does not exist");
8226
8227         # - hash_base and file_name
8228         } elsif ($hash_base && defined $file_name) {
8229                 $file_name =~ s,/+$,,;
8230
8231                 system(git_cmd(), "cat-file", '-e', $hash_base) == 0
8232                         or die_error(404, "Base object does not exist");
8233
8234                 # here errors should not happen
8235                 defined(my $fd = git_cmd_pipe "ls-tree", $hash_base, "--", $file_name)
8236                         or die_error(500, "Open git-ls-tree failed");
8237                 my $line = to_utf8(scalar <$fd>);
8238                 close $fd;
8239
8240                 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
8241                 unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
8242                         die_error(404, "File or directory for given base does not exist");
8243                 }
8244                 $type = $2;
8245                 $hash = $3;
8246         } else {
8247                 die_error(400, "Not enough information to find object");
8248         }
8249
8250         print $cgi->redirect(-uri => href(action=>$type, -full=>1,
8251                                           hash=>$hash, hash_base=>$hash_base,
8252                                           file_name=>$file_name),
8253                              -status => '302 Found');
8254 }
8255
8256 sub git_blobdiff {
8257         my $format = shift || 'html';
8258         my $diff_style = $input_params{'diff_style'} || 'inline';
8259
8260         my $fd;
8261         my @difftree;
8262         my %diffinfo;
8263         my $expires;
8264
8265         # preparing $fd and %diffinfo for git_patchset_body
8266         # new style URI
8267         if (defined $hash_base && defined $hash_parent_base) {
8268                 if (defined $file_name) {
8269                         # read raw output
8270                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8271                                 $hash_parent_base, $hash_base,
8272                                 "--", (defined $file_parent ? $file_parent : ()), $file_name)
8273                                 or die_error(500, "Open git-diff-tree failed");
8274                         @difftree = map { chomp; to_utf8($_) } <$fd>;
8275                         close $fd
8276                                 or die_error(404, "Reading git-diff-tree failed");
8277                         @difftree
8278                                 or die_error(404, "Blob diff not found");
8279
8280                 } elsif (defined $hash &&
8281                          $hash =~ /[0-9a-fA-F]{40}/) {
8282                         # try to find filename from $hash
8283
8284                         # read filtered raw output
8285                         defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8286                                 $hash_parent_base, $hash_base, "--")
8287                                 or die_error(500, "Open git-diff-tree failed");
8288                         @difftree =
8289                                 # ':100644 100644 03b21826... 3b93d5e7... M     ls-files.c'
8290                                 # $hash == to_id
8291                                 grep { /^:[0-7]{6} [0-7]{6} [0-9a-fA-F]{40} $hash/ }
8292                                 map { chomp; to_utf8($_) } <$fd>;
8293                         close $fd
8294                                 or die_error(404, "Reading git-diff-tree failed");
8295                         @difftree
8296                                 or die_error(404, "Blob diff not found");
8297
8298                 } else {
8299                         die_error(400, "Missing one of the blob diff parameters");
8300                 }
8301
8302                 if (@difftree > 1) {
8303                         die_error(400, "Ambiguous blob diff specification");
8304                 }
8305
8306                 %diffinfo = parse_difftree_raw_line($difftree[0]);
8307                 $file_parent ||= $diffinfo{'from_file'} || $file_name;
8308                 $file_name   ||= $diffinfo{'to_file'};
8309
8310                 $hash_parent ||= $diffinfo{'from_id'};
8311                 $hash        ||= $diffinfo{'to_id'};
8312
8313                 # non-textual hash id's can be cached
8314                 if ($hash_base =~ m/^[0-9a-fA-F]{40}$/ &&
8315                     $hash_parent_base =~ m/^[0-9a-fA-F]{40}$/) {
8316                         $expires = '+1d';
8317                 }
8318
8319                 # open patch output
8320                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8321                         '-p', ($format eq 'html' ? "--full-index" : ()),
8322                         $hash_parent_base, $hash_base,
8323                         "--", (defined $file_parent ? $file_parent : ()), $file_name)
8324                         or die_error(500, "Open git-diff-tree failed");
8325         }
8326
8327         # old/legacy style URI -- not generated anymore since 1.4.3.
8328         if (!%diffinfo) {
8329                 die_error('404 Not Found', "Missing one of the blob diff parameters")
8330         }
8331
8332         # header
8333         if ($format eq 'html') {
8334                 my $formats_nav =
8335                         $cgi->a({-href => href(action=>"blobdiff_plain", -replay=>1)},
8336                                 "raw");
8337                 $formats_nav .= diff_style_nav($diff_style);
8338                 git_header_html(undef, $expires);
8339                 if (defined $hash_base && (my %co = parse_commit($hash_base))) {
8340                         git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
8341                         git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
8342                 } else {
8343                         print "<div class=\"page_nav\"><br/>$formats_nav<br/></div>\n";
8344                         print "<div class=\"title\">".esc_html("$hash vs $hash_parent")."</div>\n";
8345                 }
8346                 if (defined $file_name) {
8347                         git_print_page_path($file_name, "blob", $hash_base);
8348                 } else {
8349                         print "<div class=\"page_path\"></div>\n";
8350                 }
8351
8352         } elsif ($format eq 'plain') {
8353                 print $cgi->header(
8354                         -type => 'text/plain',
8355                         -charset => 'utf-8',
8356                         -expires => $expires,
8357                         -content_disposition => 'inline; filename="' . "$file_name" . '.patch"');
8358
8359                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8360
8361         } else {
8362                 die_error(400, "Unknown blobdiff format");
8363         }
8364
8365         # patch
8366         if ($format eq 'html') {
8367                 print "<div class=\"page_body\">\n";
8368
8369                 git_patchset_body($fd, $diff_style,
8370                                   [ \%diffinfo ], $hash_base, $hash_parent_base);
8371                 close $fd;
8372
8373                 print "</div>\n"; # class="page_body"
8374                 git_footer_html();
8375
8376         } else {
8377                 while (my $line = to_utf8(scalar <$fd>)) {
8378                         $line =~ s!a/($hash|$hash_parent)!'a/'.esc_path($diffinfo{'from_file'})!eg;
8379                         $line =~ s!b/($hash|$hash_parent)!'b/'.esc_path($diffinfo{'to_file'})!eg;
8380
8381                         print $line;
8382
8383                         last if $line =~ m!^\+\+\+!;
8384                 }
8385                 while (<$fd>) {
8386                         print to_utf8($_);
8387                 }
8388                 close $fd;
8389         }
8390 }
8391
8392 sub git_blobdiff_plain {
8393         git_blobdiff('plain');
8394 }
8395
8396 # assumes that it is added as later part of already existing navigation,
8397 # so it returns "| foo | bar" rather than just "foo | bar"
8398 sub diff_style_nav {
8399         my ($diff_style, $is_combined) = @_;
8400         $diff_style ||= 'inline';
8401
8402         return "" if ($is_combined);
8403
8404         my @styles = (inline => 'inline', 'sidebyside' => 'side by side');
8405         my %styles = @styles;
8406         @styles =
8407                 @styles[ map { $_ * 2 } 0..$#styles/2 ];
8408
8409         return join '',
8410                 map { " | ".$_ }
8411                 map {
8412                         $_ eq $diff_style ? $styles{$_} :
8413                         $cgi->a({-href => href(-replay=>1, diff_style => $_)}, $styles{$_})
8414                 } @styles;
8415 }
8416
8417 sub git_commitdiff {
8418         my %params = @_;
8419         my $format = $params{-format} || 'html';
8420         my $diff_style = $input_params{'diff_style'} || 'inline';
8421
8422         my ($patch_max) = gitweb_get_feature('patches');
8423         if ($format eq 'patch') {
8424                 die_error(403, "Patch view not allowed") unless $patch_max;
8425         }
8426
8427         $hash ||= $hash_base || "HEAD";
8428         my %co = parse_commit($hash)
8429             or die_error(404, "Unknown commit object");
8430
8431         # choose format for commitdiff for merge
8432         if (! defined $hash_parent && @{$co{'parents'}} > 1) {
8433                 $hash_parent = '--cc';
8434         }
8435         # we need to prepare $formats_nav before almost any parameter munging
8436         my $formats_nav;
8437         if ($format eq 'html') {
8438                 $formats_nav =
8439                         $cgi->a({-href => href(action=>"commitdiff_plain", -replay=>1)},
8440                                 "raw");
8441                 if ($patch_max && @{$co{'parents'}} <= 1) {
8442                         $formats_nav .= " | " .
8443                                 $cgi->a({-href => href(action=>"patch", -replay=>1)},
8444                                         "patch");
8445                 }
8446                 $formats_nav .= diff_style_nav($diff_style, @{$co{'parents'}} > 1);
8447
8448                 if (defined $hash_parent &&
8449                     $hash_parent ne '-c' && $hash_parent ne '--cc') {
8450                         # commitdiff with two commits given
8451                         my $hash_parent_short = $hash_parent;
8452                         if ($hash_parent =~ m/^[0-9a-fA-F]{40}$/) {
8453                                 $hash_parent_short = substr($hash_parent, 0, 7);
8454                         }
8455                         $formats_nav .=
8456                                 ' (from';
8457                         for (my $i = 0; $i < @{$co{'parents'}}; $i++) {
8458                                 if ($co{'parents'}[$i] eq $hash_parent) {
8459                                         $formats_nav .= ' parent ' . ($i+1);
8460                                         last;
8461                                 }
8462                         }
8463                         $formats_nav .= ': ' .
8464                                 $cgi->a({-href => href(-replay=>1,
8465                                                        hash=>$hash_parent, hash_base=>undef)},
8466                                         esc_html($hash_parent_short)) .
8467                                 ')';
8468                 } elsif (!$co{'parent'}) {
8469                         # --root commitdiff
8470                         $formats_nav .= ' (initial)';
8471                 } elsif (scalar @{$co{'parents'}} == 1) {
8472                         # single parent commit
8473                         $formats_nav .=
8474                                 ' (parent: ' .
8475                                 $cgi->a({-href => href(-replay=>1,
8476                                                        hash=>$co{'parent'}, hash_base=>undef)},
8477                                         esc_html(substr($co{'parent'}, 0, 7))) .
8478                                 ')';
8479                 } else {
8480                         # merge commit
8481                         if ($hash_parent eq '--cc') {
8482                                 $formats_nav .= ' | ' .
8483                                         $cgi->a({-href => href(-replay=>1,
8484                                                                hash=>$hash, hash_parent=>'-c')},
8485                                                 'combined');
8486                         } else { # $hash_parent eq '-c'
8487                                 $formats_nav .= ' | ' .
8488                                         $cgi->a({-href => href(-replay=>1,
8489                                                                hash=>$hash, hash_parent=>'--cc')},
8490                                                 'compact');
8491                         }
8492                         $formats_nav .=
8493                                 ' (merge: ' .
8494                                 join(' ', map {
8495                                         $cgi->a({-href => href(-replay=>1,
8496                                                                hash=>$_, hash_base=>undef)},
8497                                                 esc_html(substr($_, 0, 7)));
8498                                 } @{$co{'parents'}} ) .
8499                                 ')';
8500                 }
8501         }
8502
8503         my $hash_parent_param = $hash_parent;
8504         if (!defined $hash_parent_param) {
8505                 # --cc for multiple parents, --root for parentless
8506                 $hash_parent_param =
8507                         @{$co{'parents'}} > 1 ? '--cc' : $co{'parent'} || '--root';
8508         }
8509
8510         # read commitdiff
8511         my $fd;
8512         my @difftree;
8513         if ($format eq 'html') {
8514                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8515                         "--no-commit-id", "--patch-with-raw", "--full-index",
8516                         $hash_parent_param, $hash, "--")
8517                         or die_error(500, "Open git-diff-tree failed");
8518
8519                 while (my $line = to_utf8(scalar <$fd>)) {
8520                         chomp $line;
8521                         # empty line ends raw part of diff-tree output
8522                         last unless $line;
8523                         push @difftree, scalar parse_difftree_raw_line($line);
8524                 }
8525
8526         } elsif ($format eq 'plain') {
8527                 defined($fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8528                         '-p', $hash_parent_param, $hash, "--")
8529                         or die_error(500, "Open git-diff-tree failed");
8530         } elsif ($format eq 'patch') {
8531                 # For commit ranges, we limit the output to the number of
8532                 # patches specified in the 'patches' feature.
8533                 # For single commits, we limit the output to a single patch,
8534                 # diverging from the git-format-patch default.
8535                 my @commit_spec = ();
8536                 if ($hash_parent) {
8537                         if ($patch_max > 0) {
8538                                 push @commit_spec, "-$patch_max";
8539                         }
8540                         push @commit_spec, '-n', "$hash_parent..$hash";
8541                 } else {
8542                         if ($params{-single}) {
8543                                 push @commit_spec, '-1';
8544                         } else {
8545                                 if ($patch_max > 0) {
8546                                         push @commit_spec, "-$patch_max";
8547                                 }
8548                                 push @commit_spec, "-n";
8549                         }
8550                         push @commit_spec, '--root', $hash;
8551                 }
8552                 defined($fd = git_cmd_pipe "format-patch", @diff_opts,
8553                         '--encoding=utf8', '--stdout', @commit_spec)
8554                         or die_error(500, "Open git-format-patch failed");
8555         } else {
8556                 die_error(400, "Unknown commitdiff format");
8557         }
8558
8559         # non-textual hash id's can be cached
8560         my $expires;
8561         if ($hash =~ m/^[0-9a-fA-F]{40}$/) {
8562                 $expires = "+1d";
8563         }
8564
8565         # write commit message
8566         if ($format eq 'html') {
8567                 my $refs = git_get_references();
8568                 my $ref = format_ref_marker($refs, $co{'id'});
8569
8570                 git_header_html(undef, $expires);
8571                 git_print_page_nav('commitdiff','', $hash,$co{'tree'},$hash, $formats_nav);
8572                 git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash);
8573                 print "<div class=\"title_text\">\n" .
8574                       "<table class=\"object_header\">\n";
8575                 git_print_authorship_rows(\%co);
8576                 print "</table>".
8577                       "</div>\n";
8578                 print "<div class=\"page_body\">\n";
8579                 if (@{$co{'comment'}} > 1) {
8580                         print "<div class=\"log\">\n";
8581                         git_print_log($co{'comment'}, -final_empty_line=> 1, -remove_title => 1);
8582                         print "</div>\n"; # class="log"
8583                 }
8584
8585         } elsif ($format eq 'plain') {
8586                 my $refs = git_get_references("tags");
8587                 my $tagname = git_get_rev_name_tags($hash);
8588                 my $filename = basename($project) . "-$hash.patch";
8589
8590                 print $cgi->header(
8591                         -type => 'text/plain',
8592                         -charset => 'utf-8',
8593                         -expires => $expires,
8594                         -content_disposition => 'inline; filename="' . "$filename" . '"');
8595                 my %ad = parse_date($co{'author_epoch'}, $co{'author_tz'});
8596                 print "From: " . to_utf8($co{'author'}) . "\n";
8597                 print "Date: $ad{'rfc2822'} ($ad{'tz_local'})\n";
8598                 print "Subject: " . to_utf8($co{'title'}) . "\n";
8599
8600                 print "X-Git-Tag: $tagname\n" if $tagname;
8601                 print "X-Git-Url: " . $cgi->self_url() . "\n\n";
8602
8603                 foreach my $line (@{$co{'comment'}}) {
8604                         print to_utf8($line) . "\n";
8605                 }
8606                 print "---\n\n";
8607         } elsif ($format eq 'patch') {
8608                 my $filename = basename($project) . "-$hash.patch";
8609
8610                 print $cgi->header(
8611                         -type => 'text/plain',
8612                         -charset => 'utf-8',
8613                         -expires => $expires,
8614                         -content_disposition => 'inline; filename="' . "$filename" . '"');
8615         }
8616
8617         # write patch
8618         if ($format eq 'html') {
8619                 my $use_parents = !defined $hash_parent ||
8620                         $hash_parent eq '-c' || $hash_parent eq '--cc';
8621                 git_difftree_body(\@difftree, $hash,
8622                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
8623                 print "<br/>\n";
8624
8625                 git_patchset_body($fd, $diff_style,
8626                                   \@difftree, $hash,
8627                                   $use_parents ? @{$co{'parents'}} : $hash_parent);
8628                 close $fd;
8629                 print "</div>\n"; # class="page_body"
8630                 git_footer_html();
8631
8632         } elsif ($format eq 'plain') {
8633                 while (<$fd>) {
8634                         print to_utf8($_);
8635                 }
8636                 close $fd
8637                         or print "Reading git-diff-tree failed\n";
8638         } elsif ($format eq 'patch') {
8639                 while (<$fd>) {
8640                         print to_utf8($_);
8641                 }
8642                 close $fd
8643                         or print "Reading git-format-patch failed\n";
8644         }
8645 }
8646
8647 sub git_commitdiff_plain {
8648         git_commitdiff(-format => 'plain');
8649 }
8650
8651 # format-patch-style patches
8652 sub git_patch {
8653         git_commitdiff(-format => 'patch', -single => 1);
8654 }
8655
8656 sub git_patches {
8657         git_commitdiff(-format => 'patch');
8658 }
8659
8660 sub git_history {
8661         git_log_generic('history', \&git_history_body,
8662                         $hash_base, $hash_parent_base,
8663                         $file_name, $hash);
8664 }
8665
8666 sub git_search {
8667         $searchtype ||= 'commit';
8668
8669         # check if appropriate features are enabled
8670         gitweb_check_feature('search')
8671                 or die_error(403, "Search is disabled");
8672         if ($searchtype eq 'pickaxe') {
8673                 # pickaxe may take all resources of your box and run for several minutes
8674                 # with every query - so decide by yourself how public you make this feature
8675                 gitweb_check_feature('pickaxe')
8676                         or die_error(403, "Pickaxe search is disabled");
8677         }
8678         if ($searchtype eq 'grep') {
8679                 # grep search might be potentially CPU-intensive, too
8680                 gitweb_check_feature('grep')
8681                         or die_error(403, "Grep search is disabled");
8682         }
8683
8684         if (!defined $searchtext) {
8685                 die_error(400, "Text field is empty");
8686         }
8687         if (!defined $hash) {
8688                 $hash = git_get_head_hash($project);
8689         }
8690         my %co = parse_commit($hash);
8691         if (!%co) {
8692                 die_error(404, "Unknown commit object");
8693         }
8694         if (!defined $page) {
8695                 $page = 0;
8696         }
8697
8698         if ($searchtype eq 'commit' ||
8699             $searchtype eq 'author' ||
8700             $searchtype eq 'committer') {
8701                 git_search_message(%co);
8702         } elsif ($searchtype eq 'pickaxe') {
8703                 git_search_changes(%co);
8704         } elsif ($searchtype eq 'grep') {
8705                 git_search_files(%co);
8706         } else {
8707                 die_error(400, "Unknown search type");
8708         }
8709 }
8710
8711 sub git_search_help {
8712         git_header_html();
8713         git_print_page_nav('','', $hash,$hash,$hash);
8714         print <<EOT;
8715 <p><strong>Pattern</strong> is by default a normal string that is matched precisely (but without
8716 regard to case, except in the case of pickaxe). However, when you check the <em>re</em> checkbox,
8717 the pattern entered is recognized as the POSIX extended
8718 <a href="http://en.wikipedia.org/wiki/Regular_expression">regular expression</a> (also case
8719 insensitive).</p>
8720 <dl>
8721 <dt><b>commit</b></dt>
8722 <dd>The commit messages and authorship information will be scanned for the given pattern.</dd>
8723 EOT
8724         my $have_grep = gitweb_check_feature('grep');
8725         if ($have_grep) {
8726                 print <<EOT;
8727 <dt><b>grep</b></dt>
8728 <dd>All files in the currently selected tree (HEAD unless you are explicitly browsing
8729     a different one) are searched for the given pattern. On large trees, this search can take
8730 a while and put some strain on the server, so please use it with some consideration. Note that
8731 due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
8732 case-sensitive.</dd>
8733 EOT
8734         }
8735         print <<EOT;
8736 <dt><b>author</b></dt>
8737 <dd>Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.</dd>
8738 <dt><b>committer</b></dt>
8739 <dd>Name and e-mail of the committer and date of commit will be scanned for the given pattern.</dd>
8740 EOT
8741         my $have_pickaxe = gitweb_check_feature('pickaxe');
8742         if ($have_pickaxe) {
8743                 print <<EOT;
8744 <dt><b>pickaxe</b></dt>
8745 <dd>All commits that caused the string to appear or disappear from any file (changes that
8746 added, removed or "modified" the string) will be listed. This search can take a while and
8747 takes a lot of strain on the server, so please use it wisely. Note that since you may be
8748 interested even in changes just changing the case as well, this search is case sensitive.</dd>
8749 EOT
8750         }
8751         print "</dl>\n";
8752         git_footer_html();
8753 }
8754
8755 sub git_shortlog {
8756         git_log_generic('shortlog', \&git_shortlog_body,
8757                         $hash, $hash_parent);
8758 }
8759
8760 ## ......................................................................
8761 ## feeds (RSS, Atom; OPML)
8762
8763 sub git_feed {
8764         my $format = shift || 'atom';
8765         my $have_blame = gitweb_check_feature('blame');
8766
8767         # Atom: http://www.atomenabled.org/developers/syndication/
8768         # RSS:  http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
8769         if ($format ne 'rss' && $format ne 'atom') {
8770                 die_error(400, "Unknown web feed format");
8771         }
8772
8773         # log/feed of current (HEAD) branch, log of given branch, history of file/directory
8774         my $head = $hash || 'HEAD';
8775         my @commitlist = parse_commits($head, 150, 0, $file_name);
8776
8777         my %latest_commit;
8778         my %latest_date;
8779         my $content_type = "application/$format+xml";
8780         if (defined $cgi->http('HTTP_ACCEPT') &&
8781                  $cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
8782                 # browser (feed reader) prefers text/xml
8783                 $content_type = 'text/xml';
8784         }
8785         if (defined($commitlist[0])) {
8786                 %latest_commit = %{$commitlist[0]};
8787                 my $latest_epoch = $latest_commit{'committer_epoch'};
8788                 exit_if_unmodified_since($latest_epoch);
8789                 %latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
8790         }
8791         print $cgi->header(
8792                 -type => $content_type,
8793                 -charset => 'utf-8',
8794                 %latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
8795                 -status => '200 OK');
8796
8797         # Optimization: skip generating the body if client asks only
8798         # for Last-Modified date.
8799         return if ($cgi->request_method() eq 'HEAD');
8800
8801         # header variables
8802         my $title = "$site_name - $project/$action";
8803         my $feed_type = 'log';
8804         if (defined $hash) {
8805                 $title .= " - '$hash'";
8806                 $feed_type = 'branch log';
8807                 if (defined $file_name) {
8808                         $title .= " :: $file_name";
8809                         $feed_type = 'history';
8810                 }
8811         } elsif (defined $file_name) {
8812                 $title .= " - $file_name";
8813                 $feed_type = 'history';
8814         }
8815         $title .= " $feed_type";
8816         $title = esc_html($title);
8817         my $descr = git_get_project_description($project);
8818         if (defined $descr) {
8819                 $descr = esc_html($descr);
8820         } else {
8821                 $descr = "$project " .
8822                          ($format eq 'rss' ? 'RSS' : 'Atom') .
8823                          " feed";
8824         }
8825         my $owner = git_get_project_owner($project);
8826         $owner = esc_html($owner);
8827
8828         #header
8829         my $alt_url;
8830         if (defined $file_name) {
8831                 $alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
8832         } elsif (defined $hash) {
8833                 $alt_url = href(-full=>1, action=>"log", hash=>$hash);
8834         } else {
8835                 $alt_url = href(-full=>1, action=>"summary");
8836         }
8837         print qq!<?xml version="1.0" encoding="utf-8"?>\n!;
8838         if ($format eq 'rss') {
8839                 print <<XML;
8840 <rss version="2.0" xmlns:content="http://purl.org/rss/1.0/modules/content/">
8841 <channel>
8842 XML
8843                 print "<title>$title</title>\n" .
8844                       "<link>$alt_url</link>\n" .
8845                       "<description>$descr</description>\n" .
8846                       "<language>en</language>\n" .
8847                       # project owner is responsible for 'editorial' content
8848                       "<managingEditor>$owner</managingEditor>\n";
8849                 if (defined $logo || defined $favicon) {
8850                         # prefer the logo to the favicon, since RSS
8851                         # doesn't allow both
8852                         my $img = esc_url($logo || $favicon);
8853                         print "<image>\n" .
8854                               "<url>$img</url>\n" .
8855                               "<title>$title</title>\n" .
8856                               "<link>$alt_url</link>\n" .
8857                               "</image>\n";
8858                 }
8859                 if (%latest_date) {
8860                         print "<pubDate>$latest_date{'rfc2822'}</pubDate>\n";
8861                         print "<lastBuildDate>$latest_date{'rfc2822'}</lastBuildDate>\n";
8862                 }
8863                 print "<generator>gitweb v.$version/$git_version</generator>\n";
8864         } elsif ($format eq 'atom') {
8865                 print <<XML;
8866 <feed xmlns="http://www.w3.org/2005/Atom">
8867 XML
8868                 print "<title>$title</title>\n" .
8869                       "<subtitle>$descr</subtitle>\n" .
8870                       '<link rel="alternate" type="text/html" href="' .
8871                       $alt_url . '" />' . "\n" .
8872                       '<link rel="self" type="' . $content_type . '" href="' .
8873                       $cgi->self_url() . '" />' . "\n" .
8874                       "<id>" . href(-full=>1) . "</id>\n" .
8875                       # use project owner for feed author
8876                       "<author><name>$owner</name></author>\n";
8877                 if (defined $favicon) {
8878                         print "<icon>" . esc_url($favicon) . "</icon>\n";
8879                 }
8880                 if (defined $logo) {
8881                         # not twice as wide as tall: 72 x 27 pixels
8882                         print "<logo>" . esc_url($logo) . "</logo>\n";
8883                 }
8884                 if (! %latest_date) {
8885                         # dummy date to keep the feed valid until commits trickle in:
8886                         print "<updated>1970-01-01T00:00:00Z</updated>\n";
8887                 } else {
8888                         print "<updated>$latest_date{'iso-8601'}</updated>\n";
8889                 }
8890                 print "<generator version='$version/$git_version'>gitweb</generator>\n";
8891         }
8892
8893         # contents
8894         for (my $i = 0; $i <= $#commitlist; $i++) {
8895                 my %co = %{$commitlist[$i]};
8896                 my $commit = $co{'id'};
8897                 # we read 150, we always show 30 and the ones more recent than 48 hours
8898                 if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
8899                         last;
8900                 }
8901                 my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
8902
8903                 # get list of changed files
8904                 defined(my $fd = git_cmd_pipe "diff-tree", '-r', @diff_opts,
8905                         $co{'parent'} || "--root",
8906                         $co{'id'}, "--", (defined $file_name ? $file_name : ()))
8907                         or next;
8908                 my @difftree = map { chomp; to_utf8($_) } <$fd>;
8909                 close $fd
8910                         or next;
8911
8912                 # print element (entry, item)
8913                 my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
8914                 if ($format eq 'rss') {
8915                         print "<item>\n" .
8916                               "<title>" . esc_html($co{'title'}) . "</title>\n" .
8917                               "<author>" . esc_html($co{'author'}) . "</author>\n" .
8918                               "<pubDate>$cd{'rfc2822'}</pubDate>\n" .
8919                               "<guid isPermaLink=\"true\">$co_url</guid>\n" .
8920                               "<link>$co_url</link>\n" .
8921                               "<description>" . esc_html($co{'title'}) . "</description>\n" .
8922                               "<content:encoded>" .
8923                               "<![CDATA[\n";
8924                 } elsif ($format eq 'atom') {
8925                         print "<entry>\n" .
8926                               "<title type=\"html\">" . esc_html($co{'title'}) . "</title>\n" .
8927                               "<updated>$cd{'iso-8601'}</updated>\n" .
8928                               "<author>\n" .
8929                               "  <name>" . esc_html($co{'author_name'}) . "</name>\n";
8930                         if ($co{'author_email'}) {
8931                                 print "  <email>" . esc_html($co{'author_email'}) . "</email>\n";
8932                         }
8933                         print "</author>\n" .
8934                               # use committer for contributor
8935                               "<contributor>\n" .
8936                               "  <name>" . esc_html($co{'committer_name'}) . "</name>\n";
8937                         if ($co{'committer_email'}) {
8938                                 print "  <email>" . esc_html($co{'committer_email'}) . "</email>\n";
8939                         }
8940                         print "</contributor>\n" .
8941                               "<published>$cd{'iso-8601'}</published>\n" .
8942                               "<link rel=\"alternate\" type=\"text/html\" href=\"$co_url\" />\n" .
8943                               "<id>$co_url</id>\n" .
8944                               "<content type=\"xhtml\" xml:base=\"" . esc_url($my_url) . "\">\n" .
8945                               "<div xmlns=\"http://www.w3.org/1999/xhtml\">\n";
8946                 }
8947                 my $comment = $co{'comment'};
8948                 print "<pre>\n";
8949                 foreach my $line (@$comment) {
8950                         $line = esc_html($line);
8951                         print "$line\n";
8952                 }
8953                 print "</pre><ul>\n";
8954                 foreach my $difftree_line (@difftree) {
8955                         my %difftree = parse_difftree_raw_line($difftree_line);
8956                         next if !$difftree{'from_id'};
8957
8958                         my $file = $difftree{'file'} || $difftree{'to_file'};
8959
8960                         print "<li>" .
8961                               "[" .
8962                               $cgi->a({-href => href(-full=>1, action=>"blobdiff",
8963                                                      hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
8964                                                      hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
8965                                                      file_name=>$file, file_parent=>$difftree{'from_file'}),
8966                                       -title => "diff"}, 'D');
8967                         if ($have_blame) {
8968                                 print $cgi->a({-href => href(-full=>1, action=>"blame",
8969                                                              file_name=>$file, hash_base=>$commit),
8970                                               -title => "blame"}, 'B');
8971                         }
8972                         # if this is not a feed of a file history
8973                         if (!defined $file_name || $file_name ne $file) {
8974                                 print $cgi->a({-href => href(-full=>1, action=>"history",
8975                                                              file_name=>$file, hash=>$commit),
8976                                               -title => "history"}, 'H');
8977                         }
8978                         $file = esc_path($file);
8979                         print "] ".
8980                               "$file</li>\n";
8981                 }
8982                 if ($format eq 'rss') {
8983                         print "</ul>]]>\n" .
8984                               "</content:encoded>\n" .
8985                               "</item>\n";
8986                 } elsif ($format eq 'atom') {
8987                         print "</ul>\n</div>\n" .
8988                               "</content>\n" .
8989                               "</entry>\n";
8990                 }
8991         }
8992
8993         # end of feed
8994         if ($format eq 'rss') {
8995                 print "</channel>\n</rss>\n";
8996         } elsif ($format eq 'atom') {
8997                 print "</feed>\n";
8998         }
8999 }
9000
9001 sub git_rss {
9002         git_feed('rss');
9003 }
9004
9005 sub git_atom {
9006         git_feed('atom');
9007 }
9008
9009 sub git_opml {
9010         my @list = git_get_projects_list($project_filter, $strict_export);
9011         if (!@list) {
9012                 die_error(404, "No projects found");
9013         }
9014
9015         print $cgi->header(
9016                 -type => 'text/xml',
9017                 -charset => 'utf-8',
9018                 -content_disposition => 'inline; filename="opml.xml"');
9019
9020         my $title = esc_html($site_name);
9021         my $filter = " within subdirectory ";
9022         if (defined $project_filter) {
9023                 $filter .= esc_html($project_filter);
9024         } else {
9025                 $filter = "";
9026         }
9027         print <<XML;
9028 <?xml version="1.0" encoding="utf-8"?>
9029 <opml version="1.0">
9030 <head>
9031   <title>$title OPML Export$filter</title>
9032 </head>
9033 <body>
9034 <outline text="git RSS feeds">
9035 XML
9036
9037         foreach my $pr (@list) {
9038                 my %proj = %$pr;
9039                 my $head = git_get_head_hash($proj{'path'});
9040                 if (!defined $head) {
9041                         next;
9042                 }
9043                 $git_dir = "$projectroot/$proj{'path'}";
9044                 my %co = parse_commit($head);
9045                 if (!%co) {
9046                         next;
9047                 }
9048
9049                 my $path = esc_html(chop_str($proj{'path'}, 25, 5));
9050                 my $rss  = href('project' => $proj{'path'}, 'action' => 'rss', -full => 1);
9051                 my $html = href('project' => $proj{'path'}, 'action' => 'summary', -full => 1);
9052                 print "<outline type=\"rss\" text=\"$path\" title=\"$path\" xmlUrl=\"$rss\" htmlUrl=\"$html\"/>\n";
9053         }
9054         print <<XML;
9055 </outline>
9056 </body>
9057 </opml>
9058 XML
9059 }