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