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