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