The sixth batch for 2.18
[git.git] / gitweb / gitweb.perl
blob2594a4badb3d7b942b28b57ca036650328a1b050
1 #!/usr/bin/perl
3 # gitweb - simple web interface to track changes in git repositories
5 # (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
6 # (C) 2005, Christian Gierke
8 # This program is licensed under the GPLv2
10 use 5.008;
11 use strict;
12 use warnings;
13 # handle ACL in file access tests
14 use filetest 'access';
15 use CGI qw(:standard :escapeHTML -nosticky);
16 use CGI::Util qw(unescape);
17 use CGI::Carp qw(fatalsToBrowser set_message);
18 use Encode;
19 use Fcntl ':mode';
20 use File::Find qw();
21 use File::Basename qw(basename);
22 use Time::HiRes qw(gettimeofday tv_interval);
23 use Digest::MD5 qw(md5_hex);
25 binmode STDOUT, ':utf8';
27 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
28 eval 'sub CGI::multi_param { CGI::param(@_) }'
31 our $t0 = [ gettimeofday() ];
32 our $number_of_git_cmds = 0;
34 BEGIN {
35 CGI->compile() if $ENV{'MOD_PERL'};
38 our $version = "++GIT_VERSION++";
40 our ($my_url, $my_uri, $base_url, $path_info, $home_link);
41 sub evaluate_uri {
42 our $cgi;
44 our $my_url = $cgi->url();
45 our $my_uri = $cgi->url(-absolute => 1);
47 # Base URL for relative URLs in gitweb ($logo, $favicon, ...),
48 # needed and used only for URLs with nonempty PATH_INFO
49 our $base_url = $my_url;
51 # When the script is used as DirectoryIndex, the URL does not contain the name
52 # of the script file itself, and $cgi->url() fails to strip PATH_INFO, so we
53 # have to do it ourselves. We make $path_info global because it's also used
54 # later on.
56 # Another issue with the script being the DirectoryIndex is that the resulting
57 # $my_url data is not the full script URL: this is good, because we want
58 # generated links to keep implying the script name if it wasn't explicitly
59 # indicated in the URL we're handling, but it means that $my_url cannot be used
60 # as base URL.
61 # Therefore, if we needed to strip PATH_INFO, then we know that we have
62 # to build the base URL ourselves:
63 our $path_info = decode_utf8($ENV{"PATH_INFO"});
64 if ($path_info) {
65 # $path_info has already been URL-decoded by the web server, but
66 # $my_url and $my_uri have not. URL-decode them so we can properly
67 # strip $path_info.
68 $my_url = unescape($my_url);
69 $my_uri = unescape($my_uri);
70 if ($my_url =~ s,\Q$path_info\E$,, &&
71 $my_uri =~ s,\Q$path_info\E$,, &&
72 defined $ENV{'SCRIPT_NAME'}) {
73 $base_url = $cgi->url(-base => 1) . $ENV{'SCRIPT_NAME'};
77 # target of the home link on top of all pages
78 our $home_link = $my_uri || "/";
81 # core git executable to use
82 # this can just be "git" if your webserver has a sensible PATH
83 our $GIT = "++GIT_BINDIR++/git";
85 # absolute fs-path which will be prepended to the project path
86 #our $projectroot = "/pub/scm";
87 our $projectroot = "++GITWEB_PROJECTROOT++";
89 # fs traversing limit for getting project list
90 # the number is relative to the projectroot
91 our $project_maxdepth = "++GITWEB_PROJECT_MAXDEPTH++";
93 # string of the home link on top of all pages
94 our $home_link_str = "++GITWEB_HOME_LINK_STR++";
96 # extra breadcrumbs preceding the home link
97 our @extra_breadcrumbs = ();
99 # name of your site or organization to appear in page titles
100 # replace this with something more descriptive for clearer bookmarks
101 our $site_name = "++GITWEB_SITENAME++"
102 || ($ENV{'SERVER_NAME'} || "Untitled") . " Git";
104 # html snippet to include in the <head> section of each page
105 our $site_html_head_string = "++GITWEB_SITE_HTML_HEAD_STRING++";
106 # filename of html text to include at top of each page
107 our $site_header = "++GITWEB_SITE_HEADER++";
108 # html text to include at home page
109 our $home_text = "++GITWEB_HOMETEXT++";
110 # filename of html text to include at bottom of each page
111 our $site_footer = "++GITWEB_SITE_FOOTER++";
113 # URI of stylesheets
114 our @stylesheets = ("++GITWEB_CSS++");
115 # URI of a single stylesheet, which can be overridden in GITWEB_CONFIG.
116 our $stylesheet = undef;
117 # URI of GIT logo (72x27 size)
118 our $logo = "++GITWEB_LOGO++";
119 # URI of GIT favicon, assumed to be image/png type
120 our $favicon = "++GITWEB_FAVICON++";
121 # URI of gitweb.js (JavaScript code for gitweb)
122 our $javascript = "++GITWEB_JS++";
124 # URI and label (title) of GIT logo link
125 #our $logo_url = "http://www.kernel.org/pub/software/scm/git/docs/";
126 #our $logo_label = "git documentation";
127 our $logo_url = "http://git-scm.com/";
128 our $logo_label = "git homepage";
130 # source of projects list
131 our $projects_list = "++GITWEB_LIST++";
133 # the width (in characters) of the projects list "Description" column
134 our $projects_list_description_width = 25;
136 # group projects by category on the projects list
137 # (enabled if this variable evaluates to true)
138 our $projects_list_group_categories = 0;
140 # default category if none specified
141 # (leave the empty string for no category)
142 our $project_list_default_category = "";
144 # default order of projects list
145 # valid values are none, project, descr, owner, and age
146 our $default_projects_order = "project";
148 # show repository only if this file exists
149 # (only effective if this variable evaluates to true)
150 our $export_ok = "++GITWEB_EXPORT_OK++";
152 # don't generate age column on the projects list page
153 our $omit_age_column = 0;
155 # don't generate information about owners of repositories
156 our $omit_owner=0;
158 # show repository only if this subroutine returns true
159 # when given the path to the project, for example:
160 # sub { return -e "$_[0]/git-daemon-export-ok"; }
161 our $export_auth_hook = undef;
163 # only allow viewing of repositories also shown on the overview page
164 our $strict_export = "++GITWEB_STRICT_EXPORT++";
166 # list of git base URLs used for URL to where fetch project from,
167 # i.e. full URL is "$git_base_url/$project"
168 our @git_base_url_list = grep { $_ ne '' } ("++GITWEB_BASE_URL++");
170 # default blob_plain mimetype and default charset for text/plain blob
171 our $default_blob_plain_mimetype = 'text/plain';
172 our $default_text_plain_charset = undef;
174 # file to use for guessing MIME types before trying /etc/mime.types
175 # (relative to the current git repository)
176 our $mimetypes_file = undef;
178 # assume this charset if line contains non-UTF-8 characters;
179 # it should be valid encoding (see Encoding::Supported(3pm) for list),
180 # for which encoding all byte sequences are valid, for example
181 # 'iso-8859-1' aka 'latin1' (it is decoded without checking, so it
182 # could be even 'utf-8' for the old behavior)
183 our $fallback_encoding = 'latin1';
185 # rename detection options for git-diff and git-diff-tree
186 # - default is '-M', with the cost proportional to
187 # (number of removed files) * (number of new files).
188 # - more costly is '-C' (which implies '-M'), with the cost proportional to
189 # (number of changed files + number of removed files) * (number of new files)
190 # - even more costly is '-C', '--find-copies-harder' with cost
191 # (number of files in the original tree) * (number of new files)
192 # - one might want to include '-B' option, e.g. '-B', '-M'
193 our @diff_opts = ('-M'); # taken from git_commit
195 # Disables features that would allow repository owners to inject script into
196 # the gitweb domain.
197 our $prevent_xss = 0;
199 # Path to the highlight executable to use (must be the one from
200 # http://www.andre-simon.de due to assumptions about parameters and output).
201 # Useful if highlight is not installed on your webserver's PATH.
202 # [Default: highlight]
203 our $highlight_bin = "++HIGHLIGHT_BIN++";
205 # information about snapshot formats that gitweb is capable of serving
206 our %known_snapshot_formats = (
207 # name => {
208 # 'display' => display name,
209 # 'type' => mime type,
210 # 'suffix' => filename suffix,
211 # 'format' => --format for git-archive,
212 # 'compressor' => [compressor command and arguments]
213 # (array reference, optional)
214 # 'disabled' => boolean (optional)}
216 'tgz' => {
217 'display' => 'tar.gz',
218 'type' => 'application/x-gzip',
219 'suffix' => '.tar.gz',
220 'format' => 'tar',
221 'compressor' => ['gzip', '-n']},
223 'tbz2' => {
224 'display' => 'tar.bz2',
225 'type' => 'application/x-bzip2',
226 'suffix' => '.tar.bz2',
227 'format' => 'tar',
228 'compressor' => ['bzip2']},
230 'txz' => {
231 'display' => 'tar.xz',
232 'type' => 'application/x-xz',
233 'suffix' => '.tar.xz',
234 'format' => 'tar',
235 'compressor' => ['xz'],
236 'disabled' => 1},
238 'zip' => {
239 'display' => 'zip',
240 'type' => 'application/x-zip',
241 'suffix' => '.zip',
242 'format' => 'zip'},
245 # Aliases so we understand old gitweb.snapshot values in repository
246 # configuration.
247 our %known_snapshot_format_aliases = (
248 'gzip' => 'tgz',
249 'bzip2' => 'tbz2',
250 'xz' => 'txz',
252 # backward compatibility: legacy gitweb config support
253 'x-gzip' => undef, 'gz' => undef,
254 'x-bzip2' => undef, 'bz2' => undef,
255 'x-zip' => undef, '' => undef,
258 # Pixel sizes for icons and avatars. If the default font sizes or lineheights
259 # are changed, it may be appropriate to change these values too via
260 # $GITWEB_CONFIG.
261 our %avatar_size = (
262 'default' => 16,
263 'double' => 32
266 # Used to set the maximum load that we will still respond to gitweb queries.
267 # If server load exceed this value then return "503 server busy" error.
268 # If gitweb cannot determined server load, it is taken to be 0.
269 # Leave it undefined (or set to 'undef') to turn off load checking.
270 our $maxload = 300;
272 # configuration for 'highlight' (http://www.andre-simon.de/)
273 # match by basename
274 our %highlight_basename = (
275 #'Program' => 'py',
276 #'Library' => 'py',
277 'SConstruct' => 'py', # SCons equivalent of Makefile
278 'Makefile' => 'make',
280 # match by extension
281 our %highlight_ext = (
282 # main extensions, defining name of syntax;
283 # see files in /usr/share/highlight/langDefs/ directory
284 (map { $_ => $_ } qw(py rb java css js tex bib xml awk bat ini spec tcl sql)),
285 # alternate extensions, see /etc/highlight/filetypes.conf
286 (map { $_ => 'c' } qw(c h)),
287 (map { $_ => 'sh' } qw(sh bash zsh ksh)),
288 (map { $_ => 'cpp' } qw(cpp cxx c++ cc)),
289 (map { $_ => 'php' } qw(php php3 php4 php5 phps)),
290 (map { $_ => 'pl' } qw(pl perl pm)), # perhaps also 'cgi'
291 (map { $_ => 'make'} qw(make mak mk)),
292 (map { $_ => 'xml' } qw(xml xhtml html htm)),
295 # You define site-wide feature defaults here; override them with
296 # $GITWEB_CONFIG as necessary.
297 our %feature = (
298 # feature => {
299 # 'sub' => feature-sub (subroutine),
300 # 'override' => allow-override (boolean),
301 # 'default' => [ default options...] (array reference)}
303 # if feature is overridable (it means that allow-override has true value),
304 # then feature-sub will be called with default options as parameters;
305 # return value of feature-sub indicates if to enable specified feature
307 # if there is no 'sub' key (no feature-sub), then feature cannot be
308 # overridden
310 # use gitweb_get_feature(<feature>) to retrieve the <feature> value
311 # (an array) or gitweb_check_feature(<feature>) to check if <feature>
312 # is enabled
314 # Enable the 'blame' blob view, showing the last commit that modified
315 # each line in the file. This can be very CPU-intensive.
317 # To enable system wide have in $GITWEB_CONFIG
318 # $feature{'blame'}{'default'} = [1];
319 # To have project specific config enable override in $GITWEB_CONFIG
320 # $feature{'blame'}{'override'} = 1;
321 # and in project config gitweb.blame = 0|1;
322 'blame' => {
323 'sub' => sub { feature_bool('blame', @_) },
324 'override' => 0,
325 'default' => [0]},
327 # Enable the 'snapshot' link, providing a compressed archive of any
328 # tree. This can potentially generate high traffic if you have large
329 # project.
331 # Value is a list of formats defined in %known_snapshot_formats that
332 # you wish to offer.
333 # To disable system wide have in $GITWEB_CONFIG
334 # $feature{'snapshot'}{'default'} = [];
335 # To have project specific config enable override in $GITWEB_CONFIG
336 # $feature{'snapshot'}{'override'} = 1;
337 # and in project config, a comma-separated list of formats or "none"
338 # to disable. Example: gitweb.snapshot = tbz2,zip;
339 'snapshot' => {
340 'sub' => \&feature_snapshot,
341 'override' => 0,
342 'default' => ['tgz']},
344 # Enable text search, which will list the commits which match author,
345 # committer or commit text to a given string. Enabled by default.
346 # Project specific override is not supported.
348 # Note that this controls all search features, which means that if
349 # it is disabled, then 'grep' and 'pickaxe' search would also be
350 # disabled.
351 'search' => {
352 'override' => 0,
353 'default' => [1]},
355 # Enable grep search, which will list the files in currently selected
356 # tree containing the given string. Enabled by default. This can be
357 # potentially CPU-intensive, of course.
358 # Note that you need to have 'search' feature enabled too.
360 # To enable system wide have in $GITWEB_CONFIG
361 # $feature{'grep'}{'default'} = [1];
362 # To have project specific config enable override in $GITWEB_CONFIG
363 # $feature{'grep'}{'override'} = 1;
364 # and in project config gitweb.grep = 0|1;
365 'grep' => {
366 'sub' => sub { feature_bool('grep', @_) },
367 'override' => 0,
368 'default' => [1]},
370 # Enable the pickaxe search, which will list the commits that modified
371 # a given string in a file. This can be practical and quite faster
372 # alternative to 'blame', but still potentially CPU-intensive.
373 # Note that you need to have 'search' feature enabled too.
375 # To enable system wide have in $GITWEB_CONFIG
376 # $feature{'pickaxe'}{'default'} = [1];
377 # To have project specific config enable override in $GITWEB_CONFIG
378 # $feature{'pickaxe'}{'override'} = 1;
379 # and in project config gitweb.pickaxe = 0|1;
380 'pickaxe' => {
381 'sub' => sub { feature_bool('pickaxe', @_) },
382 'override' => 0,
383 'default' => [1]},
385 # Enable showing size of blobs in a 'tree' view, in a separate
386 # column, similar to what 'ls -l' does. This cost a bit of IO.
388 # To disable system wide have in $GITWEB_CONFIG
389 # $feature{'show-sizes'}{'default'} = [0];
390 # To have project specific config enable override in $GITWEB_CONFIG
391 # $feature{'show-sizes'}{'override'} = 1;
392 # and in project config gitweb.showsizes = 0|1;
393 'show-sizes' => {
394 'sub' => sub { feature_bool('showsizes', @_) },
395 'override' => 0,
396 'default' => [1]},
398 # Make gitweb use an alternative format of the URLs which can be
399 # more readable and natural-looking: project name is embedded
400 # directly in the path and the query string contains other
401 # auxiliary information. All gitweb installations recognize
402 # URL in either format; this configures in which formats gitweb
403 # generates links.
405 # To enable system wide have in $GITWEB_CONFIG
406 # $feature{'pathinfo'}{'default'} = [1];
407 # Project specific override is not supported.
409 # Note that you will need to change the default location of CSS,
410 # favicon, logo and possibly other files to an absolute URL. Also,
411 # if gitweb.cgi serves as your indexfile, you will need to force
412 # $my_uri to contain the script name in your $GITWEB_CONFIG.
413 'pathinfo' => {
414 'override' => 0,
415 'default' => [0]},
417 # Make gitweb consider projects in project root subdirectories
418 # to be forks of existing projects. Given project $projname.git,
419 # projects matching $projname/*.git will not be shown in the main
420 # projects list, instead a '+' mark will be added to $projname
421 # there and a 'forks' view will be enabled for the project, listing
422 # all the forks. If project list is taken from a file, forks have
423 # to be listed after the main project.
425 # To enable system wide have in $GITWEB_CONFIG
426 # $feature{'forks'}{'default'} = [1];
427 # Project specific override is not supported.
428 'forks' => {
429 'override' => 0,
430 'default' => [0]},
432 # Insert custom links to the action bar of all project pages.
433 # This enables you mainly to link to third-party scripts integrating
434 # into gitweb; e.g. git-browser for graphical history representation
435 # or custom web-based repository administration interface.
437 # The 'default' value consists of a list of triplets in the form
438 # (label, link, position) where position is the label after which
439 # to insert the link and link is a format string where %n expands
440 # to the project name, %f to the project path within the filesystem,
441 # %h to the current hash (h gitweb parameter) and %b to the current
442 # hash base (hb gitweb parameter); %% expands to %.
444 # To enable system wide have in $GITWEB_CONFIG e.g.
445 # $feature{'actions'}{'default'} = [('graphiclog',
446 # '/git-browser/by-commit.html?r=%n', 'summary')];
447 # Project specific override is not supported.
448 'actions' => {
449 'override' => 0,
450 'default' => []},
452 # Allow gitweb scan project content tags of project repository,
453 # and display the popular Web 2.0-ish "tag cloud" near the projects
454 # list. Note that this is something COMPLETELY different from the
455 # normal Git tags.
457 # gitweb by itself can show existing tags, but it does not handle
458 # tagging itself; you need to do it externally, outside gitweb.
459 # The format is described in git_get_project_ctags() subroutine.
460 # You may want to install the HTML::TagCloud Perl module to get
461 # a pretty tag cloud instead of just a list of tags.
463 # To enable system wide have in $GITWEB_CONFIG
464 # $feature{'ctags'}{'default'} = [1];
465 # Project specific override is not supported.
467 # In the future whether ctags editing is enabled might depend
468 # on the value, but using 1 should always mean no editing of ctags.
469 'ctags' => {
470 'override' => 0,
471 'default' => [0]},
473 # The maximum number of patches in a patchset generated in patch
474 # view. Set this to 0 or undef to disable patch view, or to a
475 # negative number to remove any limit.
477 # To disable system wide have in $GITWEB_CONFIG
478 # $feature{'patches'}{'default'} = [0];
479 # To have project specific config enable override in $GITWEB_CONFIG
480 # $feature{'patches'}{'override'} = 1;
481 # and in project config gitweb.patches = 0|n;
482 # where n is the maximum number of patches allowed in a patchset.
483 'patches' => {
484 'sub' => \&feature_patches,
485 'override' => 0,
486 'default' => [16]},
488 # Avatar support. When this feature is enabled, views such as
489 # shortlog or commit will display an avatar associated with
490 # the email of the committer(s) and/or author(s).
492 # Currently available providers are gravatar and picon.
493 # If an unknown provider is specified, the feature is disabled.
495 # Picon currently relies on the indiana.edu database.
497 # To enable system wide have in $GITWEB_CONFIG
498 # $feature{'avatar'}{'default'} = ['<provider>'];
499 # where <provider> is either gravatar or picon.
500 # To have project specific config enable override in $GITWEB_CONFIG
501 # $feature{'avatar'}{'override'} = 1;
502 # and in project config gitweb.avatar = <provider>;
503 'avatar' => {
504 'sub' => \&feature_avatar,
505 'override' => 0,
506 'default' => ['']},
508 # Enable displaying how much time and how many git commands
509 # it took to generate and display page. Disabled by default.
510 # Project specific override is not supported.
511 'timed' => {
512 'override' => 0,
513 'default' => [0]},
515 # Enable turning some links into links to actions which require
516 # JavaScript to run (like 'blame_incremental'). Not enabled by
517 # default. Project specific override is currently not supported.
518 'javascript-actions' => {
519 'override' => 0,
520 'default' => [0]},
522 # Enable and configure ability to change common timezone for dates
523 # in gitweb output via JavaScript. Enabled by default.
524 # Project specific override is not supported.
525 'javascript-timezone' => {
526 'override' => 0,
527 'default' => [
528 'local', # default timezone: 'utc', 'local', or '(-|+)HHMM' format,
529 # or undef to turn off this feature
530 'gitweb_tz', # name of cookie where to store selected timezone
531 'datetime', # CSS class used to mark up dates for manipulation
534 # Syntax highlighting support. This is based on Daniel Svensson's
535 # and Sham Chukoury's work in gitweb-xmms2.git.
536 # It requires the 'highlight' program present in $PATH,
537 # and therefore is disabled by default.
539 # To enable system wide have in $GITWEB_CONFIG
540 # $feature{'highlight'}{'default'} = [1];
542 'highlight' => {
543 'sub' => sub { feature_bool('highlight', @_) },
544 'override' => 0,
545 'default' => [0]},
547 # Enable displaying of remote heads in the heads list
549 # To enable system wide have in $GITWEB_CONFIG
550 # $feature{'remote_heads'}{'default'} = [1];
551 # To have project specific config enable override in $GITWEB_CONFIG
552 # $feature{'remote_heads'}{'override'} = 1;
553 # and in project config gitweb.remoteheads = 0|1;
554 'remote_heads' => {
555 'sub' => sub { feature_bool('remote_heads', @_) },
556 'override' => 0,
557 'default' => [0]},
559 # Enable showing branches under other refs in addition to heads
561 # To set system wide extra branch refs have in $GITWEB_CONFIG
562 # $feature{'extra-branch-refs'}{'default'} = ['dirs', 'of', 'choice'];
563 # To have project specific config enable override in $GITWEB_CONFIG
564 # $feature{'extra-branch-refs'}{'override'} = 1;
565 # and in project config gitweb.extrabranchrefs = dirs of choice
566 # Every directory is separated with whitespace.
568 'extra-branch-refs' => {
569 'sub' => \&feature_extra_branch_refs,
570 'override' => 0,
571 'default' => []},
574 sub gitweb_get_feature {
575 my ($name) = @_;
576 return unless exists $feature{$name};
577 my ($sub, $override, @defaults) = (
578 $feature{$name}{'sub'},
579 $feature{$name}{'override'},
580 @{$feature{$name}{'default'}});
581 # project specific override is possible only if we have project
582 our $git_dir; # global variable, declared later
583 if (!$override || !defined $git_dir) {
584 return @defaults;
586 if (!defined $sub) {
587 warn "feature $name is not overridable";
588 return @defaults;
590 return $sub->(@defaults);
593 # A wrapper to check if a given feature is enabled.
594 # With this, you can say
596 # my $bool_feat = gitweb_check_feature('bool_feat');
597 # gitweb_check_feature('bool_feat') or somecode;
599 # instead of
601 # my ($bool_feat) = gitweb_get_feature('bool_feat');
602 # (gitweb_get_feature('bool_feat'))[0] or somecode;
604 sub gitweb_check_feature {
605 return (gitweb_get_feature(@_))[0];
609 sub feature_bool {
610 my $key = shift;
611 my ($val) = git_get_project_config($key, '--bool');
613 if (!defined $val) {
614 return ($_[0]);
615 } elsif ($val eq 'true') {
616 return (1);
617 } elsif ($val eq 'false') {
618 return (0);
622 sub feature_snapshot {
623 my (@fmts) = @_;
625 my ($val) = git_get_project_config('snapshot');
627 if ($val) {
628 @fmts = ($val eq 'none' ? () : split /\s*[,\s]\s*/, $val);
631 return @fmts;
634 sub feature_patches {
635 my @val = (git_get_project_config('patches', '--int'));
637 if (@val) {
638 return @val;
641 return ($_[0]);
644 sub feature_avatar {
645 my @val = (git_get_project_config('avatar'));
647 return @val ? @val : @_;
650 sub feature_extra_branch_refs {
651 my (@branch_refs) = @_;
652 my $values = git_get_project_config('extrabranchrefs');
654 if ($values) {
655 $values = config_to_multi ($values);
656 @branch_refs = ();
657 foreach my $value (@{$values}) {
658 push @branch_refs, split /\s+/, $value;
662 return @branch_refs;
665 # checking HEAD file with -e is fragile if the repository was
666 # initialized long time ago (i.e. symlink HEAD) and was pack-ref'ed
667 # and then pruned.
668 sub check_head_link {
669 my ($dir) = @_;
670 my $headfile = "$dir/HEAD";
671 return ((-e $headfile) ||
672 (-l $headfile && readlink($headfile) =~ /^refs\/heads\//));
675 sub check_export_ok {
676 my ($dir) = @_;
677 return (check_head_link($dir) &&
678 (!$export_ok || -e "$dir/$export_ok") &&
679 (!$export_auth_hook || $export_auth_hook->($dir)));
682 # process alternate names for backward compatibility
683 # filter out unsupported (unknown) snapshot formats
684 sub filter_snapshot_fmts {
685 my @fmts = @_;
687 @fmts = map {
688 exists $known_snapshot_format_aliases{$_} ?
689 $known_snapshot_format_aliases{$_} : $_} @fmts;
690 @fmts = grep {
691 exists $known_snapshot_formats{$_} &&
692 !$known_snapshot_formats{$_}{'disabled'}} @fmts;
695 sub filter_and_validate_refs {
696 my @refs = @_;
697 my %unique_refs = ();
699 foreach my $ref (@refs) {
700 die_error(500, "Invalid ref '$ref' in 'extra-branch-refs' feature") unless (is_valid_ref_format($ref));
701 # 'heads' are added implicitly in get_branch_refs().
702 $unique_refs{$ref} = 1 if ($ref ne 'heads');
704 return sort keys %unique_refs;
707 # If it is set to code reference, it is code that it is to be run once per
708 # request, allowing updating configurations that change with each request,
709 # while running other code in config file only once.
711 # Otherwise, if it is false then gitweb would process config file only once;
712 # if it is true then gitweb config would be run for each request.
713 our $per_request_config = 1;
715 # read and parse gitweb config file given by its parameter.
716 # returns true on success, false on recoverable error, allowing
717 # to chain this subroutine, using first file that exists.
718 # dies on errors during parsing config file, as it is unrecoverable.
719 sub read_config_file {
720 my $filename = shift;
721 return unless defined $filename;
722 # die if there are errors parsing config file
723 if (-e $filename) {
724 do $filename;
725 die $@ if $@;
726 return 1;
728 return;
731 our ($GITWEB_CONFIG, $GITWEB_CONFIG_SYSTEM, $GITWEB_CONFIG_COMMON);
732 sub evaluate_gitweb_config {
733 our $GITWEB_CONFIG = $ENV{'GITWEB_CONFIG'} || "++GITWEB_CONFIG++";
734 our $GITWEB_CONFIG_SYSTEM = $ENV{'GITWEB_CONFIG_SYSTEM'} || "++GITWEB_CONFIG_SYSTEM++";
735 our $GITWEB_CONFIG_COMMON = $ENV{'GITWEB_CONFIG_COMMON'} || "++GITWEB_CONFIG_COMMON++";
737 # Protect against duplications of file names, to not read config twice.
738 # Only one of $GITWEB_CONFIG and $GITWEB_CONFIG_SYSTEM is used, so
739 # there possibility of duplication of filename there doesn't matter.
740 $GITWEB_CONFIG = "" if ($GITWEB_CONFIG eq $GITWEB_CONFIG_COMMON);
741 $GITWEB_CONFIG_SYSTEM = "" if ($GITWEB_CONFIG_SYSTEM eq $GITWEB_CONFIG_COMMON);
743 # Common system-wide settings for convenience.
744 # Those settings can be ovverriden by GITWEB_CONFIG or GITWEB_CONFIG_SYSTEM.
745 read_config_file($GITWEB_CONFIG_COMMON);
747 # Use first config file that exists. This means use the per-instance
748 # GITWEB_CONFIG if exists, otherwise use GITWEB_SYSTEM_CONFIG.
749 read_config_file($GITWEB_CONFIG) and return;
750 read_config_file($GITWEB_CONFIG_SYSTEM);
753 # Get loadavg of system, to compare against $maxload.
754 # Currently it requires '/proc/loadavg' present to get loadavg;
755 # if it is not present it returns 0, which means no load checking.
756 sub get_loadavg {
757 if( -e '/proc/loadavg' ){
758 open my $fd, '<', '/proc/loadavg'
759 or return 0;
760 my @load = split(/\s+/, scalar <$fd>);
761 close $fd;
763 # The first three columns measure CPU and IO utilization of the last one,
764 # five, and 10 minute periods. The fourth column shows the number of
765 # currently running processes and the total number of processes in the m/n
766 # format. The last column displays the last process ID used.
767 return $load[0] || 0;
769 # additional checks for load average should go here for things that don't export
770 # /proc/loadavg
772 return 0;
775 # version of the core git binary
776 our $git_version;
777 sub evaluate_git_version {
778 our $git_version = qx("$GIT" --version) =~ m/git version (.*)$/ ? $1 : "unknown";
779 $number_of_git_cmds++;
782 sub check_loadavg {
783 if (defined $maxload && get_loadavg() > $maxload) {
784 die_error(503, "The load average on the server is too high");
788 # ======================================================================
789 # input validation and dispatch
791 # input parameters can be collected from a variety of sources (presently, CGI
792 # and PATH_INFO), so we define an %input_params hash that collects them all
793 # together during validation: this allows subsequent uses (e.g. href()) to be
794 # agnostic of the parameter origin
796 our %input_params = ();
798 # input parameters are stored with the long parameter name as key. This will
799 # also be used in the href subroutine to convert parameters to their CGI
800 # equivalent, and since the href() usage is the most frequent one, we store
801 # the name -> CGI key mapping here, instead of the reverse.
803 # XXX: Warning: If you touch this, check the search form for updating,
804 # too.
806 our @cgi_param_mapping = (
807 project => "p",
808 action => "a",
809 file_name => "f",
810 file_parent => "fp",
811 hash => "h",
812 hash_parent => "hp",
813 hash_base => "hb",
814 hash_parent_base => "hpb",
815 page => "pg",
816 order => "o",
817 searchtext => "s",
818 searchtype => "st",
819 snapshot_format => "sf",
820 extra_options => "opt",
821 search_use_regexp => "sr",
822 ctag => "by_tag",
823 diff_style => "ds",
824 project_filter => "pf",
825 # this must be last entry (for manipulation from JavaScript)
826 javascript => "js"
828 our %cgi_param_mapping = @cgi_param_mapping;
830 # we will also need to know the possible actions, for validation
831 our %actions = (
832 "blame" => \&git_blame,
833 "blame_incremental" => \&git_blame_incremental,
834 "blame_data" => \&git_blame_data,
835 "blobdiff" => \&git_blobdiff,
836 "blobdiff_plain" => \&git_blobdiff_plain,
837 "blob" => \&git_blob,
838 "blob_plain" => \&git_blob_plain,
839 "commitdiff" => \&git_commitdiff,
840 "commitdiff_plain" => \&git_commitdiff_plain,
841 "commit" => \&git_commit,
842 "forks" => \&git_forks,
843 "heads" => \&git_heads,
844 "history" => \&git_history,
845 "log" => \&git_log,
846 "patch" => \&git_patch,
847 "patches" => \&git_patches,
848 "remotes" => \&git_remotes,
849 "rss" => \&git_rss,
850 "atom" => \&git_atom,
851 "search" => \&git_search,
852 "search_help" => \&git_search_help,
853 "shortlog" => \&git_shortlog,
854 "summary" => \&git_summary,
855 "tag" => \&git_tag,
856 "tags" => \&git_tags,
857 "tree" => \&git_tree,
858 "snapshot" => \&git_snapshot,
859 "object" => \&git_object,
860 # those below don't need $project
861 "opml" => \&git_opml,
862 "project_list" => \&git_project_list,
863 "project_index" => \&git_project_index,
866 # finally, we have the hash of allowed extra_options for the commands that
867 # allow them
868 our %allowed_options = (
869 "--no-merges" => [ qw(rss atom log shortlog history) ],
872 # fill %input_params with the CGI parameters. All values except for 'opt'
873 # should be single values, but opt can be an array. We should probably
874 # build an array of parameters that can be multi-valued, but since for the time
875 # being it's only this one, we just single it out
876 sub evaluate_query_params {
877 our $cgi;
879 while (my ($name, $symbol) = each %cgi_param_mapping) {
880 if ($symbol eq 'opt') {
881 $input_params{$name} = [ map { decode_utf8($_) } $cgi->multi_param($symbol) ];
882 } else {
883 $input_params{$name} = decode_utf8($cgi->param($symbol));
888 # now read PATH_INFO and update the parameter list for missing parameters
889 sub evaluate_path_info {
890 return if defined $input_params{'project'};
891 return if !$path_info;
892 $path_info =~ s,^/+,,;
893 return if !$path_info;
895 # find which part of PATH_INFO is project
896 my $project = $path_info;
897 $project =~ s,/+$,,;
898 while ($project && !check_head_link("$projectroot/$project")) {
899 $project =~ s,/*[^/]*$,,;
901 return unless $project;
902 $input_params{'project'} = $project;
904 # do not change any parameters if an action is given using the query string
905 return if $input_params{'action'};
906 $path_info =~ s,^\Q$project\E/*,,;
908 # next, check if we have an action
909 my $action = $path_info;
910 $action =~ s,/.*$,,;
911 if (exists $actions{$action}) {
912 $path_info =~ s,^$action/*,,;
913 $input_params{'action'} = $action;
916 # list of actions that want hash_base instead of hash, but can have no
917 # pathname (f) parameter
918 my @wants_base = (
919 'tree',
920 'history',
923 # we want to catch, among others
924 # [$hash_parent_base[:$file_parent]..]$hash_parent[:$file_name]
925 my ($parentrefname, $parentpathname, $refname, $pathname) =
926 ($path_info =~ /^(?:(.+?)(?::(.+))?\.\.)?([^:]+?)?(?::(.+))?$/);
928 # first, analyze the 'current' part
929 if (defined $pathname) {
930 # we got "branch:filename" or "branch:dir/"
931 # we could use git_get_type(branch:pathname), but:
932 # - it needs $git_dir
933 # - it does a git() call
934 # - the convention of terminating directories with a slash
935 # makes it superfluous
936 # - embedding the action in the PATH_INFO would make it even
937 # more superfluous
938 $pathname =~ s,^/+,,;
939 if (!$pathname || substr($pathname, -1) eq "/") {
940 $input_params{'action'} ||= "tree";
941 $pathname =~ s,/$,,;
942 } else {
943 # the default action depends on whether we had parent info
944 # or not
945 if ($parentrefname) {
946 $input_params{'action'} ||= "blobdiff_plain";
947 } else {
948 $input_params{'action'} ||= "blob_plain";
951 $input_params{'hash_base'} ||= $refname;
952 $input_params{'file_name'} ||= $pathname;
953 } elsif (defined $refname) {
954 # we got "branch". In this case we have to choose if we have to
955 # set hash or hash_base.
957 # Most of the actions without a pathname only want hash to be
958 # set, except for the ones specified in @wants_base that want
959 # hash_base instead. It should also be noted that hand-crafted
960 # links having 'history' as an action and no pathname or hash
961 # set will fail, but that happens regardless of PATH_INFO.
962 if (defined $parentrefname) {
963 # if there is parent let the default be 'shortlog' action
964 # (for http://git.example.com/repo.git/A..B links); if there
965 # is no parent, dispatch will detect type of object and set
966 # action appropriately if required (if action is not set)
967 $input_params{'action'} ||= "shortlog";
969 if ($input_params{'action'} &&
970 grep { $_ eq $input_params{'action'} } @wants_base) {
971 $input_params{'hash_base'} ||= $refname;
972 } else {
973 $input_params{'hash'} ||= $refname;
977 # next, handle the 'parent' part, if present
978 if (defined $parentrefname) {
979 # a missing pathspec defaults to the 'current' filename, allowing e.g.
980 # someproject/blobdiff/oldrev..newrev:/filename
981 if ($parentpathname) {
982 $parentpathname =~ s,^/+,,;
983 $parentpathname =~ s,/$,,;
984 $input_params{'file_parent'} ||= $parentpathname;
985 } else {
986 $input_params{'file_parent'} ||= $input_params{'file_name'};
988 # we assume that hash_parent_base is wanted if a path was specified,
989 # or if the action wants hash_base instead of hash
990 if (defined $input_params{'file_parent'} ||
991 grep { $_ eq $input_params{'action'} } @wants_base) {
992 $input_params{'hash_parent_base'} ||= $parentrefname;
993 } else {
994 $input_params{'hash_parent'} ||= $parentrefname;
998 # for the snapshot action, we allow URLs in the form
999 # $project/snapshot/$hash.ext
1000 # where .ext determines the snapshot and gets removed from the
1001 # passed $refname to provide the $hash.
1003 # To be able to tell that $refname includes the format extension, we
1004 # require the following two conditions to be satisfied:
1005 # - the hash input parameter MUST have been set from the $refname part
1006 # of the URL (i.e. they must be equal)
1007 # - the snapshot format MUST NOT have been defined already (e.g. from
1008 # CGI parameter sf)
1009 # It's also useless to try any matching unless $refname has a dot,
1010 # so we check for that too
1011 if (defined $input_params{'action'} &&
1012 $input_params{'action'} eq 'snapshot' &&
1013 defined $refname && index($refname, '.') != -1 &&
1014 $refname eq $input_params{'hash'} &&
1015 !defined $input_params{'snapshot_format'}) {
1016 # We loop over the known snapshot formats, checking for
1017 # extensions. Allowed extensions are both the defined suffix
1018 # (which includes the initial dot already) and the snapshot
1019 # format key itself, with a prepended dot
1020 while (my ($fmt, $opt) = each %known_snapshot_formats) {
1021 my $hash = $refname;
1022 unless ($hash =~ s/(\Q$opt->{'suffix'}\E|\Q.$fmt\E)$//) {
1023 next;
1025 my $sfx = $1;
1026 # a valid suffix was found, so set the snapshot format
1027 # and reset the hash parameter
1028 $input_params{'snapshot_format'} = $fmt;
1029 $input_params{'hash'} = $hash;
1030 # we also set the format suffix to the one requested
1031 # in the URL: this way a request for e.g. .tgz returns
1032 # a .tgz instead of a .tar.gz
1033 $known_snapshot_formats{$fmt}{'suffix'} = $sfx;
1034 last;
1039 our ($action, $project, $file_name, $file_parent, $hash, $hash_parent, $hash_base,
1040 $hash_parent_base, @extra_options, $page, $searchtype, $search_use_regexp,
1041 $searchtext, $search_regexp, $project_filter);
1042 sub evaluate_and_validate_params {
1043 our $action = $input_params{'action'};
1044 if (defined $action) {
1045 if (!is_valid_action($action)) {
1046 die_error(400, "Invalid action parameter");
1050 # parameters which are pathnames
1051 our $project = $input_params{'project'};
1052 if (defined $project) {
1053 if (!is_valid_project($project)) {
1054 undef $project;
1055 die_error(404, "No such project");
1059 our $project_filter = $input_params{'project_filter'};
1060 if (defined $project_filter) {
1061 if (!is_valid_pathname($project_filter)) {
1062 die_error(404, "Invalid project_filter parameter");
1066 our $file_name = $input_params{'file_name'};
1067 if (defined $file_name) {
1068 if (!is_valid_pathname($file_name)) {
1069 die_error(400, "Invalid file parameter");
1073 our $file_parent = $input_params{'file_parent'};
1074 if (defined $file_parent) {
1075 if (!is_valid_pathname($file_parent)) {
1076 die_error(400, "Invalid file parent parameter");
1080 # parameters which are refnames
1081 our $hash = $input_params{'hash'};
1082 if (defined $hash) {
1083 if (!is_valid_refname($hash)) {
1084 die_error(400, "Invalid hash parameter");
1088 our $hash_parent = $input_params{'hash_parent'};
1089 if (defined $hash_parent) {
1090 if (!is_valid_refname($hash_parent)) {
1091 die_error(400, "Invalid hash parent parameter");
1095 our $hash_base = $input_params{'hash_base'};
1096 if (defined $hash_base) {
1097 if (!is_valid_refname($hash_base)) {
1098 die_error(400, "Invalid hash base parameter");
1102 our @extra_options = @{$input_params{'extra_options'}};
1103 # @extra_options is always defined, since it can only be (currently) set from
1104 # CGI, and $cgi->param() returns the empty array in array context if the param
1105 # is not set
1106 foreach my $opt (@extra_options) {
1107 if (not exists $allowed_options{$opt}) {
1108 die_error(400, "Invalid option parameter");
1110 if (not grep(/^$action$/, @{$allowed_options{$opt}})) {
1111 die_error(400, "Invalid option parameter for this action");
1115 our $hash_parent_base = $input_params{'hash_parent_base'};
1116 if (defined $hash_parent_base) {
1117 if (!is_valid_refname($hash_parent_base)) {
1118 die_error(400, "Invalid hash parent base parameter");
1122 # other parameters
1123 our $page = $input_params{'page'};
1124 if (defined $page) {
1125 if ($page =~ m/[^0-9]/) {
1126 die_error(400, "Invalid page parameter");
1130 our $searchtype = $input_params{'searchtype'};
1131 if (defined $searchtype) {
1132 if ($searchtype =~ m/[^a-z]/) {
1133 die_error(400, "Invalid searchtype parameter");
1137 our $search_use_regexp = $input_params{'search_use_regexp'};
1139 our $searchtext = $input_params{'searchtext'};
1140 our $search_regexp = undef;
1141 if (defined $searchtext) {
1142 if (length($searchtext) < 2) {
1143 die_error(403, "At least two characters are required for search parameter");
1145 if ($search_use_regexp) {
1146 $search_regexp = $searchtext;
1147 if (!eval { qr/$search_regexp/; 1; }) {
1148 (my $error = $@) =~ s/ at \S+ line \d+.*\n?//;
1149 die_error(400, "Invalid search regexp '$search_regexp'",
1150 esc_html($error));
1152 } else {
1153 $search_regexp = quotemeta $searchtext;
1158 # path to the current git repository
1159 our $git_dir;
1160 sub evaluate_git_dir {
1161 our $git_dir = "$projectroot/$project" if $project;
1164 our (@snapshot_fmts, $git_avatar, @extra_branch_refs);
1165 sub configure_gitweb_features {
1166 # list of supported snapshot formats
1167 our @snapshot_fmts = gitweb_get_feature('snapshot');
1168 @snapshot_fmts = filter_snapshot_fmts(@snapshot_fmts);
1170 our ($git_avatar) = gitweb_get_feature('avatar');
1171 $git_avatar = '' unless $git_avatar =~ /^(?:gravatar|picon)$/s;
1173 our @extra_branch_refs = gitweb_get_feature('extra-branch-refs');
1174 @extra_branch_refs = filter_and_validate_refs (@extra_branch_refs);
1177 sub get_branch_refs {
1178 return ('heads', @extra_branch_refs);
1181 # custom error handler: 'die <message>' is Internal Server Error
1182 sub handle_errors_html {
1183 my $msg = shift; # it is already HTML escaped
1185 # to avoid infinite loop where error occurs in die_error,
1186 # change handler to default handler, disabling handle_errors_html
1187 set_message("Error occurred when inside die_error:\n$msg");
1189 # you cannot jump out of die_error when called as error handler;
1190 # the subroutine set via CGI::Carp::set_message is called _after_
1191 # HTTP headers are already written, so it cannot write them itself
1192 die_error(undef, undef, $msg, -error_handler => 1, -no_http_header => 1);
1194 set_message(\&handle_errors_html);
1196 # dispatch
1197 sub dispatch {
1198 if (!defined $action) {
1199 if (defined $hash) {
1200 $action = git_get_type($hash);
1201 $action or die_error(404, "Object does not exist");
1202 } elsif (defined $hash_base && defined $file_name) {
1203 $action = git_get_type("$hash_base:$file_name");
1204 $action or die_error(404, "File or directory does not exist");
1205 } elsif (defined $project) {
1206 $action = 'summary';
1207 } else {
1208 $action = 'project_list';
1211 if (!defined($actions{$action})) {
1212 die_error(400, "Unknown action");
1214 if ($action !~ m/^(?:opml|project_list|project_index)$/ &&
1215 !$project) {
1216 die_error(400, "Project needed");
1218 $actions{$action}->();
1221 sub reset_timer {
1222 our $t0 = [ gettimeofday() ]
1223 if defined $t0;
1224 our $number_of_git_cmds = 0;
1227 our $first_request = 1;
1228 sub run_request {
1229 reset_timer();
1231 evaluate_uri();
1232 if ($first_request) {
1233 evaluate_gitweb_config();
1234 evaluate_git_version();
1236 if ($per_request_config) {
1237 if (ref($per_request_config) eq 'CODE') {
1238 $per_request_config->();
1239 } elsif (!$first_request) {
1240 evaluate_gitweb_config();
1243 check_loadavg();
1245 # $projectroot and $projects_list might be set in gitweb config file
1246 $projects_list ||= $projectroot;
1248 evaluate_query_params();
1249 evaluate_path_info();
1250 evaluate_and_validate_params();
1251 evaluate_git_dir();
1253 configure_gitweb_features();
1255 dispatch();
1258 our $is_last_request = sub { 1 };
1259 our ($pre_dispatch_hook, $post_dispatch_hook, $pre_listen_hook);
1260 our $CGI = 'CGI';
1261 our $cgi;
1262 sub configure_as_fcgi {
1263 require CGI::Fast;
1264 our $CGI = 'CGI::Fast';
1266 my $request_number = 0;
1267 # let each child service 100 requests
1268 our $is_last_request = sub { ++$request_number > 100 };
1270 sub evaluate_argv {
1271 my $script_name = $ENV{'SCRIPT_NAME'} || $ENV{'SCRIPT_FILENAME'} || __FILE__;
1272 configure_as_fcgi()
1273 if $script_name =~ /\.fcgi$/;
1275 return unless (@ARGV);
1277 require Getopt::Long;
1278 Getopt::Long::GetOptions(
1279 'fastcgi|fcgi|f' => \&configure_as_fcgi,
1280 'nproc|n=i' => sub {
1281 my ($arg, $val) = @_;
1282 return unless eval { require FCGI::ProcManager; 1; };
1283 my $proc_manager = FCGI::ProcManager->new({
1284 n_processes => $val,
1286 our $pre_listen_hook = sub { $proc_manager->pm_manage() };
1287 our $pre_dispatch_hook = sub { $proc_manager->pm_pre_dispatch() };
1288 our $post_dispatch_hook = sub { $proc_manager->pm_post_dispatch() };
1293 sub run {
1294 evaluate_argv();
1296 $first_request = 1;
1297 $pre_listen_hook->()
1298 if $pre_listen_hook;
1300 REQUEST:
1301 while ($cgi = $CGI->new()) {
1302 $pre_dispatch_hook->()
1303 if $pre_dispatch_hook;
1305 run_request();
1307 $post_dispatch_hook->()
1308 if $post_dispatch_hook;
1309 $first_request = 0;
1311 last REQUEST if ($is_last_request->());
1314 DONE_GITWEB:
1318 run();
1320 if (defined caller) {
1321 # wrapped in a subroutine processing requests,
1322 # e.g. mod_perl with ModPerl::Registry, or PSGI with Plack::App::WrapCGI
1323 return;
1324 } else {
1325 # pure CGI script, serving single request
1326 exit;
1329 ## ======================================================================
1330 ## action links
1332 # possible values of extra options
1333 # -full => 0|1 - use absolute/full URL ($my_uri/$my_url as base)
1334 # -replay => 1 - start from a current view (replay with modifications)
1335 # -path_info => 0|1 - don't use/use path_info URL (if possible)
1336 # -anchor => ANCHOR - add #ANCHOR to end of URL, implies -replay if used alone
1337 sub href {
1338 my %params = @_;
1339 # default is to use -absolute url() i.e. $my_uri
1340 my $href = $params{-full} ? $my_url : $my_uri;
1342 # implicit -replay, must be first of implicit params
1343 $params{-replay} = 1 if (keys %params == 1 && $params{-anchor});
1345 $params{'project'} = $project unless exists $params{'project'};
1347 if ($params{-replay}) {
1348 while (my ($name, $symbol) = each %cgi_param_mapping) {
1349 if (!exists $params{$name}) {
1350 $params{$name} = $input_params{$name};
1355 my $use_pathinfo = gitweb_check_feature('pathinfo');
1356 if (defined $params{'project'} &&
1357 (exists $params{-path_info} ? $params{-path_info} : $use_pathinfo)) {
1358 # try to put as many parameters as possible in PATH_INFO:
1359 # - project name
1360 # - action
1361 # - hash_parent or hash_parent_base:/file_parent
1362 # - hash or hash_base:/filename
1363 # - the snapshot_format as an appropriate suffix
1365 # When the script is the root DirectoryIndex for the domain,
1366 # $href here would be something like http://gitweb.example.com/
1367 # Thus, we strip any trailing / from $href, to spare us double
1368 # slashes in the final URL
1369 $href =~ s,/$,,;
1371 # Then add the project name, if present
1372 $href .= "/".esc_path_info($params{'project'});
1373 delete $params{'project'};
1375 # since we destructively absorb parameters, we keep this
1376 # boolean that remembers if we're handling a snapshot
1377 my $is_snapshot = $params{'action'} eq 'snapshot';
1379 # Summary just uses the project path URL, any other action is
1380 # added to the URL
1381 if (defined $params{'action'}) {
1382 $href .= "/".esc_path_info($params{'action'})
1383 unless $params{'action'} eq 'summary';
1384 delete $params{'action'};
1387 # Next, we put hash_parent_base:/file_parent..hash_base:/file_name,
1388 # stripping nonexistent or useless pieces
1389 $href .= "/" if ($params{'hash_base'} || $params{'hash_parent_base'}
1390 || $params{'hash_parent'} || $params{'hash'});
1391 if (defined $params{'hash_base'}) {
1392 if (defined $params{'hash_parent_base'}) {
1393 $href .= esc_path_info($params{'hash_parent_base'});
1394 # skip the file_parent if it's the same as the file_name
1395 if (defined $params{'file_parent'}) {
1396 if (defined $params{'file_name'} && $params{'file_parent'} eq $params{'file_name'}) {
1397 delete $params{'file_parent'};
1398 } elsif ($params{'file_parent'} !~ /\.\./) {
1399 $href .= ":/".esc_path_info($params{'file_parent'});
1400 delete $params{'file_parent'};
1403 $href .= "..";
1404 delete $params{'hash_parent'};
1405 delete $params{'hash_parent_base'};
1406 } elsif (defined $params{'hash_parent'}) {
1407 $href .= esc_path_info($params{'hash_parent'}). "..";
1408 delete $params{'hash_parent'};
1411 $href .= esc_path_info($params{'hash_base'});
1412 if (defined $params{'file_name'} && $params{'file_name'} !~ /\.\./) {
1413 $href .= ":/".esc_path_info($params{'file_name'});
1414 delete $params{'file_name'};
1416 delete $params{'hash'};
1417 delete $params{'hash_base'};
1418 } elsif (defined $params{'hash'}) {
1419 $href .= esc_path_info($params{'hash'});
1420 delete $params{'hash'};
1423 # If the action was a snapshot, we can absorb the
1424 # snapshot_format parameter too
1425 if ($is_snapshot) {
1426 my $fmt = $params{'snapshot_format'};
1427 # snapshot_format should always be defined when href()
1428 # is called, but just in case some code forgets, we
1429 # fall back to the default
1430 $fmt ||= $snapshot_fmts[0];
1431 $href .= $known_snapshot_formats{$fmt}{'suffix'};
1432 delete $params{'snapshot_format'};
1436 # now encode the parameters explicitly
1437 my @result = ();
1438 for (my $i = 0; $i < @cgi_param_mapping; $i += 2) {
1439 my ($name, $symbol) = ($cgi_param_mapping[$i], $cgi_param_mapping[$i+1]);
1440 if (defined $params{$name}) {
1441 if (ref($params{$name}) eq "ARRAY") {
1442 foreach my $par (@{$params{$name}}) {
1443 push @result, $symbol . "=" . esc_param($par);
1445 } else {
1446 push @result, $symbol . "=" . esc_param($params{$name});
1450 $href .= "?" . join(';', @result) if scalar @result;
1452 # final transformation: trailing spaces must be escaped (URI-encoded)
1453 $href =~ s/(\s+)$/CGI::escape($1)/e;
1455 if ($params{-anchor}) {
1456 $href .= "#".esc_param($params{-anchor});
1459 return $href;
1463 ## ======================================================================
1464 ## validation, quoting/unquoting and escaping
1466 sub is_valid_action {
1467 my $input = shift;
1468 return undef unless exists $actions{$input};
1469 return 1;
1472 sub is_valid_project {
1473 my $input = shift;
1475 return unless defined $input;
1476 if (!is_valid_pathname($input) ||
1477 !(-d "$projectroot/$input") ||
1478 !check_export_ok("$projectroot/$input") ||
1479 ($strict_export && !project_in_list($input))) {
1480 return undef;
1481 } else {
1482 return 1;
1486 sub is_valid_pathname {
1487 my $input = shift;
1489 return undef unless defined $input;
1490 # no '.' or '..' as elements of path, i.e. no '.' or '..'
1491 # at the beginning, at the end, and between slashes.
1492 # also this catches doubled slashes
1493 if ($input =~ m!(^|/)(|\.|\.\.)(/|$)!) {
1494 return undef;
1496 # no null characters
1497 if ($input =~ m!\0!) {
1498 return undef;
1500 return 1;
1503 sub is_valid_ref_format {
1504 my $input = shift;
1506 return undef unless defined $input;
1507 # restrictions on ref name according to git-check-ref-format
1508 if ($input =~ m!(/\.|\.\.|[\000-\040\177 ~^:?*\[]|/$)!) {
1509 return undef;
1511 return 1;
1514 sub is_valid_refname {
1515 my $input = shift;
1517 return undef unless defined $input;
1518 # textual hashes are O.K.
1519 if ($input =~ m/^[0-9a-fA-F]{40}$/) {
1520 return 1;
1522 # it must be correct pathname
1523 is_valid_pathname($input) or return undef;
1524 # check git-check-ref-format restrictions
1525 is_valid_ref_format($input) or return undef;
1526 return 1;
1529 # decode sequences of octets in utf8 into Perl's internal form,
1530 # which is utf-8 with utf8 flag set if needed. gitweb writes out
1531 # in utf-8 thanks to "binmode STDOUT, ':utf8'" at beginning
1532 sub to_utf8 {
1533 my $str = shift;
1534 return undef unless defined $str;
1536 if (utf8::is_utf8($str) || utf8::decode($str)) {
1537 return $str;
1538 } else {
1539 return decode($fallback_encoding, $str, Encode::FB_DEFAULT);
1543 # quote unsafe chars, but keep the slash, even when it's not
1544 # correct, but quoted slashes look too horrible in bookmarks
1545 sub esc_param {
1546 my $str = shift;
1547 return undef unless defined $str;
1548 $str =~ s/([^A-Za-z0-9\-_.~()\/:@ ]+)/CGI::escape($1)/eg;
1549 $str =~ s/ /\+/g;
1550 return $str;
1553 # the quoting rules for path_info fragment are slightly different
1554 sub esc_path_info {
1555 my $str = shift;
1556 return undef unless defined $str;
1558 # path_info doesn't treat '+' as space (specially), but '?' must be escaped
1559 $str =~ s/([^A-Za-z0-9\-_.~();\/;:@&= +]+)/CGI::escape($1)/eg;
1561 return $str;
1564 # quote unsafe chars in whole URL, so some characters cannot be quoted
1565 sub esc_url {
1566 my $str = shift;
1567 return undef unless defined $str;
1568 $str =~ s/([^A-Za-z0-9\-_.~();\/;?:@&= ]+)/CGI::escape($1)/eg;
1569 $str =~ s/ /\+/g;
1570 return $str;
1573 # quote unsafe characters in HTML attributes
1574 sub esc_attr {
1576 # for XHTML conformance escaping '"' to '&quot;' is not enough
1577 return esc_html(@_);
1580 # replace invalid utf8 character with SUBSTITUTION sequence
1581 sub esc_html {
1582 my $str = shift;
1583 my %opts = @_;
1585 return undef unless defined $str;
1587 $str = to_utf8($str);
1588 $str = $cgi->escapeHTML($str);
1589 if ($opts{'-nbsp'}) {
1590 $str =~ s/ /&nbsp;/g;
1592 $str =~ s|([[:cntrl:]])|(($1 ne "\t") ? quot_cec($1) : $1)|eg;
1593 return $str;
1596 # quote control characters and escape filename to HTML
1597 sub esc_path {
1598 my $str = shift;
1599 my %opts = @_;
1601 return undef unless defined $str;
1603 $str = to_utf8($str);
1604 $str = $cgi->escapeHTML($str);
1605 if ($opts{'-nbsp'}) {
1606 $str =~ s/ /&nbsp;/g;
1608 $str =~ s|([[:cntrl:]])|quot_cec($1)|eg;
1609 return $str;
1612 # Sanitize for use in XHTML + application/xml+xhtml (valid XML 1.0)
1613 sub sanitize {
1614 my $str = shift;
1616 return undef unless defined $str;
1618 $str = to_utf8($str);
1619 $str =~ s|([[:cntrl:]])|(index("\t\n\r", $1) != -1 ? $1 : quot_cec($1))|eg;
1620 return $str;
1623 # Make control characters "printable", using character escape codes (CEC)
1624 sub quot_cec {
1625 my $cntrl = shift;
1626 my %opts = @_;
1627 my %es = ( # character escape codes, aka escape sequences
1628 "\t" => '\t', # tab (HT)
1629 "\n" => '\n', # line feed (LF)
1630 "\r" => '\r', # carrige return (CR)
1631 "\f" => '\f', # form feed (FF)
1632 "\b" => '\b', # backspace (BS)
1633 "\a" => '\a', # alarm (bell) (BEL)
1634 "\e" => '\e', # escape (ESC)
1635 "\013" => '\v', # vertical tab (VT)
1636 "\000" => '\0', # nul character (NUL)
1638 my $chr = ( (exists $es{$cntrl})
1639 ? $es{$cntrl}
1640 : sprintf('\%2x', ord($cntrl)) );
1641 if ($opts{-nohtml}) {
1642 return $chr;
1643 } else {
1644 return "<span class=\"cntrl\">$chr</span>";
1648 # Alternatively use unicode control pictures codepoints,
1649 # Unicode "printable representation" (PR)
1650 sub quot_upr {
1651 my $cntrl = shift;
1652 my %opts = @_;
1654 my $chr = sprintf('&#%04d;', 0x2400+ord($cntrl));
1655 if ($opts{-nohtml}) {
1656 return $chr;
1657 } else {
1658 return "<span class=\"cntrl\">$chr</span>";
1662 # git may return quoted and escaped filenames
1663 sub unquote {
1664 my $str = shift;
1666 sub unq {
1667 my $seq = shift;
1668 my %es = ( # character escape codes, aka escape sequences
1669 't' => "\t", # tab (HT, TAB)
1670 'n' => "\n", # newline (NL)
1671 'r' => "\r", # return (CR)
1672 'f' => "\f", # form feed (FF)
1673 'b' => "\b", # backspace (BS)
1674 'a' => "\a", # alarm (bell) (BEL)
1675 'e' => "\e", # escape (ESC)
1676 'v' => "\013", # vertical tab (VT)
1679 if ($seq =~ m/^[0-7]{1,3}$/) {
1680 # octal char sequence
1681 return chr(oct($seq));
1682 } elsif (exists $es{$seq}) {
1683 # C escape sequence, aka character escape code
1684 return $es{$seq};
1686 # quoted ordinary character
1687 return $seq;
1690 if ($str =~ m/^"(.*)"$/) {
1691 # needs unquoting
1692 $str = $1;
1693 $str =~ s/\\([^0-7]|[0-7]{1,3})/unq($1)/eg;
1695 return $str;
1698 # escape tabs (convert tabs to spaces)
1699 sub untabify {
1700 my $line = shift;
1702 while ((my $pos = index($line, "\t")) != -1) {
1703 if (my $count = (8 - ($pos % 8))) {
1704 my $spaces = ' ' x $count;
1705 $line =~ s/\t/$spaces/;
1709 return $line;
1712 sub project_in_list {
1713 my $project = shift;
1714 my @list = git_get_projects_list();
1715 return @list && scalar(grep { $_->{'path'} eq $project } @list);
1718 ## ----------------------------------------------------------------------
1719 ## HTML aware string manipulation
1721 # Try to chop given string on a word boundary between position
1722 # $len and $len+$add_len. If there is no word boundary there,
1723 # chop at $len+$add_len. Do not chop if chopped part plus ellipsis
1724 # (marking chopped part) would be longer than given string.
1725 sub chop_str {
1726 my $str = shift;
1727 my $len = shift;
1728 my $add_len = shift || 10;
1729 my $where = shift || 'right'; # 'left' | 'center' | 'right'
1731 # Make sure perl knows it is utf8 encoded so we don't
1732 # cut in the middle of a utf8 multibyte char.
1733 $str = to_utf8($str);
1735 # allow only $len chars, but don't cut a word if it would fit in $add_len
1736 # if it doesn't fit, cut it if it's still longer than the dots we would add
1737 # remove chopped character entities entirely
1739 # when chopping in the middle, distribute $len into left and right part
1740 # return early if chopping wouldn't make string shorter
1741 if ($where eq 'center') {
1742 return $str if ($len + 5 >= length($str)); # filler is length 5
1743 $len = int($len/2);
1744 } else {
1745 return $str if ($len + 4 >= length($str)); # filler is length 4
1748 # regexps: ending and beginning with word part up to $add_len
1749 my $endre = qr/.{$len}\w{0,$add_len}/;
1750 my $begre = qr/\w{0,$add_len}.{$len}/;
1752 if ($where eq 'left') {
1753 $str =~ m/^(.*?)($begre)$/;
1754 my ($lead, $body) = ($1, $2);
1755 if (length($lead) > 4) {
1756 $lead = " ...";
1758 return "$lead$body";
1760 } elsif ($where eq 'center') {
1761 $str =~ m/^($endre)(.*)$/;
1762 my ($left, $str) = ($1, $2);
1763 $str =~ m/^(.*?)($begre)$/;
1764 my ($mid, $right) = ($1, $2);
1765 if (length($mid) > 5) {
1766 $mid = " ... ";
1768 return "$left$mid$right";
1770 } else {
1771 $str =~ m/^($endre)(.*)$/;
1772 my $body = $1;
1773 my $tail = $2;
1774 if (length($tail) > 4) {
1775 $tail = "... ";
1777 return "$body$tail";
1781 # takes the same arguments as chop_str, but also wraps a <span> around the
1782 # result with a title attribute if it does get chopped. Additionally, the
1783 # string is HTML-escaped.
1784 sub chop_and_escape_str {
1785 my ($str) = @_;
1787 my $chopped = chop_str(@_);
1788 $str = to_utf8($str);
1789 if ($chopped eq $str) {
1790 return esc_html($chopped);
1791 } else {
1792 $str =~ s/[[:cntrl:]]/?/g;
1793 return $cgi->span({-title=>$str}, esc_html($chopped));
1797 # Highlight selected fragments of string, using given CSS class,
1798 # and escape HTML. It is assumed that fragments do not overlap.
1799 # Regions are passed as list of pairs (array references).
1801 # Example: esc_html_hl_regions("foobar", "mark", [ 0, 3 ]) returns
1802 # '<span class="mark">foo</span>bar'
1803 sub esc_html_hl_regions {
1804 my ($str, $css_class, @sel) = @_;
1805 my %opts = grep { ref($_) ne 'ARRAY' } @sel;
1806 @sel = grep { ref($_) eq 'ARRAY' } @sel;
1807 return esc_html($str, %opts) unless @sel;
1809 my $out = '';
1810 my $pos = 0;
1812 for my $s (@sel) {
1813 my ($begin, $end) = @$s;
1815 # Don't create empty <span> elements.
1816 next if $end <= $begin;
1818 my $escaped = esc_html(substr($str, $begin, $end - $begin),
1819 %opts);
1821 $out .= esc_html(substr($str, $pos, $begin - $pos), %opts)
1822 if ($begin - $pos > 0);
1823 $out .= $cgi->span({-class => $css_class}, $escaped);
1825 $pos = $end;
1827 $out .= esc_html(substr($str, $pos), %opts)
1828 if ($pos < length($str));
1830 return $out;
1833 # return positions of beginning and end of each match
1834 sub matchpos_list {
1835 my ($str, $regexp) = @_;
1836 return unless (defined $str && defined $regexp);
1838 my @matches;
1839 while ($str =~ /$regexp/g) {
1840 push @matches, [$-[0], $+[0]];
1842 return @matches;
1845 # highlight match (if any), and escape HTML
1846 sub esc_html_match_hl {
1847 my ($str, $regexp) = @_;
1848 return esc_html($str) unless defined $regexp;
1850 my @matches = matchpos_list($str, $regexp);
1851 return esc_html($str) unless @matches;
1853 return esc_html_hl_regions($str, 'match', @matches);
1857 # highlight match (if any) of shortened string, and escape HTML
1858 sub esc_html_match_hl_chopped {
1859 my ($str, $chopped, $regexp) = @_;
1860 return esc_html_match_hl($str, $regexp) unless defined $chopped;
1862 my @matches = matchpos_list($str, $regexp);
1863 return esc_html($chopped) unless @matches;
1865 # filter matches so that we mark chopped string
1866 my $tail = "... "; # see chop_str
1867 unless ($chopped =~ s/\Q$tail\E$//) {
1868 $tail = '';
1870 my $chop_len = length($chopped);
1871 my $tail_len = length($tail);
1872 my @filtered;
1874 for my $m (@matches) {
1875 if ($m->[0] > $chop_len) {
1876 push @filtered, [ $chop_len, $chop_len + $tail_len ] if ($tail_len > 0);
1877 last;
1878 } elsif ($m->[1] > $chop_len) {
1879 push @filtered, [ $m->[0], $chop_len + $tail_len ];
1880 last;
1882 push @filtered, $m;
1885 return esc_html_hl_regions($chopped . $tail, 'match', @filtered);
1888 ## ----------------------------------------------------------------------
1889 ## functions returning short strings
1891 # CSS class for given age value (in seconds)
1892 sub age_class {
1893 my $age = shift;
1895 if (!defined $age) {
1896 return "noage";
1897 } elsif ($age < 60*60*2) {
1898 return "age0";
1899 } elsif ($age < 60*60*24*2) {
1900 return "age1";
1901 } else {
1902 return "age2";
1906 # convert age in seconds to "nn units ago" string
1907 sub age_string {
1908 my $age = shift;
1909 my $age_str;
1911 if ($age > 60*60*24*365*2) {
1912 $age_str = (int $age/60/60/24/365);
1913 $age_str .= " years ago";
1914 } elsif ($age > 60*60*24*(365/12)*2) {
1915 $age_str = int $age/60/60/24/(365/12);
1916 $age_str .= " months ago";
1917 } elsif ($age > 60*60*24*7*2) {
1918 $age_str = int $age/60/60/24/7;
1919 $age_str .= " weeks ago";
1920 } elsif ($age > 60*60*24*2) {
1921 $age_str = int $age/60/60/24;
1922 $age_str .= " days ago";
1923 } elsif ($age > 60*60*2) {
1924 $age_str = int $age/60/60;
1925 $age_str .= " hours ago";
1926 } elsif ($age > 60*2) {
1927 $age_str = int $age/60;
1928 $age_str .= " min ago";
1929 } elsif ($age > 2) {
1930 $age_str = int $age;
1931 $age_str .= " sec ago";
1932 } else {
1933 $age_str .= " right now";
1935 return $age_str;
1938 use constant {
1939 S_IFINVALID => 0030000,
1940 S_IFGITLINK => 0160000,
1943 # submodule/subproject, a commit object reference
1944 sub S_ISGITLINK {
1945 my $mode = shift;
1947 return (($mode & S_IFMT) == S_IFGITLINK)
1950 # convert file mode in octal to symbolic file mode string
1951 sub mode_str {
1952 my $mode = oct shift;
1954 if (S_ISGITLINK($mode)) {
1955 return 'm---------';
1956 } elsif (S_ISDIR($mode & S_IFMT)) {
1957 return 'drwxr-xr-x';
1958 } elsif (S_ISLNK($mode)) {
1959 return 'lrwxrwxrwx';
1960 } elsif (S_ISREG($mode)) {
1961 # git cares only about the executable bit
1962 if ($mode & S_IXUSR) {
1963 return '-rwxr-xr-x';
1964 } else {
1965 return '-rw-r--r--';
1967 } else {
1968 return '----------';
1972 # convert file mode in octal to file type string
1973 sub file_type {
1974 my $mode = shift;
1976 if ($mode !~ m/^[0-7]+$/) {
1977 return $mode;
1978 } else {
1979 $mode = oct $mode;
1982 if (S_ISGITLINK($mode)) {
1983 return "submodule";
1984 } elsif (S_ISDIR($mode & S_IFMT)) {
1985 return "directory";
1986 } elsif (S_ISLNK($mode)) {
1987 return "symlink";
1988 } elsif (S_ISREG($mode)) {
1989 return "file";
1990 } else {
1991 return "unknown";
1995 # convert file mode in octal to file type description string
1996 sub file_type_long {
1997 my $mode = shift;
1999 if ($mode !~ m/^[0-7]+$/) {
2000 return $mode;
2001 } else {
2002 $mode = oct $mode;
2005 if (S_ISGITLINK($mode)) {
2006 return "submodule";
2007 } elsif (S_ISDIR($mode & S_IFMT)) {
2008 return "directory";
2009 } elsif (S_ISLNK($mode)) {
2010 return "symlink";
2011 } elsif (S_ISREG($mode)) {
2012 if ($mode & S_IXUSR) {
2013 return "executable";
2014 } else {
2015 return "file";
2017 } else {
2018 return "unknown";
2023 ## ----------------------------------------------------------------------
2024 ## functions returning short HTML fragments, or transforming HTML fragments
2025 ## which don't belong to other sections
2027 # format line of commit message.
2028 sub format_log_line_html {
2029 my $line = shift;
2031 $line = esc_html($line, -nbsp=>1);
2032 $line =~ s{
2035 # The output of "git describe", e.g. v2.10.0-297-gf6727b0
2036 # or hadoop-20160921-113441-20-g094fb7d
2037 (?<!-) # see strbuf_check_tag_ref(). Tags can't start with -
2038 [A-Za-z0-9.-]+
2039 (?!\.) # refs can't end with ".", see check_refname_format()
2040 -g[0-9a-fA-F]{7,40}
2042 # Just a normal looking Git SHA1
2043 [0-9a-fA-F]{7,40}
2047 $cgi->a({-href => href(action=>"object", hash=>$1),
2048 -class => "text"}, $1);
2049 }egx;
2051 return $line;
2054 # format marker of refs pointing to given object
2056 # the destination action is chosen based on object type and current context:
2057 # - for annotated tags, we choose the tag view unless it's the current view
2058 # already, in which case we go to shortlog view
2059 # - for other refs, we keep the current view if we're in history, shortlog or
2060 # log view, and select shortlog otherwise
2061 sub format_ref_marker {
2062 my ($refs, $id) = @_;
2063 my $markers = '';
2065 if (defined $refs->{$id}) {
2066 foreach my $ref (@{$refs->{$id}}) {
2067 # this code exploits the fact that non-lightweight tags are the
2068 # only indirect objects, and that they are the only objects for which
2069 # we want to use tag instead of shortlog as action
2070 my ($type, $name) = qw();
2071 my $indirect = ($ref =~ s/\^\{\}$//);
2072 # e.g. tags/v2.6.11 or heads/next
2073 if ($ref =~ m!^(.*?)s?/(.*)$!) {
2074 $type = $1;
2075 $name = $2;
2076 } else {
2077 $type = "ref";
2078 $name = $ref;
2081 my $class = $type;
2082 $class .= " indirect" if $indirect;
2084 my $dest_action = "shortlog";
2086 if ($indirect) {
2087 $dest_action = "tag" unless $action eq "tag";
2088 } elsif ($action =~ /^(history|(short)?log)$/) {
2089 $dest_action = $action;
2092 my $dest = "";
2093 $dest .= "refs/" unless $ref =~ m!^refs/!;
2094 $dest .= $ref;
2096 my $link = $cgi->a({
2097 -href => href(
2098 action=>$dest_action,
2099 hash=>$dest
2100 )}, esc_html($name));
2102 $markers .= " <span class=\"".esc_attr($class)."\" title=\"".esc_attr($ref)."\">" .
2103 $link . "</span>";
2107 if ($markers) {
2108 return ' <span class="refs">'. $markers . '</span>';
2109 } else {
2110 return "";
2114 # format, perhaps shortened and with markers, title line
2115 sub format_subject_html {
2116 my ($long, $short, $href, $extra) = @_;
2117 $extra = '' unless defined($extra);
2119 if (length($short) < length($long)) {
2120 $long =~ s/[[:cntrl:]]/?/g;
2121 return $cgi->a({-href => $href, -class => "list subject",
2122 -title => to_utf8($long)},
2123 esc_html($short)) . $extra;
2124 } else {
2125 return $cgi->a({-href => $href, -class => "list subject"},
2126 esc_html($long)) . $extra;
2130 # Rather than recomputing the url for an email multiple times, we cache it
2131 # after the first hit. This gives a visible benefit in views where the avatar
2132 # for the same email is used repeatedly (e.g. shortlog).
2133 # The cache is shared by all avatar engines (currently gravatar only), which
2134 # are free to use it as preferred. Since only one avatar engine is used for any
2135 # given page, there's no risk for cache conflicts.
2136 our %avatar_cache = ();
2138 # Compute the picon url for a given email, by using the picon search service over at
2139 # http://www.cs.indiana.edu/picons/search.html
2140 sub picon_url {
2141 my $email = lc shift;
2142 if (!$avatar_cache{$email}) {
2143 my ($user, $domain) = split('@', $email);
2144 $avatar_cache{$email} =
2145 "//www.cs.indiana.edu/cgi-pub/kinzler/piconsearch.cgi/" .
2146 "$domain/$user/" .
2147 "users+domains+unknown/up/single";
2149 return $avatar_cache{$email};
2152 # Compute the gravatar url for a given email, if it's not in the cache already.
2153 # Gravatar stores only the part of the URL before the size, since that's the
2154 # one computationally more expensive. This also allows reuse of the cache for
2155 # different sizes (for this particular engine).
2156 sub gravatar_url {
2157 my $email = lc shift;
2158 my $size = shift;
2159 $avatar_cache{$email} ||=
2160 "//www.gravatar.com/avatar/" .
2161 md5_hex($email) . "?s=";
2162 return $avatar_cache{$email} . $size;
2165 # Insert an avatar for the given $email at the given $size if the feature
2166 # is enabled.
2167 sub git_get_avatar {
2168 my ($email, %opts) = @_;
2169 my $pre_white = ($opts{-pad_before} ? "&nbsp;" : "");
2170 my $post_white = ($opts{-pad_after} ? "&nbsp;" : "");
2171 $opts{-size} ||= 'default';
2172 my $size = $avatar_size{$opts{-size}} || $avatar_size{'default'};
2173 my $url = "";
2174 if ($git_avatar eq 'gravatar') {
2175 $url = gravatar_url($email, $size);
2176 } elsif ($git_avatar eq 'picon') {
2177 $url = picon_url($email);
2179 # Other providers can be added by extending the if chain, defining $url
2180 # as needed. If no variant puts something in $url, we assume avatars
2181 # are completely disabled/unavailable.
2182 if ($url) {
2183 return $pre_white .
2184 "<img width=\"$size\" " .
2185 "class=\"avatar\" " .
2186 "src=\"".esc_url($url)."\" " .
2187 "alt=\"\" " .
2188 "/>" . $post_white;
2189 } else {
2190 return "";
2194 sub format_search_author {
2195 my ($author, $searchtype, $displaytext) = @_;
2196 my $have_search = gitweb_check_feature('search');
2198 if ($have_search) {
2199 my $performed = "";
2200 if ($searchtype eq 'author') {
2201 $performed = "authored";
2202 } elsif ($searchtype eq 'committer') {
2203 $performed = "committed";
2206 return $cgi->a({-href => href(action=>"search", hash=>$hash,
2207 searchtext=>$author,
2208 searchtype=>$searchtype), class=>"list",
2209 title=>"Search for commits $performed by $author"},
2210 $displaytext);
2212 } else {
2213 return $displaytext;
2217 # format the author name of the given commit with the given tag
2218 # the author name is chopped and escaped according to the other
2219 # optional parameters (see chop_str).
2220 sub format_author_html {
2221 my $tag = shift;
2222 my $co = shift;
2223 my $author = chop_and_escape_str($co->{'author_name'}, @_);
2224 return "<$tag class=\"author\">" .
2225 format_search_author($co->{'author_name'}, "author",
2226 git_get_avatar($co->{'author_email'}, -pad_after => 1) .
2227 $author) .
2228 "</$tag>";
2231 # format git diff header line, i.e. "diff --(git|combined|cc) ..."
2232 sub format_git_diff_header_line {
2233 my $line = shift;
2234 my $diffinfo = shift;
2235 my ($from, $to) = @_;
2237 if ($diffinfo->{'nparents'}) {
2238 # combined diff
2239 $line =~ s!^(diff (.*?) )"?.*$!$1!;
2240 if ($to->{'href'}) {
2241 $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2242 esc_path($to->{'file'}));
2243 } else { # file was deleted (no href)
2244 $line .= esc_path($to->{'file'});
2246 } else {
2247 # "ordinary" diff
2248 $line =~ s!^(diff (.*?) )"?a/.*$!$1!;
2249 if ($from->{'href'}) {
2250 $line .= $cgi->a({-href => $from->{'href'}, -class => "path"},
2251 'a/' . esc_path($from->{'file'}));
2252 } else { # file was added (no href)
2253 $line .= 'a/' . esc_path($from->{'file'});
2255 $line .= ' ';
2256 if ($to->{'href'}) {
2257 $line .= $cgi->a({-href => $to->{'href'}, -class => "path"},
2258 'b/' . esc_path($to->{'file'}));
2259 } else { # file was deleted
2260 $line .= 'b/' . esc_path($to->{'file'});
2264 return "<div class=\"diff header\">$line</div>\n";
2267 # format extended diff header line, before patch itself
2268 sub format_extended_diff_header_line {
2269 my $line = shift;
2270 my $diffinfo = shift;
2271 my ($from, $to) = @_;
2273 # match <path>
2274 if ($line =~ s!^((copy|rename) from ).*$!$1! && $from->{'href'}) {
2275 $line .= $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2276 esc_path($from->{'file'}));
2278 if ($line =~ s!^((copy|rename) to ).*$!$1! && $to->{'href'}) {
2279 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2280 esc_path($to->{'file'}));
2282 # match single <mode>
2283 if ($line =~ m/\s(\d{6})$/) {
2284 $line .= '<span class="info"> (' .
2285 file_type_long($1) .
2286 ')</span>';
2288 # match <hash>
2289 if ($line =~ m/^index [0-9a-fA-F]{40},[0-9a-fA-F]{40}/) {
2290 # can match only for combined diff
2291 $line = 'index ';
2292 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2293 if ($from->{'href'}[$i]) {
2294 $line .= $cgi->a({-href=>$from->{'href'}[$i],
2295 -class=>"hash"},
2296 substr($diffinfo->{'from_id'}[$i],0,7));
2297 } else {
2298 $line .= '0' x 7;
2300 # separator
2301 $line .= ',' if ($i < $diffinfo->{'nparents'} - 1);
2303 $line .= '..';
2304 if ($to->{'href'}) {
2305 $line .= $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2306 substr($diffinfo->{'to_id'},0,7));
2307 } else {
2308 $line .= '0' x 7;
2311 } elsif ($line =~ m/^index [0-9a-fA-F]{40}..[0-9a-fA-F]{40}/) {
2312 # can match only for ordinary diff
2313 my ($from_link, $to_link);
2314 if ($from->{'href'}) {
2315 $from_link = $cgi->a({-href=>$from->{'href'}, -class=>"hash"},
2316 substr($diffinfo->{'from_id'},0,7));
2317 } else {
2318 $from_link = '0' x 7;
2320 if ($to->{'href'}) {
2321 $to_link = $cgi->a({-href=>$to->{'href'}, -class=>"hash"},
2322 substr($diffinfo->{'to_id'},0,7));
2323 } else {
2324 $to_link = '0' x 7;
2326 my ($from_id, $to_id) = ($diffinfo->{'from_id'}, $diffinfo->{'to_id'});
2327 $line =~ s!$from_id\.\.$to_id!$from_link..$to_link!;
2330 return $line . "<br/>\n";
2333 # format from-file/to-file diff header
2334 sub format_diff_from_to_header {
2335 my ($from_line, $to_line, $diffinfo, $from, $to, @parents) = @_;
2336 my $line;
2337 my $result = '';
2339 $line = $from_line;
2340 #assert($line =~ m/^---/) if DEBUG;
2341 # no extra formatting for "^--- /dev/null"
2342 if (! $diffinfo->{'nparents'}) {
2343 # ordinary (single parent) diff
2344 if ($line =~ m!^--- "?a/!) {
2345 if ($from->{'href'}) {
2346 $line = '--- a/' .
2347 $cgi->a({-href=>$from->{'href'}, -class=>"path"},
2348 esc_path($from->{'file'}));
2349 } else {
2350 $line = '--- a/' .
2351 esc_path($from->{'file'});
2354 $result .= qq!<div class="diff from_file">$line</div>\n!;
2356 } else {
2357 # combined diff (merge commit)
2358 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
2359 if ($from->{'href'}[$i]) {
2360 $line = '--- ' .
2361 $cgi->a({-href=>href(action=>"blobdiff",
2362 hash_parent=>$diffinfo->{'from_id'}[$i],
2363 hash_parent_base=>$parents[$i],
2364 file_parent=>$from->{'file'}[$i],
2365 hash=>$diffinfo->{'to_id'},
2366 hash_base=>$hash,
2367 file_name=>$to->{'file'}),
2368 -class=>"path",
2369 -title=>"diff" . ($i+1)},
2370 $i+1) .
2371 '/' .
2372 $cgi->a({-href=>$from->{'href'}[$i], -class=>"path"},
2373 esc_path($from->{'file'}[$i]));
2374 } else {
2375 $line = '--- /dev/null';
2377 $result .= qq!<div class="diff from_file">$line</div>\n!;
2381 $line = $to_line;
2382 #assert($line =~ m/^\+\+\+/) if DEBUG;
2383 # no extra formatting for "^+++ /dev/null"
2384 if ($line =~ m!^\+\+\+ "?b/!) {
2385 if ($to->{'href'}) {
2386 $line = '+++ b/' .
2387 $cgi->a({-href=>$to->{'href'}, -class=>"path"},
2388 esc_path($to->{'file'}));
2389 } else {
2390 $line = '+++ b/' .
2391 esc_path($to->{'file'});
2394 $result .= qq!<div class="diff to_file">$line</div>\n!;
2396 return $result;
2399 # create note for patch simplified by combined diff
2400 sub format_diff_cc_simplified {
2401 my ($diffinfo, @parents) = @_;
2402 my $result = '';
2404 $result .= "<div class=\"diff header\">" .
2405 "diff --cc ";
2406 if (!is_deleted($diffinfo)) {
2407 $result .= $cgi->a({-href => href(action=>"blob",
2408 hash_base=>$hash,
2409 hash=>$diffinfo->{'to_id'},
2410 file_name=>$diffinfo->{'to_file'}),
2411 -class => "path"},
2412 esc_path($diffinfo->{'to_file'}));
2413 } else {
2414 $result .= esc_path($diffinfo->{'to_file'});
2416 $result .= "</div>\n" . # class="diff header"
2417 "<div class=\"diff nodifferences\">" .
2418 "Simple merge" .
2419 "</div>\n"; # class="diff nodifferences"
2421 return $result;
2424 sub diff_line_class {
2425 my ($line, $from, $to) = @_;
2427 # ordinary diff
2428 my $num_sign = 1;
2429 # combined diff
2430 if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
2431 $num_sign = scalar @{$from->{'href'}};
2434 my @diff_line_classifier = (
2435 { regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
2436 { regexp => qr/^\\/, class => "incomplete" },
2437 { regexp => qr/^ {$num_sign}/, class => "ctx" },
2438 # classifier for context must come before classifier add/rem,
2439 # or we would have to use more complicated regexp, for example
2440 # qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
2441 { regexp => qr/^[+ ]{$num_sign}/, class => "add" },
2442 { regexp => qr/^[- ]{$num_sign}/, class => "rem" },
2444 for my $clsfy (@diff_line_classifier) {
2445 return $clsfy->{'class'}
2446 if ($line =~ $clsfy->{'regexp'});
2449 # fallback
2450 return "";
2453 # assumes that $from and $to are defined and correctly filled,
2454 # and that $line holds a line of chunk header for unified diff
2455 sub format_unidiff_chunk_header {
2456 my ($line, $from, $to) = @_;
2458 my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
2459 $line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
2461 $from_lines = 0 unless defined $from_lines;
2462 $to_lines = 0 unless defined $to_lines;
2464 if ($from->{'href'}) {
2465 $from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
2466 -class=>"list"}, $from_text);
2468 if ($to->{'href'}) {
2469 $to_text = $cgi->a({-href=>"$to->{'href'}#l$to_start",
2470 -class=>"list"}, $to_text);
2472 $line = "<span class=\"chunk_info\">@@ $from_text $to_text @@</span>" .
2473 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
2474 return $line;
2477 # assumes that $from and $to are defined and correctly filled,
2478 # and that $line holds a line of chunk header for combined diff
2479 sub format_cc_diff_chunk_header {
2480 my ($line, $from, $to) = @_;
2482 my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
2483 my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
2485 @from_text = split(' ', $ranges);
2486 for (my $i = 0; $i < @from_text; ++$i) {
2487 ($from_start[$i], $from_nlines[$i]) =
2488 (split(',', substr($from_text[$i], 1)), 0);
2491 $to_text = pop @from_text;
2492 $to_start = pop @from_start;
2493 $to_nlines = pop @from_nlines;
2495 $line = "<span class=\"chunk_info\">$prefix ";
2496 for (my $i = 0; $i < @from_text; ++$i) {
2497 if ($from->{'href'}[$i]) {
2498 $line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
2499 -class=>"list"}, $from_text[$i]);
2500 } else {
2501 $line .= $from_text[$i];
2503 $line .= " ";
2505 if ($to->{'href'}) {
2506 $line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
2507 -class=>"list"}, $to_text);
2508 } else {
2509 $line .= $to_text;
2511 $line .= " $prefix</span>" .
2512 "<span class=\"section\">" . esc_html($section, -nbsp=>1) . "</span>";
2513 return $line;
2516 # process patch (diff) line (not to be used for diff headers),
2517 # returning HTML-formatted (but not wrapped) line.
2518 # If the line is passed as a reference, it is treated as HTML and not
2519 # esc_html()'ed.
2520 sub format_diff_line {
2521 my ($line, $diff_class, $from, $to) = @_;
2523 if (ref($line)) {
2524 $line = $$line;
2525 } else {
2526 chomp $line;
2527 $line = untabify($line);
2529 if ($from && $to && $line =~ m/^\@{2} /) {
2530 $line = format_unidiff_chunk_header($line, $from, $to);
2531 } elsif ($from && $to && $line =~ m/^\@{3}/) {
2532 $line = format_cc_diff_chunk_header($line, $from, $to);
2533 } else {
2534 $line = esc_html($line, -nbsp=>1);
2538 my $diff_classes = "diff";
2539 $diff_classes .= " $diff_class" if ($diff_class);
2540 $line = "<div class=\"$diff_classes\">$line</div>\n";
2542 return $line;
2545 # Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
2546 # linked. Pass the hash of the tree/commit to snapshot.
2547 sub format_snapshot_links {
2548 my ($hash) = @_;
2549 my $num_fmts = @snapshot_fmts;
2550 if ($num_fmts > 1) {
2551 # A parenthesized list of links bearing format names.
2552 # e.g. "snapshot (_tar.gz_ _zip_)"
2553 return "snapshot (" . join(' ', map
2554 $cgi->a({
2555 -href => href(
2556 action=>"snapshot",
2557 hash=>$hash,
2558 snapshot_format=>$_
2560 }, $known_snapshot_formats{$_}{'display'})
2561 , @snapshot_fmts) . ")";
2562 } elsif ($num_fmts == 1) {
2563 # A single "snapshot" link whose tooltip bears the format name.
2564 # i.e. "_snapshot_"
2565 my ($fmt) = @snapshot_fmts;
2566 return
2567 $cgi->a({
2568 -href => href(
2569 action=>"snapshot",
2570 hash=>$hash,
2571 snapshot_format=>$fmt
2573 -title => "in format: $known_snapshot_formats{$fmt}{'display'}"
2574 }, "snapshot");
2575 } else { # $num_fmts == 0
2576 return undef;
2580 ## ......................................................................
2581 ## functions returning values to be passed, perhaps after some
2582 ## transformation, to other functions; e.g. returning arguments to href()
2584 # returns hash to be passed to href to generate gitweb URL
2585 # in -title key it returns description of link
2586 sub get_feed_info {
2587 my $format = shift || 'Atom';
2588 my %res = (action => lc($format));
2589 my $matched_ref = 0;
2591 # feed links are possible only for project views
2592 return unless (defined $project);
2593 # some views should link to OPML, or to generic project feed,
2594 # or don't have specific feed yet (so they should use generic)
2595 return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
2597 my $branch = undef;
2598 # branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
2599 # (fullname) to differentiate from tag links; this also makes
2600 # possible to detect branch links
2601 for my $ref (get_branch_refs()) {
2602 if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
2603 (defined $hash && $hash =~ m!^refs/\Q$ref\E/(.*)$!)) {
2604 $branch = $1;
2605 $matched_ref = $ref;
2606 last;
2609 # find log type for feed description (title)
2610 my $type = 'log';
2611 if (defined $file_name) {
2612 $type = "history of $file_name";
2613 $type .= "/" if ($action eq 'tree');
2614 $type .= " on '$branch'" if (defined $branch);
2615 } else {
2616 $type = "log of $branch" if (defined $branch);
2619 $res{-title} = $type;
2620 $res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
2621 $res{'file_name'} = $file_name;
2623 return %res;
2626 ## ----------------------------------------------------------------------
2627 ## git utility subroutines, invoking git commands
2629 # returns path to the core git executable and the --git-dir parameter as list
2630 sub git_cmd {
2631 $number_of_git_cmds++;
2632 return $GIT, '--git-dir='.$git_dir;
2635 # quote the given arguments for passing them to the shell
2636 # quote_command("command", "arg 1", "arg with ' and ! characters")
2637 # => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
2638 # Try to avoid using this function wherever possible.
2639 sub quote_command {
2640 return join(' ',
2641 map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
2644 # get HEAD ref of given project as hash
2645 sub git_get_head_hash {
2646 return git_get_full_hash(shift, 'HEAD');
2649 sub git_get_full_hash {
2650 return git_get_hash(@_);
2653 sub git_get_short_hash {
2654 return git_get_hash(@_, '--short=7');
2657 sub git_get_hash {
2658 my ($project, $hash, @options) = @_;
2659 my $o_git_dir = $git_dir;
2660 my $retval = undef;
2661 $git_dir = "$projectroot/$project";
2662 if (open my $fd, '-|', git_cmd(), 'rev-parse',
2663 '--verify', '-q', @options, $hash) {
2664 $retval = <$fd>;
2665 chomp $retval if defined $retval;
2666 close $fd;
2668 if (defined $o_git_dir) {
2669 $git_dir = $o_git_dir;
2671 return $retval;
2674 # get type of given object
2675 sub git_get_type {
2676 my $hash = shift;
2678 open my $fd, "-|", git_cmd(), "cat-file", '-t', $hash or return;
2679 my $type = <$fd>;
2680 close $fd or return;
2681 chomp $type;
2682 return $type;
2685 # repository configuration
2686 our $config_file = '';
2687 our %config;
2689 # store multiple values for single key as anonymous array reference
2690 # single values stored directly in the hash, not as [ <value> ]
2691 sub hash_set_multi {
2692 my ($hash, $key, $value) = @_;
2694 if (!exists $hash->{$key}) {
2695 $hash->{$key} = $value;
2696 } elsif (!ref $hash->{$key}) {
2697 $hash->{$key} = [ $hash->{$key}, $value ];
2698 } else {
2699 push @{$hash->{$key}}, $value;
2703 # return hash of git project configuration
2704 # optionally limited to some section, e.g. 'gitweb'
2705 sub git_parse_project_config {
2706 my $section_regexp = shift;
2707 my %config;
2709 local $/ = "\0";
2711 open my $fh, "-|", git_cmd(), "config", '-z', '-l',
2712 or return;
2714 while (my $keyval = <$fh>) {
2715 chomp $keyval;
2716 my ($key, $value) = split(/\n/, $keyval, 2);
2718 hash_set_multi(\%config, $key, $value)
2719 if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
2721 close $fh;
2723 return %config;
2726 # convert config value to boolean: 'true' or 'false'
2727 # no value, number > 0, 'true' and 'yes' values are true
2728 # rest of values are treated as false (never as error)
2729 sub config_to_bool {
2730 my $val = shift;
2732 return 1 if !defined $val; # section.key
2734 # strip leading and trailing whitespace
2735 $val =~ s/^\s+//;
2736 $val =~ s/\s+$//;
2738 return (($val =~ /^\d+$/ && $val) || # section.key = 1
2739 ($val =~ /^(?:true|yes)$/i)); # section.key = true
2742 # convert config value to simple decimal number
2743 # an optional value suffix of 'k', 'm', or 'g' will cause the value
2744 # to be multiplied by 1024, 1048576, or 1073741824
2745 sub config_to_int {
2746 my $val = shift;
2748 # strip leading and trailing whitespace
2749 $val =~ s/^\s+//;
2750 $val =~ s/\s+$//;
2752 if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
2753 $unit = lc($unit);
2754 # unknown unit is treated as 1
2755 return $num * ($unit eq 'g' ? 1073741824 :
2756 $unit eq 'm' ? 1048576 :
2757 $unit eq 'k' ? 1024 : 1);
2759 return $val;
2762 # convert config value to array reference, if needed
2763 sub config_to_multi {
2764 my $val = shift;
2766 return ref($val) ? $val : (defined($val) ? [ $val ] : []);
2769 sub git_get_project_config {
2770 my ($key, $type) = @_;
2772 return unless defined $git_dir;
2774 # key sanity check
2775 return unless ($key);
2776 # only subsection, if exists, is case sensitive,
2777 # and not lowercased by 'git config -z -l'
2778 if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
2779 $lo =~ s/_//g;
2780 $key = join(".", lc($hi), $mi, lc($lo));
2781 return if ($lo =~ /\W/ || $hi =~ /\W/);
2782 } else {
2783 $key = lc($key);
2784 $key =~ s/_//g;
2785 return if ($key =~ /\W/);
2787 $key =~ s/^gitweb\.//;
2789 # type sanity check
2790 if (defined $type) {
2791 $type =~ s/^--//;
2792 $type = undef
2793 unless ($type eq 'bool' || $type eq 'int');
2796 # get config
2797 if (!defined $config_file ||
2798 $config_file ne "$git_dir/config") {
2799 %config = git_parse_project_config('gitweb');
2800 $config_file = "$git_dir/config";
2803 # check if config variable (key) exists
2804 return unless exists $config{"gitweb.$key"};
2806 # ensure given type
2807 if (!defined $type) {
2808 return $config{"gitweb.$key"};
2809 } elsif ($type eq 'bool') {
2810 # backward compatibility: 'git config --bool' returns true/false
2811 return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
2812 } elsif ($type eq 'int') {
2813 return config_to_int($config{"gitweb.$key"});
2815 return $config{"gitweb.$key"};
2818 # get hash of given path at given ref
2819 sub git_get_hash_by_path {
2820 my $base = shift;
2821 my $path = shift || return undef;
2822 my $type = shift;
2824 $path =~ s,/+$,,;
2826 open my $fd, "-|", git_cmd(), "ls-tree", $base, "--", $path
2827 or die_error(500, "Open git-ls-tree failed");
2828 my $line = <$fd>;
2829 close $fd or return undef;
2831 if (!defined $line) {
2832 # there is no tree or hash given by $path at $base
2833 return undef;
2836 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
2837 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
2838 if (defined $type && $type ne $2) {
2839 # type doesn't match
2840 return undef;
2842 return $3;
2845 # get path of entry with given hash at given tree-ish (ref)
2846 # used to get 'from' filename for combined diff (merge commit) for renames
2847 sub git_get_path_by_hash {
2848 my $base = shift || return;
2849 my $hash = shift || return;
2851 local $/ = "\0";
2853 open my $fd, "-|", git_cmd(), "ls-tree", '-r', '-t', '-z', $base
2854 or return undef;
2855 while (my $line = <$fd>) {
2856 chomp $line;
2858 #'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423 gitweb'
2859 #'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f gitweb/README'
2860 if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
2861 close $fd;
2862 return $1;
2865 close $fd;
2866 return undef;
2869 ## ......................................................................
2870 ## git utility functions, directly accessing git repository
2872 # get the value of config variable either from file named as the variable
2873 # itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
2874 # configuration variable in the repository config file.
2875 sub git_get_file_or_project_config {
2876 my ($path, $name) = @_;
2878 $git_dir = "$projectroot/$path";
2879 open my $fd, '<', "$git_dir/$name"
2880 or return git_get_project_config($name);
2881 my $conf = <$fd>;
2882 close $fd;
2883 if (defined $conf) {
2884 chomp $conf;
2886 return $conf;
2889 sub git_get_project_description {
2890 my $path = shift;
2891 return git_get_file_or_project_config($path, 'description');
2894 sub git_get_project_category {
2895 my $path = shift;
2896 return git_get_file_or_project_config($path, 'category');
2900 # supported formats:
2901 # * $GIT_DIR/ctags/<tagname> file (in 'ctags' subdirectory)
2902 # - if its contents is a number, use it as tag weight,
2903 # - otherwise add a tag with weight 1
2904 # * $GIT_DIR/ctags file, each line is a tag (with weight 1)
2905 # the same value multiple times increases tag weight
2906 # * `gitweb.ctag' multi-valued repo config variable
2907 sub git_get_project_ctags {
2908 my $project = shift;
2909 my $ctags = {};
2911 $git_dir = "$projectroot/$project";
2912 if (opendir my $dh, "$git_dir/ctags") {
2913 my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
2914 foreach my $tagfile (@files) {
2915 open my $ct, '<', $tagfile
2916 or next;
2917 my $val = <$ct>;
2918 chomp $val if $val;
2919 close $ct;
2921 (my $ctag = $tagfile) =~ s#.*/##;
2922 if ($val =~ /^\d+$/) {
2923 $ctags->{$ctag} = $val;
2924 } else {
2925 $ctags->{$ctag} = 1;
2928 closedir $dh;
2930 } elsif (open my $fh, '<', "$git_dir/ctags") {
2931 while (my $line = <$fh>) {
2932 chomp $line;
2933 $ctags->{$line}++ if $line;
2935 close $fh;
2937 } else {
2938 my $taglist = config_to_multi(git_get_project_config('ctag'));
2939 foreach my $tag (@$taglist) {
2940 $ctags->{$tag}++;
2944 return $ctags;
2947 # return hash, where keys are content tags ('ctags'),
2948 # and values are sum of weights of given tag in every project
2949 sub git_gather_all_ctags {
2950 my $projects = shift;
2951 my $ctags = {};
2953 foreach my $p (@$projects) {
2954 foreach my $ct (keys %{$p->{'ctags'}}) {
2955 $ctags->{$ct} += $p->{'ctags'}->{$ct};
2959 return $ctags;
2962 sub git_populate_project_tagcloud {
2963 my $ctags = shift;
2965 # First, merge different-cased tags; tags vote on casing
2966 my %ctags_lc;
2967 foreach (keys %$ctags) {
2968 $ctags_lc{lc $_}->{count} += $ctags->{$_};
2969 if (not $ctags_lc{lc $_}->{topcount}
2970 or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
2971 $ctags_lc{lc $_}->{topcount} = $ctags->{$_};
2972 $ctags_lc{lc $_}->{topname} = $_;
2976 my $cloud;
2977 my $matched = $input_params{'ctag'};
2978 if (eval { require HTML::TagCloud; 1; }) {
2979 $cloud = HTML::TagCloud->new;
2980 foreach my $ctag (sort keys %ctags_lc) {
2981 # Pad the title with spaces so that the cloud looks
2982 # less crammed.
2983 my $title = esc_html($ctags_lc{$ctag}->{topname});
2984 $title =~ s/ /&nbsp;/g;
2985 $title =~ s/^/&nbsp;/g;
2986 $title =~ s/$/&nbsp;/g;
2987 if (defined $matched && $matched eq $ctag) {
2988 $title = qq(<span class="match">$title</span>);
2990 $cloud->add($title, href(project=>undef, ctag=>$ctag),
2991 $ctags_lc{$ctag}->{count});
2993 } else {
2994 $cloud = {};
2995 foreach my $ctag (keys %ctags_lc) {
2996 my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
2997 if (defined $matched && $matched eq $ctag) {
2998 $title = qq(<span class="match">$title</span>);
3000 $cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
3001 $cloud->{$ctag}{ctag} =
3002 $cgi->a({-href=>href(project=>undef, ctag=>$ctag)}, $title);
3005 return $cloud;
3008 sub git_show_project_tagcloud {
3009 my ($cloud, $count) = @_;
3010 if (ref $cloud eq 'HTML::TagCloud') {
3011 return $cloud->html_and_css($count);
3012 } else {
3013 my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
3014 return
3015 '<div id="htmltagcloud"'.($project ? '' : ' align="center"').'>' .
3016 join (', ', map {
3017 $cloud->{$_}->{'ctag'}
3018 } splice(@tags, 0, $count)) .
3019 '</div>';
3023 sub git_get_project_url_list {
3024 my $path = shift;
3026 $git_dir = "$projectroot/$path";
3027 open my $fd, '<', "$git_dir/cloneurl"
3028 or return wantarray ?
3029 @{ config_to_multi(git_get_project_config('url')) } :
3030 config_to_multi(git_get_project_config('url'));
3031 my @git_project_url_list = map { chomp; $_ } <$fd>;
3032 close $fd;
3034 return wantarray ? @git_project_url_list : \@git_project_url_list;
3037 sub git_get_projects_list {
3038 my $filter = shift || '';
3039 my $paranoid = shift;
3040 my @list;
3042 if (-d $projects_list) {
3043 # search in directory
3044 my $dir = $projects_list;
3045 # remove the trailing "/"
3046 $dir =~ s!/+$!!;
3047 my $pfxlen = length("$dir");
3048 my $pfxdepth = ($dir =~ tr!/!!);
3049 # when filtering, search only given subdirectory
3050 if ($filter && !$paranoid) {
3051 $dir .= "/$filter";
3052 $dir =~ s!/+$!!;
3055 File::Find::find({
3056 follow_fast => 1, # follow symbolic links
3057 follow_skip => 2, # ignore duplicates
3058 dangling_symlinks => 0, # ignore dangling symlinks, silently
3059 wanted => sub {
3060 # global variables
3061 our $project_maxdepth;
3062 our $projectroot;
3063 # skip project-list toplevel, if we get it.
3064 return if (m!^[/.]$!);
3065 # only directories can be git repositories
3066 return unless (-d $_);
3067 # need search permission
3068 return unless (-x $_);
3069 # don't traverse too deep (Find is super slow on os x)
3070 # $project_maxdepth excludes depth of $projectroot
3071 if (($File::Find::name =~ tr!/!!) - $pfxdepth > $project_maxdepth) {
3072 $File::Find::prune = 1;
3073 return;
3076 my $path = substr($File::Find::name, $pfxlen + 1);
3077 # paranoidly only filter here
3078 if ($paranoid && $filter && $path !~ m!^\Q$filter\E/!) {
3079 next;
3081 # we check related file in $projectroot
3082 if (check_export_ok("$projectroot/$path")) {
3083 push @list, { path => $path };
3084 $File::Find::prune = 1;
3087 }, "$dir");
3089 } elsif (-f $projects_list) {
3090 # read from file(url-encoded):
3091 # 'git%2Fgit.git Linus+Torvalds'
3092 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3093 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3094 open my $fd, '<', $projects_list or return;
3095 PROJECT:
3096 while (my $line = <$fd>) {
3097 chomp $line;
3098 my ($path, $owner) = split ' ', $line;
3099 $path = unescape($path);
3100 $owner = unescape($owner);
3101 if (!defined $path) {
3102 next;
3104 # if $filter is rpovided, check if $path begins with $filter
3105 if ($filter && $path !~ m!^\Q$filter\E/!) {
3106 next;
3108 if (check_export_ok("$projectroot/$path")) {
3109 my $pr = {
3110 path => $path
3112 if ($owner) {
3113 $pr->{'owner'} = to_utf8($owner);
3115 push @list, $pr;
3118 close $fd;
3120 return @list;
3123 # written with help of Tree::Trie module (Perl Artistic License, GPL compatible)
3124 # as side effects it sets 'forks' field to list of forks for forked projects
3125 sub filter_forks_from_projects_list {
3126 my $projects = shift;
3128 my %trie; # prefix tree of directories (path components)
3129 # generate trie out of those directories that might contain forks
3130 foreach my $pr (@$projects) {
3131 my $path = $pr->{'path'};
3132 $path =~ s/\.git$//; # forks of 'repo.git' are in 'repo/' directory
3133 next if ($path =~ m!/$!); # skip non-bare repositories, e.g. 'repo/.git'
3134 next unless ($path); # skip '.git' repository: tests, git-instaweb
3135 next unless (-d "$projectroot/$path"); # containing directory exists
3136 $pr->{'forks'} = []; # there can be 0 or more forks of project
3138 # add to trie
3139 my @dirs = split('/', $path);
3140 # walk the trie, until either runs out of components or out of trie
3141 my $ref = \%trie;
3142 while (scalar @dirs &&
3143 exists($ref->{$dirs[0]})) {
3144 $ref = $ref->{shift @dirs};
3146 # create rest of trie structure from rest of components
3147 foreach my $dir (@dirs) {
3148 $ref = $ref->{$dir} = {};
3150 # create end marker, store $pr as a data
3151 $ref->{''} = $pr if (!exists $ref->{''});
3154 # filter out forks, by finding shortest prefix match for paths
3155 my @filtered;
3156 PROJECT:
3157 foreach my $pr (@$projects) {
3158 # trie lookup
3159 my $ref = \%trie;
3160 DIR:
3161 foreach my $dir (split('/', $pr->{'path'})) {
3162 if (exists $ref->{''}) {
3163 # found [shortest] prefix, is a fork - skip it
3164 push @{$ref->{''}{'forks'}}, $pr;
3165 next PROJECT;
3167 if (!exists $ref->{$dir}) {
3168 # not in trie, cannot have prefix, not a fork
3169 push @filtered, $pr;
3170 next PROJECT;
3172 # If the dir is there, we just walk one step down the trie.
3173 $ref = $ref->{$dir};
3175 # we ran out of trie
3176 # (shouldn't happen: it's either no match, or end marker)
3177 push @filtered, $pr;
3180 return @filtered;
3183 # note: fill_project_list_info must be run first,
3184 # for 'descr_long' and 'ctags' to be filled
3185 sub search_projects_list {
3186 my ($projlist, %opts) = @_;
3187 my $tagfilter = $opts{'tagfilter'};
3188 my $search_re = $opts{'search_regexp'};
3190 return @$projlist
3191 unless ($tagfilter || $search_re);
3193 # searching projects require filling to be run before it;
3194 fill_project_list_info($projlist,
3195 $tagfilter ? 'ctags' : (),
3196 $search_re ? ('path', 'descr') : ());
3197 my @projects;
3198 PROJECT:
3199 foreach my $pr (@$projlist) {
3201 if ($tagfilter) {
3202 next unless ref($pr->{'ctags'}) eq 'HASH';
3203 next unless
3204 grep { lc($_) eq lc($tagfilter) } keys %{$pr->{'ctags'}};
3207 if ($search_re) {
3208 next unless
3209 $pr->{'path'} =~ /$search_re/ ||
3210 $pr->{'descr_long'} =~ /$search_re/;
3213 push @projects, $pr;
3216 return @projects;
3219 our $gitweb_project_owner = undef;
3220 sub git_get_project_list_from_file {
3222 return if (defined $gitweb_project_owner);
3224 $gitweb_project_owner = {};
3225 # read from file (url-encoded):
3226 # 'git%2Fgit.git Linus+Torvalds'
3227 # 'libs%2Fklibc%2Fklibc.git H.+Peter+Anvin'
3228 # 'linux%2Fhotplug%2Fudev.git Greg+Kroah-Hartman'
3229 if (-f $projects_list) {
3230 open(my $fd, '<', $projects_list);
3231 while (my $line = <$fd>) {
3232 chomp $line;
3233 my ($pr, $ow) = split ' ', $line;
3234 $pr = unescape($pr);
3235 $ow = unescape($ow);
3236 $gitweb_project_owner->{$pr} = to_utf8($ow);
3238 close $fd;
3242 sub git_get_project_owner {
3243 my $project = shift;
3244 my $owner;
3246 return undef unless $project;
3247 $git_dir = "$projectroot/$project";
3249 if (!defined $gitweb_project_owner) {
3250 git_get_project_list_from_file();
3253 if (exists $gitweb_project_owner->{$project}) {
3254 $owner = $gitweb_project_owner->{$project};
3256 if (!defined $owner){
3257 $owner = git_get_project_config('owner');
3259 if (!defined $owner) {
3260 $owner = get_file_owner("$git_dir");
3263 return $owner;
3266 sub git_get_last_activity {
3267 my ($path) = @_;
3268 my $fd;
3270 $git_dir = "$projectroot/$path";
3271 open($fd, "-|", git_cmd(), 'for-each-ref',
3272 '--format=%(committer)',
3273 '--sort=-committerdate',
3274 '--count=1',
3275 map { "refs/$_" } get_branch_refs ()) or return;
3276 my $most_recent = <$fd>;
3277 close $fd or return;
3278 if (defined $most_recent &&
3279 $most_recent =~ / (\d+) [-+][01]\d\d\d$/) {
3280 my $timestamp = $1;
3281 my $age = time - $timestamp;
3282 return ($age, age_string($age));
3284 return (undef, undef);
3287 # Implementation note: when a single remote is wanted, we cannot use 'git
3288 # remote show -n' because that command always work (assuming it's a remote URL
3289 # if it's not defined), and we cannot use 'git remote show' because that would
3290 # try to make a network roundtrip. So the only way to find if that particular
3291 # remote is defined is to walk the list provided by 'git remote -v' and stop if
3292 # and when we find what we want.
3293 sub git_get_remotes_list {
3294 my $wanted = shift;
3295 my %remotes = ();
3297 open my $fd, '-|' , git_cmd(), 'remote', '-v';
3298 return unless $fd;
3299 while (my $remote = <$fd>) {
3300 chomp $remote;
3301 $remote =~ s!\t(.*?)\s+\((\w+)\)$!!;
3302 next if $wanted and not $remote eq $wanted;
3303 my ($url, $key) = ($1, $2);
3305 $remotes{$remote} ||= { 'heads' => () };
3306 $remotes{$remote}{$key} = $url;
3308 close $fd or return;
3309 return wantarray ? %remotes : \%remotes;
3312 # Takes a hash of remotes as first parameter and fills it by adding the
3313 # available remote heads for each of the indicated remotes.
3314 sub fill_remote_heads {
3315 my $remotes = shift;
3316 my @heads = map { "remotes/$_" } keys %$remotes;
3317 my @remoteheads = git_get_heads_list(undef, @heads);
3318 foreach my $remote (keys %$remotes) {
3319 $remotes->{$remote}{'heads'} = [ grep {
3320 $_->{'name'} =~ s!^$remote/!!
3321 } @remoteheads ];
3325 sub git_get_references {
3326 my $type = shift || "";
3327 my %refs;
3328 # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
3329 # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
3330 open my $fd, "-|", git_cmd(), "show-ref", "--dereference",
3331 ($type ? ("--", "refs/$type") : ()) # use -- <pattern> if $type
3332 or return;
3334 while (my $line = <$fd>) {
3335 chomp $line;
3336 if ($line =~ m!^([0-9a-fA-F]{40})\srefs/($type.*)$!) {
3337 if (defined $refs{$1}) {
3338 push @{$refs{$1}}, $2;
3339 } else {
3340 $refs{$1} = [ $2 ];
3344 close $fd or return;
3345 return \%refs;
3348 sub git_get_rev_name_tags {
3349 my $hash = shift || return undef;
3351 open my $fd, "-|", git_cmd(), "name-rev", "--tags", $hash
3352 or return;
3353 my $name_rev = <$fd>;
3354 close $fd;
3356 if ($name_rev =~ m|^$hash tags/(.*)$|) {
3357 return $1;
3358 } else {
3359 # catches also '$hash undefined' output
3360 return undef;
3364 ## ----------------------------------------------------------------------
3365 ## parse to hash functions
3367 sub parse_date {
3368 my $epoch = shift;
3369 my $tz = shift || "-0000";
3371 my %date;
3372 my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
3373 my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
3374 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
3375 $date{'hour'} = $hour;
3376 $date{'minute'} = $min;
3377 $date{'mday'} = $mday;
3378 $date{'day'} = $days[$wday];
3379 $date{'month'} = $months[$mon];
3380 $date{'rfc2822'} = sprintf "%s, %d %s %4d %02d:%02d:%02d +0000",
3381 $days[$wday], $mday, $months[$mon], 1900+$year, $hour ,$min, $sec;
3382 $date{'mday-time'} = sprintf "%d %s %02d:%02d",
3383 $mday, $months[$mon], $hour ,$min;
3384 $date{'iso-8601'} = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
3385 1900+$year, 1+$mon, $mday, $hour ,$min, $sec;
3387 my ($tz_sign, $tz_hour, $tz_min) =
3388 ($tz =~ m/^([-+])(\d\d)(\d\d)$/);
3389 $tz_sign = ($tz_sign eq '-' ? -1 : +1);
3390 my $local = $epoch + $tz_sign*((($tz_hour*60) + $tz_min)*60);
3391 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($local);
3392 $date{'hour_local'} = $hour;
3393 $date{'minute_local'} = $min;
3394 $date{'tz_local'} = $tz;
3395 $date{'iso-tz'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
3396 1900+$year, $mon+1, $mday,
3397 $hour, $min, $sec, $tz);
3398 return %date;
3401 sub parse_tag {
3402 my $tag_id = shift;
3403 my %tag;
3404 my @comment;
3406 open my $fd, "-|", git_cmd(), "cat-file", "tag", $tag_id or return;
3407 $tag{'id'} = $tag_id;
3408 while (my $line = <$fd>) {
3409 chomp $line;
3410 if ($line =~ m/^object ([0-9a-fA-F]{40})$/) {
3411 $tag{'object'} = $1;
3412 } elsif ($line =~ m/^type (.+)$/) {
3413 $tag{'type'} = $1;
3414 } elsif ($line =~ m/^tag (.+)$/) {
3415 $tag{'name'} = $1;
3416 } elsif ($line =~ m/^tagger (.*) ([0-9]+) (.*)$/) {
3417 $tag{'author'} = $1;
3418 $tag{'author_epoch'} = $2;
3419 $tag{'author_tz'} = $3;
3420 if ($tag{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3421 $tag{'author_name'} = $1;
3422 $tag{'author_email'} = $2;
3423 } else {
3424 $tag{'author_name'} = $tag{'author'};
3426 } elsif ($line =~ m/--BEGIN/) {
3427 push @comment, $line;
3428 last;
3429 } elsif ($line eq "") {
3430 last;
3433 push @comment, <$fd>;
3434 $tag{'comment'} = \@comment;
3435 close $fd or return;
3436 if (!defined $tag{'name'}) {
3437 return
3439 return %tag
3442 sub parse_commit_text {
3443 my ($commit_text, $withparents) = @_;
3444 my @commit_lines = split '\n', $commit_text;
3445 my %co;
3447 pop @commit_lines; # Remove '\0'
3449 if (! @commit_lines) {
3450 return;
3453 my $header = shift @commit_lines;
3454 if ($header !~ m/^[0-9a-fA-F]{40}/) {
3455 return;
3457 ($co{'id'}, my @parents) = split ' ', $header;
3458 while (my $line = shift @commit_lines) {
3459 last if $line eq "\n";
3460 if ($line =~ m/^tree ([0-9a-fA-F]{40})$/) {
3461 $co{'tree'} = $1;
3462 } elsif ((!defined $withparents) && ($line =~ m/^parent ([0-9a-fA-F]{40})$/)) {
3463 push @parents, $1;
3464 } elsif ($line =~ m/^author (.*) ([0-9]+) (.*)$/) {
3465 $co{'author'} = to_utf8($1);
3466 $co{'author_epoch'} = $2;
3467 $co{'author_tz'} = $3;
3468 if ($co{'author'} =~ m/^([^<]+) <([^>]*)>/) {
3469 $co{'author_name'} = $1;
3470 $co{'author_email'} = $2;
3471 } else {
3472 $co{'author_name'} = $co{'author'};
3474 } elsif ($line =~ m/^committer (.*) ([0-9]+) (.*)$/) {
3475 $co{'committer'} = to_utf8($1);
3476 $co{'committer_epoch'} = $2;
3477 $co{'committer_tz'} = $3;
3478 if ($co{'committer'} =~ m/^([^<]+) <([^>]*)>/) {
3479 $co{'committer_name'} = $1;
3480 $co{'committer_email'} = $2;
3481 } else {
3482 $co{'committer_name'} = $co{'committer'};
3486 if (!defined $co{'tree'}) {
3487 return;
3489 $co{'parents'} = \@parents;
3490 $co{'parent'} = $parents[0];
3492 foreach my $title (@commit_lines) {
3493 $title =~ s/^ //;
3494 if ($title ne "") {
3495 $co{'title'} = chop_str($title, 80, 5);
3496 # remove leading stuff of merges to make the interesting part visible
3497 if (length($title) > 50) {
3498 $title =~ s/^Automatic //;
3499 $title =~ s/^merge (of|with) /Merge ... /i;
3500 if (length($title) > 50) {
3501 $title =~ s/(http|rsync):\/\///;
3503 if (length($title) > 50) {
3504 $title =~ s/(master|www|rsync)\.//;
3506 if (length($title) > 50) {
3507 $title =~ s/kernel.org:?//;
3509 if (length($title) > 50) {
3510 $title =~ s/\/pub\/scm//;
3513 $co{'title_short'} = chop_str($title, 50, 5);
3514 last;
3517 if (! defined $co{'title'} || $co{'title'} eq "") {
3518 $co{'title'} = $co{'title_short'} = '(no commit message)';
3520 # remove added spaces
3521 foreach my $line (@commit_lines) {
3522 $line =~ s/^ //;
3524 $co{'comment'} = \@commit_lines;
3526 my $age = time - $co{'committer_epoch'};
3527 $co{'age'} = $age;
3528 $co{'age_string'} = age_string($age);
3529 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($co{'committer_epoch'});
3530 if ($age > 60*60*24*7*2) {
3531 $co{'age_string_date'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
3532 $co{'age_string_age'} = $co{'age_string'};
3533 } else {
3534 $co{'age_string_date'} = $co{'age_string'};
3535 $co{'age_string_age'} = sprintf "%4i-%02u-%02i", 1900 + $year, $mon+1, $mday;
3537 return %co;
3540 sub parse_commit {
3541 my ($commit_id) = @_;
3542 my %co;
3544 local $/ = "\0";
3546 open my $fd, "-|", git_cmd(), "rev-list",
3547 "--parents",
3548 "--header",
3549 "--max-count=1",
3550 $commit_id,
3551 "--",
3552 or die_error(500, "Open git-rev-list failed");
3553 %co = parse_commit_text(<$fd>, 1);
3554 close $fd;
3556 return %co;
3559 sub parse_commits {
3560 my ($commit_id, $maxcount, $skip, $filename, @args) = @_;
3561 my @cos;
3563 $maxcount ||= 1;
3564 $skip ||= 0;
3566 local $/ = "\0";
3568 open my $fd, "-|", git_cmd(), "rev-list",
3569 "--header",
3570 @args,
3571 ("--max-count=" . $maxcount),
3572 ("--skip=" . $skip),
3573 @extra_options,
3574 $commit_id,
3575 "--",
3576 ($filename ? ($filename) : ())
3577 or die_error(500, "Open git-rev-list failed");
3578 while (my $line = <$fd>) {
3579 my %co = parse_commit_text($line);
3580 push @cos, \%co;
3582 close $fd;
3584 return wantarray ? @cos : \@cos;
3587 # parse line of git-diff-tree "raw" output
3588 sub parse_difftree_raw_line {
3589 my $line = shift;
3590 my %res;
3592 # ':100644 100644 03b218260e99b78c6df0ed378e59ed9205ccc96d 3b93d5e7cc7f7dd4ebed13a5cc1a4ad976fc94d8 M ls-files.c'
3593 # ':100644 100644 7f9281985086971d3877aca27704f2aaf9c448ce bc190ebc71bbd923f2b728e505408f5e54bd073a M rev-tree.c'
3594 if ($line =~ m/^:([0-7]{6}) ([0-7]{6}) ([0-9a-fA-F]{40}) ([0-9a-fA-F]{40}) (.)([0-9]{0,3})\t(.*)$/) {
3595 $res{'from_mode'} = $1;
3596 $res{'to_mode'} = $2;
3597 $res{'from_id'} = $3;
3598 $res{'to_id'} = $4;
3599 $res{'status'} = $5;
3600 $res{'similarity'} = $6;
3601 if ($res{'status'} eq 'R' || $res{'status'} eq 'C') { # renamed or copied
3602 ($res{'from_file'}, $res{'to_file'}) = map { unquote($_) } split("\t", $7);
3603 } else {
3604 $res{'from_file'} = $res{'to_file'} = $res{'file'} = unquote($7);
3607 # '::100755 100755 100755 60e79ca1b01bc8b057abe17ddab484699a7f5fdb 94067cc5f73388f33722d52ae02f44692bc07490 94067cc5f73388f33722d52ae02f44692bc07490 MR git-gui/git-gui.sh'
3608 # combined diff (for merge commit)
3609 elsif ($line =~ s/^(::+)((?:[0-7]{6} )+)((?:[0-9a-fA-F]{40} )+)([a-zA-Z]+)\t(.*)$//) {
3610 $res{'nparents'} = length($1);
3611 $res{'from_mode'} = [ split(' ', $2) ];
3612 $res{'to_mode'} = pop @{$res{'from_mode'}};
3613 $res{'from_id'} = [ split(' ', $3) ];
3614 $res{'to_id'} = pop @{$res{'from_id'}};
3615 $res{'status'} = [ split('', $4) ];
3616 $res{'to_file'} = unquote($5);
3618 # 'c512b523472485aef4fff9e57b229d9d243c967f'
3619 elsif ($line =~ m/^([0-9a-fA-F]{40})$/) {
3620 $res{'commit'} = $1;
3623 return wantarray ? %res : \%res;
3626 # wrapper: return parsed line of git-diff-tree "raw" output
3627 # (the argument might be raw line, or parsed info)
3628 sub parsed_difftree_line {
3629 my $line_or_ref = shift;
3631 if (ref($line_or_ref) eq "HASH") {
3632 # pre-parsed (or generated by hand)
3633 return $line_or_ref;
3634 } else {
3635 return parse_difftree_raw_line($line_or_ref);
3639 # parse line of git-ls-tree output
3640 sub parse_ls_tree_line {
3641 my $line = shift;
3642 my %opts = @_;
3643 my %res;
3645 if ($opts{'-l'}) {
3646 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa 16717 panic.c'
3647 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40}) +(-|[0-9]+)\t(.+)$/s;
3649 $res{'mode'} = $1;
3650 $res{'type'} = $2;
3651 $res{'hash'} = $3;
3652 $res{'size'} = $4;
3653 if ($opts{'-z'}) {
3654 $res{'name'} = $5;
3655 } else {
3656 $res{'name'} = unquote($5);
3658 } else {
3659 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
3660 $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t(.+)$/s;
3662 $res{'mode'} = $1;
3663 $res{'type'} = $2;
3664 $res{'hash'} = $3;
3665 if ($opts{'-z'}) {
3666 $res{'name'} = $4;
3667 } else {
3668 $res{'name'} = unquote($4);
3672 return wantarray ? %res : \%res;
3675 # generates _two_ hashes, references to which are passed as 2 and 3 argument
3676 sub parse_from_to_diffinfo {
3677 my ($diffinfo, $from, $to, @parents) = @_;
3679 if ($diffinfo->{'nparents'}) {
3680 # combined diff
3681 $from->{'file'} = [];
3682 $from->{'href'} = [];
3683 fill_from_file_info($diffinfo, @parents)
3684 unless exists $diffinfo->{'from_file'};
3685 for (my $i = 0; $i < $diffinfo->{'nparents'}; $i++) {
3686 $from->{'file'}[$i] =
3687 defined $diffinfo->{'from_file'}[$i] ?
3688 $diffinfo->{'from_file'}[$i] :
3689 $diffinfo->{'to_file'};
3690 if ($diffinfo->{'status'}[$i] ne "A") { # not new (added) file
3691 $from->{'href'}[$i] = href(action=>"blob",
3692 hash_base=>$parents[$i],
3693 hash=>$diffinfo->{'from_id'}[$i],
3694 file_name=>$from->{'file'}[$i]);
3695 } else {
3696 $from->{'href'}[$i] = undef;
3699 } else {
3700 # ordinary (not combined) diff
3701 $from->{'file'} = $diffinfo->{'from_file'};
3702 if ($diffinfo->{'status'} ne "A") { # not new (added) file
3703 $from->{'href'} = href(action=>"blob", hash_base=>$hash_parent,
3704 hash=>$diffinfo->{'from_id'},
3705 file_name=>$from->{'file'});
3706 } else {
3707 delete $from->{'href'};
3711 $to->{'file'} = $diffinfo->{'to_file'};
3712 if (!is_deleted($diffinfo)) { # file exists in result
3713 $to->{'href'} = href(action=>"blob", hash_base=>$hash,
3714 hash=>$diffinfo->{'to_id'},
3715 file_name=>$to->{'file'});
3716 } else {
3717 delete $to->{'href'};
3721 ## ......................................................................
3722 ## parse to array of hashes functions
3724 sub git_get_heads_list {
3725 my ($limit, @classes) = @_;
3726 @classes = get_branch_refs() unless @classes;
3727 my @patterns = map { "refs/$_" } @classes;
3728 my @headslist;
3730 open my $fd, '-|', git_cmd(), 'for-each-ref',
3731 ($limit ? '--count='.($limit+1) : ()), '--sort=-committerdate',
3732 '--format=%(objectname) %(refname) %(subject)%00%(committer)',
3733 @patterns
3734 or return;
3735 while (my $line = <$fd>) {
3736 my %ref_item;
3738 chomp $line;
3739 my ($refinfo, $committerinfo) = split(/\0/, $line);
3740 my ($hash, $name, $title) = split(' ', $refinfo, 3);
3741 my ($committer, $epoch, $tz) =
3742 ($committerinfo =~ /^(.*) ([0-9]+) (.*)$/);
3743 $ref_item{'fullname'} = $name;
3744 my $strip_refs = join '|', map { quotemeta } get_branch_refs();
3745 $name =~ s!^refs/($strip_refs|remotes)/!!;
3746 $ref_item{'name'} = $name;
3747 # for refs neither in 'heads' nor 'remotes' we want to
3748 # show their ref dir
3749 my $ref_dir = (defined $1) ? $1 : '';
3750 if ($ref_dir ne '' and $ref_dir ne 'heads' and $ref_dir ne 'remotes') {
3751 $ref_item{'name'} .= ' (' . $ref_dir . ')';
3754 $ref_item{'id'} = $hash;
3755 $ref_item{'title'} = $title || '(no commit message)';
3756 $ref_item{'epoch'} = $epoch;
3757 if ($epoch) {
3758 $ref_item{'age'} = age_string(time - $ref_item{'epoch'});
3759 } else {
3760 $ref_item{'age'} = "unknown";
3763 push @headslist, \%ref_item;
3765 close $fd;
3767 return wantarray ? @headslist : \@headslist;
3770 sub git_get_tags_list {
3771 my $limit = shift;
3772 my @tagslist;
3774 open my $fd, '-|', git_cmd(), 'for-each-ref',
3775 ($limit ? '--count='.($limit+1) : ()), '--sort=-creatordate',
3776 '--format=%(objectname) %(objecttype) %(refname) '.
3777 '%(*objectname) %(*objecttype) %(subject)%00%(creator)',
3778 'refs/tags'
3779 or return;
3780 while (my $line = <$fd>) {
3781 my %ref_item;
3783 chomp $line;
3784 my ($refinfo, $creatorinfo) = split(/\0/, $line);
3785 my ($id, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
3786 my ($creator, $epoch, $tz) =
3787 ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
3788 $ref_item{'fullname'} = $name;
3789 $name =~ s!^refs/tags/!!;
3791 $ref_item{'type'} = $type;
3792 $ref_item{'id'} = $id;
3793 $ref_item{'name'} = $name;
3794 if ($type eq "tag") {
3795 $ref_item{'subject'} = $title;
3796 $ref_item{'reftype'} = $reftype;
3797 $ref_item{'refid'} = $refid;
3798 } else {
3799 $ref_item{'reftype'} = $type;
3800 $ref_item{'refid'} = $id;
3803 if ($type eq "tag" || $type eq "commit") {
3804 $ref_item{'epoch'} = $epoch;
3805 if ($epoch) {
3806 $ref_item{'age'} = age_string(time - $ref_item{'epoch'});
3807 } else {
3808 $ref_item{'age'} = "unknown";
3812 push @tagslist, \%ref_item;
3814 close $fd;
3816 return wantarray ? @tagslist : \@tagslist;
3819 ## ----------------------------------------------------------------------
3820 ## filesystem-related functions
3822 sub get_file_owner {
3823 my $path = shift;
3825 my ($dev, $ino, $mode, $nlink, $st_uid, $st_gid, $rdev, $size) = stat($path);
3826 my ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($st_uid);
3827 if (!defined $gcos) {
3828 return undef;
3830 my $owner = $gcos;
3831 $owner =~ s/[,;].*$//;
3832 return to_utf8($owner);
3835 # assume that file exists
3836 sub insert_file {
3837 my $filename = shift;
3839 open my $fd, '<', $filename;
3840 print map { to_utf8($_) } <$fd>;
3841 close $fd;
3844 ## ......................................................................
3845 ## mimetype related functions
3847 sub mimetype_guess_file {
3848 my $filename = shift;
3849 my $mimemap = shift;
3850 -r $mimemap or return undef;
3852 my %mimemap;
3853 open(my $mh, '<', $mimemap) or return undef;
3854 while (<$mh>) {
3855 next if m/^#/; # skip comments
3856 my ($mimetype, @exts) = split(/\s+/);
3857 foreach my $ext (@exts) {
3858 $mimemap{$ext} = $mimetype;
3861 close($mh);
3863 $filename =~ /\.([^.]*)$/;
3864 return $mimemap{$1};
3867 sub mimetype_guess {
3868 my $filename = shift;
3869 my $mime;
3870 $filename =~ /\./ or return undef;
3872 if ($mimetypes_file) {
3873 my $file = $mimetypes_file;
3874 if ($file !~ m!^/!) { # if it is relative path
3875 # it is relative to project
3876 $file = "$projectroot/$project/$file";
3878 $mime = mimetype_guess_file($filename, $file);
3880 $mime ||= mimetype_guess_file($filename, '/etc/mime.types');
3881 return $mime;
3884 sub blob_mimetype {
3885 my $fd = shift;
3886 my $filename = shift;
3888 if ($filename) {
3889 my $mime = mimetype_guess($filename);
3890 $mime and return $mime;
3893 # just in case
3894 return $default_blob_plain_mimetype unless $fd;
3896 if (-T $fd) {
3897 return 'text/plain';
3898 } elsif (! $filename) {
3899 return 'application/octet-stream';
3900 } elsif ($filename =~ m/\.png$/i) {
3901 return 'image/png';
3902 } elsif ($filename =~ m/\.gif$/i) {
3903 return 'image/gif';
3904 } elsif ($filename =~ m/\.jpe?g$/i) {
3905 return 'image/jpeg';
3906 } else {
3907 return 'application/octet-stream';
3911 sub blob_contenttype {
3912 my ($fd, $file_name, $type) = @_;
3914 $type ||= blob_mimetype($fd, $file_name);
3915 if ($type eq 'text/plain' && defined $default_text_plain_charset) {
3916 $type .= "; charset=$default_text_plain_charset";
3919 return $type;
3922 # guess file syntax for syntax highlighting; return undef if no highlighting
3923 # the name of syntax can (in the future) depend on syntax highlighter used
3924 sub guess_file_syntax {
3925 my ($highlight, $file_name) = @_;
3926 return undef unless ($highlight && defined $file_name);
3927 my $basename = basename($file_name, '.in');
3928 return $highlight_basename{$basename}
3929 if exists $highlight_basename{$basename};
3931 $basename =~ /\.([^.]*)$/;
3932 my $ext = $1 or return undef;
3933 return $highlight_ext{$ext}
3934 if exists $highlight_ext{$ext};
3936 return undef;
3939 # run highlighter and return FD of its output,
3940 # or return original FD if no highlighting
3941 sub run_highlighter {
3942 my ($fd, $highlight, $syntax) = @_;
3943 return $fd unless ($highlight);
3945 close $fd;
3946 my $syntax_arg = (defined $syntax) ? "--syntax $syntax" : "--force";
3947 open $fd, quote_command(git_cmd(), "cat-file", "blob", $hash)." | ".
3948 quote_command($^X, '-CO', '-MEncode=decode,FB_DEFAULT', '-pse',
3949 '$_ = decode($fe, $_, FB_DEFAULT) if !utf8::decode($_);',
3950 '--', "-fe=$fallback_encoding")." | ".
3951 quote_command($highlight_bin).
3952 " --replace-tabs=8 --fragment $syntax_arg |"
3953 or die_error(500, "Couldn't open file or run syntax highlighter");
3954 return $fd;
3957 ## ======================================================================
3958 ## functions printing HTML: header, footer, error page
3960 sub get_page_title {
3961 my $title = to_utf8($site_name);
3963 unless (defined $project) {
3964 if (defined $project_filter) {
3965 $title .= " - projects in '" . esc_path($project_filter) . "'";
3967 return $title;
3969 $title .= " - " . to_utf8($project);
3971 return $title unless (defined $action);
3972 $title .= "/$action"; # $action is US-ASCII (7bit ASCII)
3974 return $title unless (defined $file_name);
3975 $title .= " - " . esc_path($file_name);
3976 if ($action eq "tree" && $file_name !~ m|/$|) {
3977 $title .= "/";
3980 return $title;
3983 sub get_content_type_html {
3984 # require explicit support from the UA if we are to send the page as
3985 # 'application/xhtml+xml', otherwise send it as plain old 'text/html'.
3986 # we have to do this because MSIE sometimes globs '*/*', pretending to
3987 # support xhtml+xml but choking when it gets what it asked for.
3988 if (defined $cgi->http('HTTP_ACCEPT') &&
3989 $cgi->http('HTTP_ACCEPT') =~ m/(,|;|\s|^)application\/xhtml\+xml(,|;|\s|$)/ &&
3990 $cgi->Accept('application/xhtml+xml') != 0) {
3991 return 'application/xhtml+xml';
3992 } else {
3993 return 'text/html';
3997 sub print_feed_meta {
3998 if (defined $project) {
3999 my %href_params = get_feed_info();
4000 if (!exists $href_params{'-title'}) {
4001 $href_params{'-title'} = 'log';
4004 foreach my $format (qw(RSS Atom)) {
4005 my $type = lc($format);
4006 my %link_attr = (
4007 '-rel' => 'alternate',
4008 '-title' => esc_attr("$project - $href_params{'-title'} - $format feed"),
4009 '-type' => "application/$type+xml"
4012 $href_params{'extra_options'} = undef;
4013 $href_params{'action'} = $type;
4014 $link_attr{'-href'} = href(%href_params);
4015 print "<link ".
4016 "rel=\"$link_attr{'-rel'}\" ".
4017 "title=\"$link_attr{'-title'}\" ".
4018 "href=\"$link_attr{'-href'}\" ".
4019 "type=\"$link_attr{'-type'}\" ".
4020 "/>\n";
4022 $href_params{'extra_options'} = '--no-merges';
4023 $link_attr{'-href'} = href(%href_params);
4024 $link_attr{'-title'} .= ' (no merges)';
4025 print "<link ".
4026 "rel=\"$link_attr{'-rel'}\" ".
4027 "title=\"$link_attr{'-title'}\" ".
4028 "href=\"$link_attr{'-href'}\" ".
4029 "type=\"$link_attr{'-type'}\" ".
4030 "/>\n";
4033 } else {
4034 printf('<link rel="alternate" title="%s projects list" '.
4035 'href="%s" type="text/plain; charset=utf-8" />'."\n",
4036 esc_attr($site_name), href(project=>undef, action=>"project_index"));
4037 printf('<link rel="alternate" title="%s projects feeds" '.
4038 'href="%s" type="text/x-opml" />'."\n",
4039 esc_attr($site_name), href(project=>undef, action=>"opml"));
4043 sub print_header_links {
4044 my $status = shift;
4046 # print out each stylesheet that exist, providing backwards capability
4047 # for those people who defined $stylesheet in a config file
4048 if (defined $stylesheet) {
4049 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4050 } else {
4051 foreach my $stylesheet (@stylesheets) {
4052 next unless $stylesheet;
4053 print '<link rel="stylesheet" type="text/css" href="'.esc_url($stylesheet).'"/>'."\n";
4056 print_feed_meta()
4057 if ($status eq '200 OK');
4058 if (defined $favicon) {
4059 print qq(<link rel="shortcut icon" href=").esc_url($favicon).qq(" type="image/png" />\n);
4063 sub print_nav_breadcrumbs_path {
4064 my $dirprefix = undef;
4065 while (my $part = shift) {
4066 $dirprefix .= "/" if defined $dirprefix;
4067 $dirprefix .= $part;
4068 print $cgi->a({-href => href(project => undef,
4069 project_filter => $dirprefix,
4070 action => "project_list")},
4071 esc_html($part)) . " / ";
4075 sub print_nav_breadcrumbs {
4076 my %opts = @_;
4078 for my $crumb (@extra_breadcrumbs, [ $home_link_str => $home_link ]) {
4079 print $cgi->a({-href => esc_url($crumb->[1])}, $crumb->[0]) . " / ";
4081 if (defined $project) {
4082 my @dirname = split '/', $project;
4083 my $projectbasename = pop @dirname;
4084 print_nav_breadcrumbs_path(@dirname);
4085 print $cgi->a({-href => href(action=>"summary")}, esc_html($projectbasename));
4086 if (defined $action) {
4087 my $action_print = $action ;
4088 if (defined $opts{-action_extra}) {
4089 $action_print = $cgi->a({-href => href(action=>$action)},
4090 $action);
4092 print " / $action_print";
4094 if (defined $opts{-action_extra}) {
4095 print " / $opts{-action_extra}";
4097 print "\n";
4098 } elsif (defined $project_filter) {
4099 print_nav_breadcrumbs_path(split '/', $project_filter);
4103 sub print_search_form {
4104 if (!defined $searchtext) {
4105 $searchtext = "";
4107 my $search_hash;
4108 if (defined $hash_base) {
4109 $search_hash = $hash_base;
4110 } elsif (defined $hash) {
4111 $search_hash = $hash;
4112 } else {
4113 $search_hash = "HEAD";
4115 my $action = $my_uri;
4116 my $use_pathinfo = gitweb_check_feature('pathinfo');
4117 if ($use_pathinfo) {
4118 $action .= "/".esc_url($project);
4120 print $cgi->start_form(-method => "get", -action => $action) .
4121 "<div class=\"search\">\n" .
4122 (!$use_pathinfo &&
4123 $cgi->input({-name=>"p", -value=>$project, -type=>"hidden"}) . "\n") .
4124 $cgi->input({-name=>"a", -value=>"search", -type=>"hidden"}) . "\n" .
4125 $cgi->input({-name=>"h", -value=>$search_hash, -type=>"hidden"}) . "\n" .
4126 $cgi->popup_menu(-name => 'st', -default => 'commit',
4127 -values => ['commit', 'grep', 'author', 'committer', 'pickaxe']) .
4128 " " . $cgi->a({-href => href(action=>"search_help"),
4129 -title => "search help" }, "?") . " search:\n",
4130 $cgi->textfield(-name => "s", -value => $searchtext, -override => 1) . "\n" .
4131 "<span title=\"Extended regular expression\">" .
4132 $cgi->checkbox(-name => 'sr', -value => 1, -label => 're',
4133 -checked => $search_use_regexp) .
4134 "</span>" .
4135 "</div>" .
4136 $cgi->end_form() . "\n";
4139 sub git_header_html {
4140 my $status = shift || "200 OK";
4141 my $expires = shift;
4142 my %opts = @_;
4144 my $title = get_page_title();
4145 my $content_type = get_content_type_html();
4146 print $cgi->header(-type=>$content_type, -charset => 'utf-8',
4147 -status=> $status, -expires => $expires)
4148 unless ($opts{'-no_http_header'});
4149 my $mod_perl_version = $ENV{'MOD_PERL'} ? " $ENV{'MOD_PERL'}" : '';
4150 print <<EOF;
4151 <?xml version="1.0" encoding="utf-8"?>
4152 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
4153 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
4154 <!-- git web interface version $version, (C) 2005-2006, Kay Sievers <kay.sievers\@vrfy.org>, Christian Gierke -->
4155 <!-- git core binaries version $git_version -->
4156 <head>
4157 <meta http-equiv="content-type" content="$content_type; charset=utf-8"/>
4158 <meta name="generator" content="gitweb/$version git/$git_version$mod_perl_version"/>
4159 <meta name="robots" content="index, nofollow"/>
4160 <title>$title</title>
4162 # the stylesheet, favicon etc urls won't work correctly with path_info
4163 # unless we set the appropriate base URL
4164 if ($ENV{'PATH_INFO'}) {
4165 print "<base href=\"".esc_url($base_url)."\" />\n";
4167 print_header_links($status);
4169 if (defined $site_html_head_string) {
4170 print to_utf8($site_html_head_string);
4173 print "</head>\n" .
4174 "<body>\n";
4176 if (defined $site_header && -f $site_header) {
4177 insert_file($site_header);
4180 print "<div class=\"page_header\">\n";
4181 if (defined $logo) {
4182 print $cgi->a({-href => esc_url($logo_url),
4183 -title => $logo_label},
4184 $cgi->img({-src => esc_url($logo),
4185 -width => 72, -height => 27,
4186 -alt => "git",
4187 -class => "logo"}));
4189 print_nav_breadcrumbs(%opts);
4190 print "</div>\n";
4192 my $have_search = gitweb_check_feature('search');
4193 if (defined $project && $have_search) {
4194 print_search_form();
4198 sub git_footer_html {
4199 my $feed_class = 'rss_logo';
4201 print "<div class=\"page_footer\">\n";
4202 if (defined $project) {
4203 my $descr = git_get_project_description($project);
4204 if (defined $descr) {
4205 print "<div class=\"page_footer_text\">" . esc_html($descr) . "</div>\n";
4208 my %href_params = get_feed_info();
4209 if (!%href_params) {
4210 $feed_class .= ' generic';
4212 $href_params{'-title'} ||= 'log';
4214 foreach my $format (qw(RSS Atom)) {
4215 $href_params{'action'} = lc($format);
4216 print $cgi->a({-href => href(%href_params),
4217 -title => "$href_params{'-title'} $format feed",
4218 -class => $feed_class}, $format)."\n";
4221 } else {
4222 print $cgi->a({-href => href(project=>undef, action=>"opml",
4223 project_filter => $project_filter),
4224 -class => $feed_class}, "OPML") . " ";
4225 print $cgi->a({-href => href(project=>undef, action=>"project_index",
4226 project_filter => $project_filter),
4227 -class => $feed_class}, "TXT") . "\n";
4229 print "</div>\n"; # class="page_footer"
4231 if (defined $t0 && gitweb_check_feature('timed')) {
4232 print "<div id=\"generating_info\">\n";
4233 print 'This page took '.
4234 '<span id="generating_time" class="time_span">'.
4235 tv_interval($t0, [ gettimeofday() ]).
4236 ' seconds </span>'.
4237 ' and '.
4238 '<span id="generating_cmd">'.
4239 $number_of_git_cmds.
4240 '</span> git commands '.
4241 " to generate.\n";
4242 print "</div>\n"; # class="page_footer"
4245 if (defined $site_footer && -f $site_footer) {
4246 insert_file($site_footer);
4249 print qq!<script type="text/javascript" src="!.esc_url($javascript).qq!"></script>\n!;
4250 if (defined $action &&
4251 $action eq 'blame_incremental') {
4252 print qq!<script type="text/javascript">\n!.
4253 qq!startBlame("!. href(action=>"blame_data", -replay=>1) .qq!",\n!.
4254 qq! "!. href() .qq!");\n!.
4255 qq!</script>\n!;
4256 } else {
4257 my ($jstimezone, $tz_cookie, $datetime_class) =
4258 gitweb_get_feature('javascript-timezone');
4260 print qq!<script type="text/javascript">\n!.
4261 qq!window.onload = function () {\n!;
4262 if (gitweb_check_feature('javascript-actions')) {
4263 print qq! fixLinks();\n!;
4265 if ($jstimezone && $tz_cookie && $datetime_class) {
4266 print qq! var tz_cookie = { name: '$tz_cookie', expires: 14, path: '/' };\n!. # in days
4267 qq! onloadTZSetup('$jstimezone', tz_cookie, '$datetime_class');\n!;
4269 print qq!};\n!.
4270 qq!</script>\n!;
4273 print "</body>\n" .
4274 "</html>";
4277 # die_error(<http_status_code>, <error_message>[, <detailed_html_description>])
4278 # Example: die_error(404, 'Hash not found')
4279 # By convention, use the following status codes (as defined in RFC 2616):
4280 # 400: Invalid or missing CGI parameters, or
4281 # requested object exists but has wrong type.
4282 # 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
4283 # this server or project.
4284 # 404: Requested object/revision/project doesn't exist.
4285 # 500: The server isn't configured properly, or
4286 # an internal error occurred (e.g. failed assertions caused by bugs), or
4287 # an unknown error occurred (e.g. the git binary died unexpectedly).
4288 # 503: The server is currently unavailable (because it is overloaded,
4289 # or down for maintenance). Generally, this is a temporary state.
4290 sub die_error {
4291 my $status = shift || 500;
4292 my $error = esc_html(shift) || "Internal Server Error";
4293 my $extra = shift;
4294 my %opts = @_;
4296 my %http_responses = (
4297 400 => '400 Bad Request',
4298 403 => '403 Forbidden',
4299 404 => '404 Not Found',
4300 500 => '500 Internal Server Error',
4301 503 => '503 Service Unavailable',
4303 git_header_html($http_responses{$status}, undef, %opts);
4304 print <<EOF;
4305 <div class="page_body">
4306 <br /><br />
4307 $status - $error
4308 <br />