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