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