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