\n"; # class="diff nodifferences"
return $result;
}
sub diff_line_class {
my ($line, $from, $to) = @_;
# ordinary diff
my $num_sign = 1;
# combined diff
if ($from && $to && ref($from->{'href'}) eq "ARRAY") {
$num_sign = scalar @{$from->{'href'}};
}
my @diff_line_classifier = (
{ regexp => qr/^\@\@{$num_sign} /, class => "chunk_header"},
{ regexp => qr/^\\/, class => "incomplete" },
{ regexp => qr/^ {$num_sign}/, class => "ctx" },
# classifier for context must come before classifier add/rem,
# or we would have to use more complicated regexp, for example
# qr/(?= {0,$m}\+)[+ ]{$num_sign}/, where $m = $num_sign - 1;
{ regexp => qr/^[+ ]{$num_sign}/, class => "add" },
{ regexp => qr/^[- ]{$num_sign}/, class => "rem" },
);
for my $clsfy (@diff_line_classifier) {
return $clsfy->{'class'}
if ($line =~ $clsfy->{'regexp'});
}
# fallback
return "";
}
# assumes that $from and $to are defined and correctly filled,
# and that $line holds a line of chunk header for unified diff
sub format_unidiff_chunk_header {
my ($line, $from, $to) = @_;
my ($from_text, $from_start, $from_lines, $to_text, $to_start, $to_lines, $section) =
$line =~ m/^\@{2} (-(\d+)(?:,(\d+))?) (\+(\d+)(?:,(\d+))?) \@{2}(.*)$/;
$from_lines = 0 unless defined $from_lines;
$to_lines = 0 unless defined $to_lines;
if ($from->{'href'}) {
$from_text = $cgi->a({-href=>"$from->{'href'}#l$from_start",
-class=>"list"}, $from_text);
}
if ($to->{'href'}) {
$to_text = $cgi->a({-href=>"$to->{'href'}#l$to_start",
-class=>"list"}, $to_text);
}
$line = "@@ $from_text $to_text @@" .
"" . esc_html($section, -nbsp=>1) . "";
return $line;
}
# assumes that $from and $to are defined and correctly filled,
# and that $line holds a line of chunk header for combined diff
sub format_cc_diff_chunk_header {
my ($line, $from, $to) = @_;
my ($prefix, $ranges, $section) = $line =~ m/^(\@+) (.*?) \@+(.*)$/;
my (@from_text, @from_start, @from_nlines, $to_text, $to_start, $to_nlines);
@from_text = split(' ', $ranges);
for (my $i = 0; $i < @from_text; ++$i) {
($from_start[$i], $from_nlines[$i]) =
(split(',', substr($from_text[$i], 1)), 0);
}
$to_text = pop @from_text;
$to_start = pop @from_start;
$to_nlines = pop @from_nlines;
$line = "$prefix ";
for (my $i = 0; $i < @from_text; ++$i) {
if ($from->{'href'}[$i]) {
$line .= $cgi->a({-href=>"$from->{'href'}[$i]#l$from_start[$i]",
-class=>"list"}, $from_text[$i]);
} else {
$line .= $from_text[$i];
}
$line .= " ";
}
if ($to->{'href'}) {
$line .= $cgi->a({-href=>"$to->{'href'}#l$to_start",
-class=>"list"}, $to_text);
} else {
$line .= $to_text;
}
$line .= " $prefix" .
"" . esc_html($section, -nbsp=>1) . "";
return $line;
}
# process patch (diff) line (not to be used for diff headers),
# returning HTML-formatted (but not wrapped) line.
# If the line is passed as a reference, it is treated as HTML and not
# esc_html()'ed.
sub format_diff_line {
my ($line, $diff_class, $from, $to) = @_;
if (ref($line)) {
$line = $$line;
} else {
chomp $line;
$line = untabify($line);
if ($from && $to && $line =~ m/^\@{2} /) {
$line = format_unidiff_chunk_header($line, $from, $to);
} elsif ($from && $to && $line =~ m/^\@{3}/) {
$line = format_cc_diff_chunk_header($line, $from, $to);
} else {
$line = esc_html($line, -nbsp=>1);
}
}
my $diff_classes = "diff";
$diff_classes .= " $diff_class" if ($diff_class);
$line = "
$line
\n";
return $line;
}
# Generates undef or something like "_snapshot_" or "snapshot (_tbz2_ _zip_)",
# linked. Pass the hash of the tree/commit to snapshot.
sub format_snapshot_links {
my ($hash) = @_;
my $num_fmts = @snapshot_fmts;
if ($num_fmts > 1) {
# A parenthesized list of links bearing format names.
# e.g. "snapshot (_tar.gz_ _zip_)"
return "snapshot (" . join(' ', map
$cgi->a({
-href => href(
action=>"snapshot",
hash=>$hash,
snapshot_format=>$_
)
}, $known_snapshot_formats{$_}{'display'})
, @snapshot_fmts) . ")";
} elsif ($num_fmts == 1) {
# A single "snapshot" link whose tooltip bears the format name.
# i.e. "_snapshot_"
my ($fmt) = @snapshot_fmts;
return
$cgi->a({
-href => href(
action=>"snapshot",
hash=>$hash,
snapshot_format=>$fmt
),
-title => "in format: $known_snapshot_formats{$fmt}{'display'}"
}, "snapshot");
} else { # $num_fmts == 0
return undef;
}
}
## ......................................................................
## functions returning values to be passed, perhaps after some
## transformation, to other functions; e.g. returning arguments to href()
# returns hash to be passed to href to generate gitweb URL
# in -title key it returns description of link
sub get_feed_info {
my $format = shift || 'Atom';
my %res = (action => lc($format));
my $matched_ref = 0;
# feed links are possible only for project views
return unless (defined $project);
# some views should link to OPML, or to generic project feed,
# or don't have specific feed yet (so they should use generic)
return if (!$action || $action =~ /^(?:tags|heads|forks|tag|search)$/x);
my $branch = undef;
# branches refs uses 'refs/' + $get_branch_refs()[x] + '/' prefix
# (fullname) to differentiate from tag links; this also makes
# possible to detect branch links
for my $ref (get_branch_refs()) {
if ((defined $hash_base && $hash_base =~ m!^refs/\Q$ref\E/(.*)$!) ||
(defined $hash && $hash =~ m!^refs/\Q$ref\E/(.*)$!)) {
$branch = $1;
$matched_ref = $ref;
last;
}
}
# find log type for feed description (title)
my $type = 'log';
if (defined $file_name) {
$type = "history of $file_name";
$type .= "/" if ($action eq 'tree');
$type .= " on '$branch'" if (defined $branch);
} else {
$type = "log of $branch" if (defined $branch);
}
$res{-title} = $type;
$res{'hash'} = (defined $branch ? "refs/$matched_ref/$branch" : undef);
$res{'file_name'} = $file_name;
return %res;
}
## ----------------------------------------------------------------------
## git utility subroutines, invoking git commands
# returns path to the core git executable and the --git-dir parameter as list
sub git_cmd {
$number_of_git_cmds++;
return $GIT, '--git-dir='.$git_dir;
}
# quote the given arguments for passing them to the shell
# quote_command("command", "arg 1", "arg with ' and ! characters")
# => "'command' 'arg 1' 'arg with '\'' and '\!' characters'"
# Try to avoid using this function wherever possible.
sub quote_command {
return join(' ',
map { my $a = $_; $a =~ s/(['!])/'\\$1'/g; "'$a'" } @_ );
}
# get HEAD ref of given project as hash
sub git_get_head_hash {
return git_get_full_hash(shift, 'HEAD');
}
sub git_get_full_hash {
return git_get_hash(@_);
}
sub git_get_short_hash {
return git_get_hash(@_, '--short=7');
}
sub git_get_hash {
my ($project, $hash, @options) = @_;
my $o_git_dir = $git_dir;
my $retval = undef;
$git_dir = "$projectroot/$project";
if (open my $fd, '-|', git_cmd(), 'rev-parse',
'--verify', '-q', @options, $hash) {
$retval = <$fd>;
chomp $retval if defined $retval;
close $fd;
}
if (defined $o_git_dir) {
$git_dir = $o_git_dir;
}
return $retval;
}
# get type of given object
sub git_get_type {
my $hash = shift;
open my $fd, "-|", git_cmd(), "cat-file", '-t', $hash or return;
my $type = <$fd>;
close $fd or return;
chomp $type;
return $type;
}
# repository configuration
our $config_file = '';
our %config;
# store multiple values for single key as anonymous array reference
# single values stored directly in the hash, not as [ ]
sub hash_set_multi {
my ($hash, $key, $value) = @_;
if (!exists $hash->{$key}) {
$hash->{$key} = $value;
} elsif (!ref $hash->{$key}) {
$hash->{$key} = [ $hash->{$key}, $value ];
} else {
push @{$hash->{$key}}, $value;
}
}
# return hash of git project configuration
# optionally limited to some section, e.g. 'gitweb'
sub git_parse_project_config {
my $section_regexp = shift;
my %config;
local $/ = "\0";
open my $fh, "-|", git_cmd(), "config", '-z', '-l',
or return;
while (my $keyval = <$fh>) {
chomp $keyval;
my ($key, $value) = split(/\n/, $keyval, 2);
hash_set_multi(\%config, $key, $value)
if (!defined $section_regexp || $key =~ /^(?:$section_regexp)\./o);
}
close $fh;
return %config;
}
# convert config value to boolean: 'true' or 'false'
# no value, number > 0, 'true' and 'yes' values are true
# rest of values are treated as false (never as error)
sub config_to_bool {
my $val = shift;
return 1 if !defined $val; # section.key
# strip leading and trailing whitespace
$val =~ s/^\s+//;
$val =~ s/\s+$//;
return (($val =~ /^\d+$/ && $val) || # section.key = 1
($val =~ /^(?:true|yes)$/i)); # section.key = true
}
# convert config value to simple decimal number
# an optional value suffix of 'k', 'm', or 'g' will cause the value
# to be multiplied by 1024, 1048576, or 1073741824
sub config_to_int {
my $val = shift;
# strip leading and trailing whitespace
$val =~ s/^\s+//;
$val =~ s/\s+$//;
if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
$unit = lc($unit);
# unknown unit is treated as 1
return $num * ($unit eq 'g' ? 1073741824 :
$unit eq 'm' ? 1048576 :
$unit eq 'k' ? 1024 : 1);
}
return $val;
}
# convert config value to array reference, if needed
sub config_to_multi {
my $val = shift;
return ref($val) ? $val : (defined($val) ? [ $val ] : []);
}
sub git_get_project_config {
my ($key, $type) = @_;
return unless defined $git_dir;
# key sanity check
return unless ($key);
# only subsection, if exists, is case sensitive,
# and not lowercased by 'git config -z -l'
if (my ($hi, $mi, $lo) = ($key =~ /^([^.]*)\.(.*)\.([^.]*)$/)) {
$lo =~ s/_//g;
$key = join(".", lc($hi), $mi, lc($lo));
return if ($lo =~ /\W/ || $hi =~ /\W/);
} else {
$key = lc($key);
$key =~ s/_//g;
return if ($key =~ /\W/);
}
$key =~ s/^gitweb\.//;
# type sanity check
if (defined $type) {
$type =~ s/^--//;
$type = undef
unless ($type eq 'bool' || $type eq 'int');
}
# get config
if (!defined $config_file ||
$config_file ne "$git_dir/config") {
%config = git_parse_project_config('gitweb');
$config_file = "$git_dir/config";
}
# check if config variable (key) exists
return unless exists $config{"gitweb.$key"};
# ensure given type
if (!defined $type) {
return $config{"gitweb.$key"};
} elsif ($type eq 'bool') {
# backward compatibility: 'git config --bool' returns true/false
return config_to_bool($config{"gitweb.$key"}) ? 'true' : 'false';
} elsif ($type eq 'int') {
return config_to_int($config{"gitweb.$key"});
}
return $config{"gitweb.$key"};
}
# get hash of given path at given ref
sub git_get_hash_by_path {
my $base = shift;
my $path = shift || return undef;
my $type = shift;
$path =~ s,/+$,,;
open my $fd, "-|", git_cmd(), "ls-tree", $base, "--", $path
or die_error(500, "Open git-ls-tree failed");
my $line = <$fd>;
close $fd or return undef;
if (!defined $line) {
# there is no tree or hash given by $path at $base
return undef;
}
#'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
$line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
if (defined $type && $type ne $2) {
# type doesn't match
return undef;
}
return $3;
}
# get path of entry with given hash at given tree-ish (ref)
# used to get 'from' filename for combined diff (merge commit) for renames
sub git_get_path_by_hash {
my $base = shift || return;
my $hash = shift || return;
local $/ = "\0";
open my $fd, "-|", git_cmd(), "ls-tree", '-r', '-t', '-z', $base
or return undef;
while (my $line = <$fd>) {
chomp $line;
#'040000 tree 595596a6a9117ddba9fe379b6b012b558bac8423 gitweb'
#'100644 blob e02e90f0429be0d2a69b76571101f20b8f75530f gitweb/README'
if ($line =~ m/(?:[0-9]+) (?:.+) $hash\t(.+)$/) {
close $fd;
return $1;
}
}
close $fd;
return undef;
}
## ......................................................................
## git utility functions, directly accessing git repository
# get the value of config variable either from file named as the variable
# itself in the repository ($GIT_DIR/$name file), or from gitweb.$name
# configuration variable in the repository config file.
sub git_get_file_or_project_config {
my ($path, $name) = @_;
$git_dir = "$projectroot/$path";
open my $fd, '<', "$git_dir/$name"
or return git_get_project_config($name);
my $conf = <$fd>;
close $fd;
if (defined $conf) {
chomp $conf;
}
return $conf;
}
sub git_get_project_description {
my $path = shift;
return git_get_file_or_project_config($path, 'description');
}
sub git_get_project_category {
my $path = shift;
return git_get_file_or_project_config($path, 'category');
}
# supported formats:
# * $GIT_DIR/ctags/ file (in 'ctags' subdirectory)
# - if its contents is a number, use it as tag weight,
# - otherwise add a tag with weight 1
# * $GIT_DIR/ctags file, each line is a tag (with weight 1)
# the same value multiple times increases tag weight
# * `gitweb.ctag' multi-valued repo config variable
sub git_get_project_ctags {
my $project = shift;
my $ctags = {};
$git_dir = "$projectroot/$project";
if (opendir my $dh, "$git_dir/ctags") {
my @files = grep { -f $_ } map { "$git_dir/ctags/$_" } readdir($dh);
foreach my $tagfile (@files) {
open my $ct, '<', $tagfile
or next;
my $val = <$ct>;
chomp $val if $val;
close $ct;
(my $ctag = $tagfile) =~ s#.*/##;
if ($val =~ /^\d+$/) {
$ctags->{$ctag} = $val;
} else {
$ctags->{$ctag} = 1;
}
}
closedir $dh;
} elsif (open my $fh, '<', "$git_dir/ctags") {
while (my $line = <$fh>) {
chomp $line;
$ctags->{$line}++ if $line;
}
close $fh;
} else {
my $taglist = config_to_multi(git_get_project_config('ctag'));
foreach my $tag (@$taglist) {
$ctags->{$tag}++;
}
}
return $ctags;
}
# return hash, where keys are content tags ('ctags'),
# and values are sum of weights of given tag in every project
sub git_gather_all_ctags {
my $projects = shift;
my $ctags = {};
foreach my $p (@$projects) {
foreach my $ct (keys %{$p->{'ctags'}}) {
$ctags->{$ct} += $p->{'ctags'}->{$ct};
}
}
return $ctags;
}
sub git_populate_project_tagcloud {
my $ctags = shift;
# First, merge different-cased tags; tags vote on casing
my %ctags_lc;
foreach (keys %$ctags) {
$ctags_lc{lc $_}->{count} += $ctags->{$_};
if (not $ctags_lc{lc $_}->{topcount}
or $ctags_lc{lc $_}->{topcount} < $ctags->{$_}) {
$ctags_lc{lc $_}->{topcount} = $ctags->{$_};
$ctags_lc{lc $_}->{topname} = $_;
}
}
my $cloud;
my $matched = $input_params{'ctag'};
if (eval { require HTML::TagCloud; 1; }) {
$cloud = HTML::TagCloud->new;
foreach my $ctag (sort keys %ctags_lc) {
# Pad the title with spaces so that the cloud looks
# less crammed.
my $title = esc_html($ctags_lc{$ctag}->{topname});
$title =~ s/ / /g;
$title =~ s/^/ /g;
$title =~ s/$/ /g;
if (defined $matched && $matched eq $ctag) {
$title = qq($title);
}
$cloud->add($title, href(project=>undef, ctag=>$ctag),
$ctags_lc{$ctag}->{count});
}
} else {
$cloud = {};
foreach my $ctag (keys %ctags_lc) {
my $title = esc_html($ctags_lc{$ctag}->{topname}, -nbsp=>1);
if (defined $matched && $matched eq $ctag) {
$title = qq($title);
}
$cloud->{$ctag}{count} = $ctags_lc{$ctag}->{count};
$cloud->{$ctag}{ctag} =
$cgi->a({-href=>href(project=>undef, ctag=>$ctag)}, $title);
}
}
return $cloud;
}
sub git_show_project_tagcloud {
my ($cloud, $count) = @_;
if (ref $cloud eq 'HTML::TagCloud') {
return $cloud->html_and_css($count);
} else {
my @tags = sort { $cloud->{$a}->{'count'} <=> $cloud->{$b}->{'count'} } keys %$cloud;
return
'
\n";
my $have_search = gitweb_check_feature('search');
if (defined $project && $have_search) {
print_search_form();
}
}
sub git_footer_html {
my $feed_class = 'rss_logo';
print "\n"; # class="page_footer"
if (defined $t0 && gitweb_check_feature('timed')) {
print "
\n";
print 'This page took '.
''.
tv_interval($t0, [ gettimeofday() ]).
' seconds '.
' and '.
''.
$number_of_git_cmds.
' git commands '.
" to generate.\n";
print "
\n"; # class="page_footer"
}
if (defined $site_footer && -f $site_footer) {
insert_file($site_footer);
}
print qq!\n!;
if (defined $action &&
$action eq 'blame_incremental') {
print qq!\n!;
} else {
my ($jstimezone, $tz_cookie, $datetime_class) =
gitweb_get_feature('javascript-timezone');
print qq!\n!;
}
print "\n" .
"";
}
# die_error(, [, ])
# Example: die_error(404, 'Hash not found')
# By convention, use the following status codes (as defined in RFC 2616):
# 400: Invalid or missing CGI parameters, or
# requested object exists but has wrong type.
# 403: Requested feature (like "pickaxe" or "snapshot") not enabled on
# this server or project.
# 404: Requested object/revision/project doesn't exist.
# 500: The server isn't configured properly, or
# an internal error occurred (e.g. failed assertions caused by bugs), or
# an unknown error occurred (e.g. the git binary died unexpectedly).
# 503: The server is currently unavailable (because it is overloaded,
# or down for maintenance). Generally, this is a temporary state.
sub die_error {
my $status = shift || 500;
my $error = esc_html(shift) || "Internal Server Error";
my $extra = shift;
my %opts = @_;
my %http_responses = (
400 => '400 Bad Request',
403 => '403 Forbidden',
404 => '404 Not Found',
500 => '500 Internal Server Error',
503 => '503 Service Unavailable',
);
git_header_html($http_responses{$status}, undef, %opts);
print <
$status - $error
EOF
if (defined $extra) {
print "\n" .
"$extra\n";
}
print "\n";
git_footer_html();
goto DONE_GITWEB
unless ($opts{'-error_handler'});
}
## ----------------------------------------------------------------------
## functions printing or outputting HTML: navigation
sub git_print_page_nav {
my ($current, $suppress, $head, $treehead, $treebase, $extra) = @_;
$extra = '' if !defined $extra; # pager or formats
my @navs = qw(summary shortlog log commit commitdiff tree);
if ($suppress) {
@navs = grep { $_ ne $suppress } @navs;
}
my %arg = map { $_ => {action=>$_} } @navs;
if (defined $head) {
for (qw(commit commitdiff)) {
$arg{$_}{'hash'} = $head;
}
if ($current =~ m/^(tree | log | shortlog | commit | commitdiff | search)$/x) {
for (qw(shortlog log)) {
$arg{$_}{'hash'} = $head;
}
}
}
$arg{'tree'}{'hash'} = $treehead if defined $treehead;
$arg{'tree'}{'hash_base'} = $treebase if defined $treebase;
my @actions = gitweb_get_feature('actions');
my %repl = (
'%' => '%',
'n' => $project, # project name
'f' => $git_dir, # project path within filesystem
'h' => $treehead || '', # current hash ('h' parameter)
'b' => $treebase || '', # hash base ('hb' parameter)
);
while (@actions) {
my ($label, $link, $pos) = splice(@actions,0,3);
# insert
@navs = map { $_ eq $pos ? ($_, $label) : $_ } @navs;
# munch munch
$link =~ s/%([%nfhb])/$repl{$1}/g;
$arg{$label}{'_href'} = $link;
}
print "
\n";
}
sub format_repo_url {
my ($name, $url) = @_;
return "
$name
$url
\n";
}
# Group output by placing it in a DIV element and adding a header.
# Options for start_div() can be provided by passing a hash reference as the
# first parameter to the function.
# Options to git_print_header_div() can be provided by passing an array
# reference. This must follow the options to start_div if they are present.
# The content can be a scalar, which is output as-is, a scalar reference, which
# is output after html escaping, an IO handle passed either as *handle or
# *handle{IO}, or a function reference. In the latter case all following
# parameters will be taken as argument to the content function call.
sub git_print_section {
my ($div_args, $header_args, $content);
my $arg = shift;
if (ref($arg) eq 'HASH') {
$div_args = $arg;
$arg = shift;
}
if (ref($arg) eq 'ARRAY') {
$header_args = $arg;
$arg = shift;
}
$content = $arg;
print $cgi->start_div($div_args);
git_print_header_div(@$header_args);
if (ref($content) eq 'CODE') {
$content->(@_);
} elsif (ref($content) eq 'SCALAR') {
print esc_html($$content);
} elsif (ref($content) eq 'GLOB' or ref($content) eq 'IO::Handle') {
print <$content>;
} elsif (!ref($content) && defined($content)) {
print $content;
}
print $cgi->end_div;
}
sub format_timestamp_html {
my $date = shift;
my $strtime = $date->{'rfc2822'};
my (undef, undef, $datetime_class) =
gitweb_get_feature('javascript-timezone');
if ($datetime_class) {
$strtime = qq!$strtime!;
}
my $localtime_format = '(%02d:%02d %s)';
if ($date->{'hour_local'} < 6) {
$localtime_format = '(%02d:%02d %s)';
}
$strtime .= ' ' .
sprintf($localtime_format,
$date->{'hour_local'}, $date->{'minute_local'}, $date->{'tz_local'});
return $strtime;
}
# Outputs the author name and date in long form
sub git_print_authorship {
my $co = shift;
my %opts = @_;
my $tag = $opts{-tag} || 'div';
my $author = $co->{'author_name'};
my %ad = parse_date($co->{'author_epoch'}, $co->{'author_tz'});
print "<$tag class=\"author_date\">" .
format_search_author($author, "author", esc_html($author)) .
" [".format_timestamp_html(\%ad)."]".
git_get_avatar($co->{'author_email'}, -pad_before => 1) .
"$tag>\n";
}
# Outputs table rows containing the full author or committer information,
# in the format expected for 'commit' view (& similar).
# Parameters are a commit hash reference, followed by the list of people
# to output information for. If the list is empty it defaults to both
# author and committer.
sub git_print_authorship_rows {
my $co = shift;
# too bad we can't use @people = @_ || ('author', 'committer')
my @people = @_;
@people = ('author', 'committer') unless @people;
foreach my $who (@people) {
my %wd = parse_date($co->{"${who}_epoch"}, $co->{"${who}_tz"});
print "
\n";
}
sub git_print_log {
my $log = shift;
my %opts = @_;
if ($opts{'-remove_title'}) {
# remove title, i.e. first line of log
shift @$log;
}
# remove leading empty lines
while (defined $log->[0] && $log->[0] eq "") {
shift @$log;
}
# print log
my $skip_blank_line = 0;
foreach my $line (@$log) {
if ($line =~ m/^\s*([A-Z][-A-Za-z]*-[Bb]y|C[Cc]): /) {
if (! $opts{'-remove_signoff'}) {
print "" . esc_html($line) . " \n";
$skip_blank_line = 1;
}
next;
}
if ($line =~ m,\s*([a-z]*link): (https?://\S+),i) {
if (! $opts{'-remove_signoff'}) {
print "" . esc_html($1) . ": " .
"" . esc_html($2) . "" .
" \n";
$skip_blank_line = 1;
}
next;
}
# print only one empty line
# do not print empty line after signoff
if ($line eq "") {
next if ($skip_blank_line);
$skip_blank_line = 1;
} else {
$skip_blank_line = 0;
}
print format_log_line_html($line) . " \n";
}
if ($opts{'-final_empty_line'}) {
# end with single empty line
print " \n" unless $skip_blank_line;
}
}
# return link target (what link points to)
sub git_get_link_target {
my $hash = shift;
my $link_target;
# read link
open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
or return;
{
local $/ = undef;
$link_target = <$fd>;
}
close $fd
or return;
return $link_target;
}
# given link target, and the directory (basedir) the link is in,
# return target of link relative to top directory (top tree);
# return undef if it is not possible (including absolute links).
sub normalize_link_target {
my ($link_target, $basedir) = @_;
# absolute symlinks (beginning with '/') cannot be normalized
return if (substr($link_target, 0, 1) eq '/');
# normalize link target to path from top (root) tree (dir)
my $path;
if ($basedir) {
$path = $basedir . '/' . $link_target;
} else {
# we are in top (root) tree (dir)
$path = $link_target;
}
# remove //, /./, and /../
my @path_parts;
foreach my $part (split('/', $path)) {
# discard '.' and ''
next if (!$part || $part eq '.');
# handle '..'
if ($part eq '..') {
if (@path_parts) {
pop @path_parts;
} else {
# link leads outside repository (outside top dir)
return;
}
} else {
push @path_parts, $part;
}
}
$path = join('/', @path_parts);
return $path;
}
# print tree entry (row of git_tree), but without encompassing
element
sub git_print_tree_entry {
my ($t, $basedir, $hash_base, $have_blame) = @_;
my %base_key = ();
$base_key{'hash_base'} = $hash_base if defined $hash_base;
# The format of a table row is: mode list link. Where mode is
# the mode of the entry, list is the name of the entry, an href,
# and link is the action links of the entry.
print "
\n";
}
}
## ......................................................................
## functions printing large fragments of HTML
# get pre-image filenames for merge (combined) diff
sub fill_from_file_info {
my ($diff, @parents) = @_;
$diff->{'from_file'} = [ ];
$diff->{'from_file'}[$diff->{'nparents'} - 1] = undef;
for (my $i = 0; $i < $diff->{'nparents'}; $i++) {
if ($diff->{'status'}[$i] eq 'R' ||
$diff->{'status'}[$i] eq 'C') {
$diff->{'from_file'}[$i] =
git_get_path_by_hash($parents[$i], $diff->{'from_id'}[$i]);
}
}
return $diff;
}
# is current raw difftree line of file deletion
sub is_deleted {
my $diffinfo = shift;
return $diffinfo->{'to_id'} eq ('0' x 40);
}
# does patch correspond to [previous] difftree raw line
# $diffinfo - hashref of parsed raw diff format
# $patchinfo - hashref of parsed patch diff format
# (the same keys as in $diffinfo)
sub is_patch_split {
my ($diffinfo, $patchinfo) = @_;
return defined $diffinfo && defined $patchinfo
&& $diffinfo->{'to_file'} eq $patchinfo->{'to_file'};
}
sub git_difftree_body {
my ($difftree, $hash, @parents) = @_;
my ($parent) = $parents[0];
my $have_blame = gitweb_check_feature('blame');
print "
\n";
next; # instead of 'else' clause, to avoid extra indent
}
# else ordinary diff
my ($to_mode_oct, $to_mode_str, $to_file_type);
my ($from_mode_oct, $from_mode_str, $from_file_type);
if ($diff->{'to_mode'} ne ('0' x 6)) {
$to_mode_oct = oct $diff->{'to_mode'};
if (S_ISREG($to_mode_oct)) { # only for regular file
$to_mode_str = sprintf("%04o", $to_mode_oct & 0777); # permission bits
}
$to_file_type = file_type($diff->{'to_mode'});
}
if ($diff->{'from_mode'} ne ('0' x 6)) {
$from_mode_oct = oct $diff->{'from_mode'};
if (S_ISREG($from_mode_oct)) { # only for regular file
$from_mode_str = sprintf("%04o", $from_mode_oct & 0777); # permission bits
}
$from_file_type = file_type($diff->{'from_mode'});
}
if ($diff->{'status'} eq "A") { # created
my $mode_chng = "[new $to_file_type";
$mode_chng .= " with mode: $to_mode_str" if $to_mode_str;
$mode_chng .= "]";
print "
";
if ($action eq 'commitdiff') {
# link to patch
$patchno++;
print $cgi->a({-href => href(-anchor=>"patch$patchno")},
"patch") .
" | ";
} elsif ($diff->{'to_id'} ne $diff->{'from_id'}) {
# "commit" view and modified file (not only pure rename or copy)
print $cgi->a({-href => href(action=>"blobdiff",
hash=>$diff->{'to_id'}, hash_parent=>$diff->{'from_id'},
hash_base=>$hash, hash_parent_base=>$parent,
file_name=>$diff->{'to_file'}, file_parent=>$diff->{'from_file'})},
"diff") .
" | ";
}
print $cgi->a({-href => href(action=>"blob", hash=>$diff->{'to_id'},
hash_base=>$parent, file_name=>$diff->{'to_file'})},
"blob") . " | ";
if ($have_blame) {
print $cgi->a({-href => href(action=>"blame", hash_base=>$hash,
file_name=>$diff->{'to_file'})},
"blame") . " | ";
}
print $cgi->a({-href => href(action=>"history", hash_base=>$hash,
file_name=>$diff->{'to_file'})},
"history");
print "
\n";
} # we should not encounter Unmerged (U) or Unknown (X) status
print "\n";
}
print "" if $has_header;
print "
\n";
}
# Print context lines and then rem/add lines in a side-by-side manner.
sub print_sidebyside_diff_lines {
my ($ctx, $rem, $add) = @_;
# print context block before add/rem block
if (@$ctx) {
print join '',
'
',
'
',
@$ctx,
'
',
'
',
@$ctx,
'
',
'
';
}
if (!@$add) {
# pure removal
print join '',
'
';
}
}
# Print context lines and then rem/add lines in inline manner.
sub print_inline_diff_lines {
my ($ctx, $rem, $add) = @_;
print @$ctx, @$rem, @$add;
}
# Format removed and added line, mark changed part and HTML-format them.
# Implementation is based on contrib/diff-highlight
sub format_rem_add_lines_pair {
my ($rem, $add, $num_parents) = @_;
# We need to untabify lines before split()'ing them;
# otherwise offsets would be invalid.
chomp $rem;
chomp $add;
$rem = untabify($rem);
$add = untabify($add);
my @rem = split(//, $rem);
my @add = split(//, $add);
my ($esc_rem, $esc_add);
# Ignore leading +/- characters for each parent.
my ($prefix_len, $suffix_len) = ($num_parents, 0);
my ($prefix_has_nonspace, $suffix_has_nonspace);
my $shorter = (@rem < @add) ? @rem : @add;
while ($prefix_len < $shorter) {
last if ($rem[$prefix_len] ne $add[$prefix_len]);
$prefix_has_nonspace = 1 if ($rem[$prefix_len] !~ /\s/);
$prefix_len++;
}
while ($prefix_len + $suffix_len < $shorter) {
last if ($rem[-1 - $suffix_len] ne $add[-1 - $suffix_len]);
$suffix_has_nonspace = 1 if ($rem[-1 - $suffix_len] !~ /\s/);
$suffix_len++;
}
# Mark lines that are different from each other, but have some common
# part that isn't whitespace. If lines are completely different, don't
# mark them because that would make output unreadable, especially if
# diff consists of multiple lines.
if ($prefix_has_nonspace || $suffix_has_nonspace) {
$esc_rem = esc_html_hl_regions($rem, 'marked',
[$prefix_len, @rem - $suffix_len], -nbsp=>1);
$esc_add = esc_html_hl_regions($add, 'marked',
[$prefix_len, @add - $suffix_len], -nbsp=>1);
} else {
$esc_rem = esc_html($rem, -nbsp=>1);
$esc_add = esc_html($add, -nbsp=>1);
}
return format_diff_line(\$esc_rem, 'rem'),
format_diff_line(\$esc_add, 'add');
}
# HTML-format diff context, removed and added lines.
sub format_ctx_rem_add_lines {
my ($ctx, $rem, $add, $num_parents) = @_;
my (@new_ctx, @new_rem, @new_add);
my $can_highlight = 0;
my $is_combined = ($num_parents > 1);
# Highlight if every removed line has a corresponding added line.
if (@$add > 0 && @$add == @$rem) {
$can_highlight = 1;
# Highlight lines in combined diff only if the chunk contains
# diff between the same version, e.g.
#
# - a
# - b
# + c
# + d
#
# Otherwise the highlightling would be confusing.
if ($is_combined) {
for (my $i = 0; $i < @$add; $i++) {
my $prefix_rem = substr($rem->[$i], 0, $num_parents);
my $prefix_add = substr($add->[$i], 0, $num_parents);
$prefix_rem =~ s/-/+/g;
if ($prefix_rem ne $prefix_add) {
$can_highlight = 0;
last;
}
}
}
}
if ($can_highlight) {
for (my $i = 0; $i < @$add; $i++) {
my ($line_rem, $line_add) = format_rem_add_lines_pair(
$rem->[$i], $add->[$i], $num_parents);
push @new_rem, $line_rem;
push @new_add, $line_add;
}
} else {
@new_rem = map { format_diff_line($_, 'rem') } @$rem;
@new_add = map { format_diff_line($_, 'add') } @$add;
}
@new_ctx = map { format_diff_line($_, 'ctx') } @$ctx;
return (\@new_ctx, \@new_rem, \@new_add);
}
# Print context lines and then rem/add lines.
sub print_diff_lines {
my ($ctx, $rem, $add, $diff_style, $num_parents) = @_;
my $is_combined = $num_parents > 1;
($ctx, $rem, $add) = format_ctx_rem_add_lines($ctx, $rem, $add,
$num_parents);
if ($diff_style eq 'sidebyside' && !$is_combined) {
print_sidebyside_diff_lines($ctx, $rem, $add);
} else {
# default 'inline' style and unknown styles
print_inline_diff_lines($ctx, $rem, $add);
}
}
sub print_diff_chunk {
my ($diff_style, $num_parents, $from, $to, @chunk) = @_;
my (@ctx, @rem, @add);
# The class of the previous line.
my $prev_class = '';
return unless @chunk;
# incomplete last line might be among removed or added lines,
# or both, or among context lines: find which
for (my $i = 1; $i < @chunk; $i++) {
if ($chunk[$i][0] eq 'incomplete') {
$chunk[$i][0] = $chunk[$i-1][0];
}
}
# guardian
push @chunk, ["", ""];
foreach my $line_info (@chunk) {
my ($class, $line) = @$line_info;
# print chunk headers
if ($class && $class eq 'chunk_header') {
print format_diff_line($line, $class, $from, $to);
next;
}
## print from accumulator when have some add/rem lines or end
# of chunk (flush context lines), or when have add and rem
# lines and new block is reached (otherwise add/rem lines could
# be reordered)
if (!$class || ((@rem || @add) && $class eq 'ctx') ||
(@rem && @add && $class ne $prev_class)) {
print_diff_lines(\@ctx, \@rem, \@add,
$diff_style, $num_parents);
@ctx = @rem = @add = ();
}
## adding lines to accumulator
# guardian value
last unless $line;
# rem, add or change
if ($class eq 'rem') {
push @rem, $line;
} elsif ($class eq 'add') {
push @add, $line;
}
# context line
if ($class eq 'ctx') {
push @ctx, $line;
}
$prev_class = $class;
}
}
sub git_patchset_body {
my ($fd, $diff_style, $difftree, $hash, @hash_parents) = @_;
my ($hash_parent) = $hash_parents[0];
my $is_combined = (@hash_parents > 1);
my $patch_idx = 0;
my $patch_number = 0;
my $patch_line;
my $diffinfo;
my $to_name;
my (%from, %to);
my @chunk; # for side-by-side diff
print "
\n";
# skip to first patch
while ($patch_line = <$fd>) {
chomp $patch_line;
last if ($patch_line =~ m/^diff /);
}
PATCH:
while ($patch_line) {
# parse "git diff" header line
if ($patch_line =~ m/^diff --git (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|[^ "]*) (.*)$/) {
# $1 is from_name, which we do not use
$to_name = unquote($2);
$to_name =~ s!^b/!!;
} elsif ($patch_line =~ m/^diff --(cc|combined) ("?.*"?)$/) {
# $1 is 'cc' or 'combined', which we do not use
$to_name = unquote($2);
} else {
$to_name = undef;
}
# check if current patch belong to current raw line
# and parse raw git-diff line if needed
if (is_patch_split($diffinfo, { 'to_file' => $to_name })) {
# this is continuation of a split patch
print "
\n";
} else {
# advance raw git-diff output if needed
$patch_idx++ if defined $diffinfo;
# read and prepare patch information
$diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
# compact combined diff output can have some patches skipped
# find which patch (using pathname of result) we are at now;
if ($is_combined) {
while ($to_name ne $diffinfo->{'to_file'}) {
print "
\n"; # class="patch"
$patch_idx++;
$patch_number++;
last if $patch_idx > $#$difftree;
$diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
}
}
# modifies %from, %to hashes
parse_from_to_diffinfo($diffinfo, \%from, \%to, @hash_parents);
# this is first patch for raw difftree line with $patch_idx index
# we index @$difftree array from 0, but number patches from 1
print "
\n"; # class="patch"
last PATCH;
}
next PATCH if ($patch_line =~ m/^diff /);
#assert($patch_line =~ m/^---/) if DEBUG;
my $last_patch_line = $patch_line;
$patch_line = <$fd>;
chomp $patch_line;
#assert($patch_line =~ m/^\+\+\+/) if DEBUG;
print format_diff_from_to_header($last_patch_line, $patch_line,
$diffinfo, \%from, \%to,
@hash_parents);
# the patch itself
LINE:
while ($patch_line = <$fd>) {
chomp $patch_line;
next PATCH if ($patch_line =~ m/^diff /);
my $class = diff_line_class($patch_line, \%from, \%to);
if ($class eq 'chunk_header') {
print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
@chunk = ();
}
push @chunk, [ $class, $patch_line ];
}
} continue {
if (@chunk) {
print_diff_chunk($diff_style, scalar @hash_parents, \%from, \%to, @chunk);
@chunk = ();
}
print "
\n"; # class="patch"
}
# for compact combined (--cc) format, with chunk and patch simplification
# the patchset might be empty, but there might be unprocessed raw lines
for (++$patch_idx if $patch_number > 0;
$patch_idx < @$difftree;
++$patch_idx) {
# read and prepare patch information
$diffinfo = parsed_difftree_line($difftree->[$patch_idx]);
# generate anchor for "patch" links in difftree / whatchanged part
print "
\n";
}
# entry for given @keys needs filling if at least one of keys in list
# is not present in %$project_info
sub project_info_needs_filling {
my ($project_info, @keys) = @_;
# return List::MoreUtils::any { !exists $project_info->{$_} } @keys;
foreach my $key (@keys) {
if (!exists $project_info->{$key}) {
return 1;
}
}
return;
}
# fills project list info (age, description, owner, category, forks, etc.)
# for each project in the list, removing invalid projects from
# returned list, or fill only specified info.
#
# Invalid projects are removed from the returned list if and only if you
# ask 'age' or 'age_string' to be filled, because they are the only fields
# that run unconditionally git command that requires repository, and
# therefore do always check if project repository is invalid.
#
# USAGE:
# * fill_project_list_info(\@project_list, 'descr_long', 'ctags')
# ensures that 'descr_long' and 'ctags' fields are filled
# * @project_list = fill_project_list_info(\@project_list)
# ensures that all fields are filled (and invalid projects removed)
#
# NOTE: modifies $projlist, but does not remove entries from it
sub fill_project_list_info {
my ($projlist, @wanted_keys) = @_;
my @projects;
my $filter_set = sub { return @_; };
if (@wanted_keys) {
my %wanted_keys = map { $_ => 1 } @wanted_keys;
$filter_set = sub { return grep { $wanted_keys{$_} } @_; };
}
my $show_ctags = gitweb_check_feature('ctags');
PROJECT:
foreach my $pr (@$projlist) {
if (project_info_needs_filling($pr, $filter_set->('age', 'age_string'))) {
my (@activity) = git_get_last_activity($pr->{'path'});
unless (@activity) {
next PROJECT;
}
($pr->{'age'}, $pr->{'age_string'}) = @activity;
}
if (project_info_needs_filling($pr, $filter_set->('descr', 'descr_long'))) {
my $descr = git_get_project_description($pr->{'path'}) || "";
$descr = to_utf8($descr);
$pr->{'descr_long'} = $descr;
$pr->{'descr'} = chop_str($descr, $projects_list_description_width, 5);
}
if (project_info_needs_filling($pr, $filter_set->('owner'))) {
$pr->{'owner'} = git_get_project_owner("$pr->{'path'}") || "";
}
if ($show_ctags &&
project_info_needs_filling($pr, $filter_set->('ctags'))) {
$pr->{'ctags'} = git_get_project_ctags($pr->{'path'});
}
if ($projects_list_group_categories &&
project_info_needs_filling($pr, $filter_set->('category'))) {
my $cat = git_get_project_category($pr->{'path'}) ||
$project_list_default_category;
$pr->{'category'} = to_utf8($cat);
}
push @projects, $pr;
}
return @projects;
}
sub sort_projects_list {
my ($projlist, $order) = @_;
sub order_str {
my $key = shift;
return sub { $a->{$key} cmp $b->{$key} };
}
sub order_num_then_undef {
my $key = shift;
return sub {
defined $a->{$key} ?
(defined $b->{$key} ? $a->{$key} <=> $b->{$key} : -1) :
(defined $b->{$key} ? 1 : 0)
};
}
my %orderings = (
project => order_str('path'),
descr => order_str('descr_long'),
owner => order_str('owner'),
age => order_num_then_undef('age'),
);
my $ordering = $orderings{$order};
return defined $ordering ? sort $ordering @$projlist : @$projlist;
}
# returns a hash of categories, containing the list of project
# belonging to each category
sub build_projlist_by_category {
my ($projlist, $from, $to) = @_;
my %categories;
$from = 0 unless defined $from;
$to = $#$projlist if (!defined $to || $#$projlist < $to);
for (my $i = $from; $i <= $to; $i++) {
my $pr = $projlist->[$i];
push @{$categories{ $pr->{'category'} }}, $pr;
}
return wantarray ? %categories : \%categories;
}
# print 'sort by'
element, generating 'sort by $name' replay link
# if that order is not selected
sub print_sort_th {
print format_sort_th(@_);
}
sub format_sort_th {
my ($name, $order, $header) = @_;
my $sort_th = "";
$header ||= ucfirst($name);
if ($order eq $name) {
$sort_th .= "
\n";
}
# Display a single remote block
sub git_remote_block {
my ($remote, $rdata, $limit, $head) = @_;
my $heads = $rdata->{'heads'};
my $fetch = $rdata->{'fetch'};
my $push = $rdata->{'push'};
my $urls_table = "
\n";
}
## ======================================================================
## ======================================================================
## actions
sub git_project_list {
my $order = $input_params{'order'};
if (defined $order && $order !~ m/none|project|descr|owner|age/) {
die_error(400, "Unknown order parameter");
}
my @list = git_get_projects_list($project_filter, $strict_export);
if (!@list) {
die_error(404, "No projects found");
}
git_header_html();
if (defined $home_text && -f $home_text) {
print "
\n";
insert_file($home_text);
print "
\n";
}
git_project_search_form($searchtext, $search_use_regexp);
git_project_list_body(\@list, $order);
git_footer_html();
}
sub git_forks {
my $order = $input_params{'order'};
if (defined $order && $order !~ m/none|project|descr|owner|age/) {
die_error(400, "Unknown order parameter");
}
my $filter = $project;
$filter =~ s/\.git$//;
my @list = git_get_projects_list($filter);
if (!@list) {
die_error(404, "No forks found");
}
git_header_html();
git_print_page_nav('','');
git_print_header_div('summary', "$project forks");
git_project_list_body(\@list, $order);
git_footer_html();
}
sub git_project_index {
my @projects = git_get_projects_list($project_filter, $strict_export);
if (!@projects) {
die_error(404, "No projects found");
}
print $cgi->header(
-type => 'text/plain',
-charset => 'utf-8',
-content_disposition => 'inline; filename="index.aux"');
foreach my $pr (@projects) {
if (!exists $pr->{'owner'}) {
$pr->{'owner'} = git_get_project_owner("$pr->{'path'}");
}
my ($path, $owner) = ($pr->{'path'}, $pr->{'owner'});
# quote as in CGI::Util::encode, but keep the slash, and use '+' for ' '
$path =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
$owner =~ s/([^a-zA-Z0-9_.\-\/ ])/sprintf("%%%02X", ord($1))/eg;
$path =~ s/ /\+/g;
$owner =~ s/ /\+/g;
print "$path $owner\n";
}
}
sub git_summary {
my $descr = git_get_project_description($project) || "none";
my %co = parse_commit("HEAD");
my %cd = %co ? parse_date($co{'committer_epoch'}, $co{'committer_tz'}) : ();
my $head = $co{'id'};
my $remote_heads = gitweb_check_feature('remote_heads');
my $owner = git_get_project_owner($project);
my $refs = git_get_references();
# These get_*_list functions return one more to allow us to see if
# there are more ...
my @taglist = git_get_tags_list(16);
my @headlist = git_get_heads_list(16);
my %remotedata = $remote_heads ? git_get_remotes_list() : ();
my @forklist;
my $check_forks = gitweb_check_feature('forks');
if ($check_forks) {
# find forks of a project
my $filter = $project;
$filter =~ s/\.git$//;
@forklist = git_get_projects_list($filter);
# filter out forks of forks
@forklist = filter_forks_from_projects_list(\@forklist)
if (@forklist);
}
git_header_html();
git_print_page_nav('summary','', $head);
print "
\n";
print "
\n" .
"
description
" . esc_html($descr) . "
\n";
if ($owner and not $omit_owner) {
print "
owner
" . esc_html($owner) . "
\n";
}
if (defined $cd{'rfc2822'}) {
print "
last change
" .
"
".format_timestamp_html(\%cd)."
\n";
}
# use per project git URL list in $projectroot/$project/cloneurl
# or make project git URL from git base URL and project name
my $url_tag = "URL";
my @url_list = git_get_project_url_list($project);
@url_list = map { "$_/$project" } @git_base_url_list unless @url_list;
foreach my $git_url (@url_list) {
next unless $git_url;
print format_repo_url($url_tag, $git_url);
$url_tag = "";
}
# Tag cloud
my $show_ctags = gitweb_check_feature('ctags');
if ($show_ctags) {
my $ctags = git_get_project_ctags($project);
if (%$ctags) {
# without ability to add tags, don't show if there are none
my $cloud = git_populate_project_tagcloud($ctags);
print "
" .
"
content tags
" .
"
".git_show_project_tagcloud($cloud, 48)."
" .
"
\n";
}
}
print "
\n";
# If XSS prevention is on, we don't include README.html.
# TODO: Allow a readme in some safe format.
if (!$prevent_xss && -s "$projectroot/$project/README.html") {
print "
\n";
git_footer_html();
}
sub git_blame_common {
my $format = shift || 'porcelain';
if ($format eq 'porcelain' && $input_params{'javascript'}) {
$format = 'incremental';
$action = 'blame_incremental'; # for page title etc
}
# permissions
gitweb_check_feature('blame')
or die_error(403, "Blame view not allowed");
# error checking
die_error(400, "No file name given") unless $file_name;
$hash_base ||= git_get_head_hash($project);
die_error(404, "Couldn't find base commit") unless $hash_base;
my %co = parse_commit($hash_base)
or die_error(404, "Commit not found");
my $ftype = "blob";
if (!defined $hash) {
$hash = git_get_hash_by_path($hash_base, $file_name, "blob")
or die_error(404, "Error looking up file");
} else {
$ftype = git_get_type($hash);
if ($ftype !~ "blob") {
die_error(400, "Object is not a blob");
}
}
my $fd;
if ($format eq 'incremental') {
# get file contents (as base)
open $fd, "-|", git_cmd(), 'cat-file', 'blob', $hash
or die_error(500, "Open git-cat-file failed");
} elsif ($format eq 'data') {
# run git-blame --incremental
open $fd, "-|", git_cmd(), "blame", "--incremental",
$hash_base, "--", $file_name
or die_error(500, "Open git-blame --incremental failed");
} else {
# run git-blame --porcelain
open $fd, "-|", git_cmd(), "blame", '-p',
$hash_base, '--', $file_name
or die_error(500, "Open git-blame --porcelain failed");
}
binmode $fd, ':utf8';
# incremental blame data returns early
if ($format eq 'data') {
print $cgi->header(
-type=>"text/plain", -charset => "utf-8",
-status=> "200 OK");
local $| = 1; # output autoflush
while (my $line = <$fd>) {
print to_utf8($line);
}
close $fd
or print "ERROR $!\n";
print 'END';
if (defined $t0 && gitweb_check_feature('timed')) {
print ' '.
tv_interval($t0, [ gettimeofday() ]).
' '.$number_of_git_cmds;
}
print "\n";
return;
}
# page header
git_header_html();
my $formats_nav =
$cgi->a({-href => href(action=>"blob", -replay=>1)},
"blob") .
" | ";
if ($format eq 'incremental') {
$formats_nav .=
$cgi->a({-href => href(action=>"blame", javascript=>0, -replay=>1)},
"blame") . " (non-incremental)";
} else {
$formats_nav .=
$cgi->a({-href => href(action=>"blame_incremental", -replay=>1)},
"blame") . " (incremental)";
}
$formats_nav .=
" | " .
$cgi->a({-href => href(action=>"history", -replay=>1)},
"history") .
" | " .
$cgi->a({-href => href(action=>$action, file_name=>$file_name)},
"HEAD");
git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
git_print_page_path($file_name, $ftype, $hash_base);
# page body
if ($format eq 'incremental') {
print "\n";
print qq!\n!;
}
print qq!
\n!;
print qq!
... / ...
\n!
if ($format eq 'incremental');
print qq!
\n!.
#qq!
\n!.
qq!\n!.
qq!
Commit
Line
Data
\n!.
qq!\n!.
qq!\n!;
my @rev_color = qw(light dark);
my $num_colors = scalar(@rev_color);
my $current_color = 0;
if ($format eq 'incremental') {
my $color_class = $rev_color[$current_color];
#contents of a file
my $linenr = 0;
LINE:
while (my $line = <$fd>) {
chomp $line;
$linenr++;
print qq!
\n"; # class="blame_body"
close $fd
or print "Reading blob failed\n";
git_footer_html();
}
sub git_blame {
git_blame_common();
}
sub git_blame_incremental {
git_blame_common('incremental');
}
sub git_blame_data {
git_blame_common('data');
}
sub git_tags {
my $head = git_get_head_hash($project);
git_header_html();
git_print_page_nav('','', $head,undef,$head,format_ref_views('tags'));
git_print_header_div('summary', $project);
my @tagslist = git_get_tags_list();
if (@tagslist) {
git_tags_body(\@tagslist);
}
git_footer_html();
}
sub git_heads {
my $head = git_get_head_hash($project);
git_header_html();
git_print_page_nav('','', $head,undef,$head,format_ref_views('heads'));
git_print_header_div('summary', $project);
my @headslist = git_get_heads_list();
if (@headslist) {
git_heads_body(\@headslist, $head);
}
git_footer_html();
}
# used both for single remote view and for list of all the remotes
sub git_remotes {
gitweb_check_feature('remote_heads')
or die_error(403, "Remote heads view is disabled");
my $head = git_get_head_hash($project);
my $remote = $input_params{'hash'};
my $remotedata = git_get_remotes_list($remote);
die_error(500, "Unable to get remote information") unless defined $remotedata;
unless (%$remotedata) {
die_error(404, defined $remote ?
"Remote $remote not found" :
"No remotes found");
}
git_header_html(undef, undef, -action_extra => $remote);
git_print_page_nav('', '', $head, undef, $head,
format_ref_views($remote ? '' : 'remotes'));
fill_remote_heads($remotedata);
if (defined $remote) {
git_print_header_div('remotes', "$remote remote for $project");
git_remote_block($remote, $remotedata->{$remote}, undef, $head);
} else {
git_print_header_div('summary', "$project remotes");
git_remotes_body($remotedata, undef, $head);
}
git_footer_html();
}
sub git_blob_plain {
my $type = shift;
my $expires;
if (!defined $hash) {
if (defined $file_name) {
my $base = $hash_base || git_get_head_hash($project);
$hash = git_get_hash_by_path($base, $file_name, "blob")
or die_error(404, "Cannot find file");
} else {
die_error(400, "No file name defined");
}
} elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
# blobs defined by non-textual hash id's can be cached
$expires = "+1d";
}
open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
or die_error(500, "Open git-cat-file blob '$hash' failed");
# content-type (can include charset)
$type = blob_contenttype($fd, $file_name, $type);
# "save as" filename, even when no $file_name is given
my $save_as = "$hash";
if (defined $file_name) {
$save_as = $file_name;
} elsif ($type =~ m/^text\//) {
$save_as .= '.txt';
}
# With XSS prevention on, blobs of all types except a few known safe
# ones are served with "Content-Disposition: attachment" to make sure
# they don't run in our security domain. For certain image types,
# blob view writes an tag referring to blob_plain view, and we
# want to be sure not to break that by serving the image as an
# attachment (though Firefox 3 doesn't seem to care).
my $sandbox = $prevent_xss &&
$type !~ m!^(?:text/[a-z]+|image/(?:gif|png|jpeg))(?:[ ;]|$)!;
# serve text/* as text/plain
if ($prevent_xss &&
($type =~ m!^text/[a-z]+\b(.*)$! ||
($type =~ m!^[a-z]+/[a-z]\+xml\b(.*)$! && -T $fd))) {
my $rest = $1;
$rest = defined $rest ? $rest : '';
$type = "text/plain$rest";
}
print $cgi->header(
-type => $type,
-expires => $expires,
-content_disposition =>
($sandbox ? 'attachment' : 'inline')
. '; filename="' . $save_as . '"');
local $/ = undef;
binmode STDOUT, ':raw';
print <$fd>;
binmode STDOUT, ':utf8'; # as set at the beginning of gitweb.cgi
close $fd;
}
sub git_blob {
my $expires;
if (!defined $hash) {
if (defined $file_name) {
my $base = $hash_base || git_get_head_hash($project);
$hash = git_get_hash_by_path($base, $file_name, "blob")
or die_error(404, "Cannot find file");
} else {
die_error(400, "No file name defined");
}
} elsif ($hash =~ m/^[0-9a-fA-F]{40}$/) {
# blobs defined by non-textual hash id's can be cached
$expires = "+1d";
}
my $have_blame = gitweb_check_feature('blame');
open my $fd, "-|", git_cmd(), "cat-file", "blob", $hash
or die_error(500, "Couldn't cat $file_name, $hash");
my $mimetype = blob_mimetype($fd, $file_name);
# use 'blob_plain' (aka 'raw') view for files that cannot be displayed
if ($mimetype !~ m!^(?:text/|image/(?:gif|png|jpeg)$)! && -B $fd) {
close $fd;
return git_blob_plain($mimetype);
}
# we can have blame only for text/* mimetype
$have_blame &&= ($mimetype =~ m!^text/!);
my $highlight = gitweb_check_feature('highlight');
my $syntax = guess_file_syntax($highlight, $file_name);
$fd = run_highlighter($fd, $highlight, $syntax);
git_header_html(undef, $expires);
my $formats_nav = '';
if (defined $hash_base && (my %co = parse_commit($hash_base))) {
if (defined $file_name) {
if ($have_blame) {
$formats_nav .=
$cgi->a({-href => href(action=>"blame", -replay=>1)},
"blame") .
" | ";
}
$formats_nav .=
$cgi->a({-href => href(action=>"history", -replay=>1)},
"history") .
" | " .
$cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
"raw") .
" | " .
$cgi->a({-href => href(action=>"blob",
hash_base=>"HEAD", file_name=>$file_name)},
"HEAD");
} else {
$formats_nav .=
$cgi->a({-href => href(action=>"blob_plain", -replay=>1)},
"raw");
}
git_print_page_nav('','', $hash_base,$co{'tree'},$hash_base, $formats_nav);
git_print_header_div('commit', esc_html($co{'title'}), $hash_base);
} else {
print "
";
git_footer_html();
}
sub git_tree {
if (!defined $hash_base) {
$hash_base = "HEAD";
}
if (!defined $hash) {
if (defined $file_name) {
$hash = git_get_hash_by_path($hash_base, $file_name, "tree");
} else {
$hash = $hash_base;
}
}
die_error(404, "No such tree") unless defined($hash);
my $show_sizes = gitweb_check_feature('show-sizes');
my $have_blame = gitweb_check_feature('blame');
my @entries = ();
{
local $/ = "\0";
open my $fd, "-|", git_cmd(), "ls-tree", '-z',
($show_sizes ? '-l' : ()), @extra_options, $hash
or die_error(500, "Open git-ls-tree failed");
@entries = map { chomp; $_ } <$fd>;
close $fd
or die_error(404, "Reading tree failed");
}
my $refs = git_get_references();
my $ref = format_ref_marker($refs, $hash_base);
git_header_html();
my $basedir = '';
if (defined $hash_base && (my %co = parse_commit($hash_base))) {
my @views_nav = ();
if (defined $file_name) {
push @views_nav,
$cgi->a({-href => href(action=>"history", -replay=>1)},
"history"),
$cgi->a({-href => href(action=>"tree",
hash_base=>"HEAD", file_name=>$file_name)},
"HEAD"),
}
my $snapshot_links = format_snapshot_links($hash);
if (defined $snapshot_links) {
# FIXME: Should be available when we have no hash base as well.
push @views_nav, $snapshot_links;
}
git_print_page_nav('tree','', $hash_base, undef, undef,
join(' | ', @views_nav));
git_print_header_div('commit', esc_html($co{'title'}) . $ref, $hash_base);
} else {
undef $hash_base;
print "
\n";
print "
\n";
print "
".esc_html($hash)."
\n";
}
if (defined $file_name) {
$basedir = $file_name;
if ($basedir ne '' && substr($basedir, -1) ne '/') {
$basedir .= '/';
}
git_print_page_path($file_name, 'tree', $hash_base);
}
print "
\n";
print "
\n";
my $alternate = 1;
# '..' (top directory) link if possible
if (defined $hash_base &&
defined $file_name && $file_name =~ m![^/]+$!) {
if ($alternate) {
print "
\n";
} else {
print "
\n";
}
$alternate ^= 1;
my $up = $file_name;
$up =~ s!/?[^/]+$!!;
undef $up unless $up;
# based on git_print_tree_entry
print '
\n"; # class="page_body"
git_footer_html();
} elsif ($format eq 'plain') {
local $/ = undef;
print <$fd>;
close $fd
or print "Reading git-diff-tree failed\n";
} elsif ($format eq 'patch') {
local $/ = undef;
print <$fd>;
close $fd
or print "Reading git-format-patch failed\n";
}
}
sub git_commitdiff_plain {
git_commitdiff(-format => 'plain');
}
# format-patch-style patches
sub git_patch {
git_commitdiff(-format => 'patch', -single => 1);
}
sub git_patches {
git_commitdiff(-format => 'patch');
}
sub git_history {
git_log_generic('history', \&git_history_body,
$hash_base, $hash_parent_base,
$file_name, $hash);
}
sub git_search {
$searchtype ||= 'commit';
# check if appropriate features are enabled
gitweb_check_feature('search')
or die_error(403, "Search is disabled");
if ($searchtype eq 'pickaxe') {
# pickaxe may take all resources of your box and run for several minutes
# with every query - so decide by yourself how public you make this feature
gitweb_check_feature('pickaxe')
or die_error(403, "Pickaxe search is disabled");
}
if ($searchtype eq 'grep') {
# grep search might be potentially CPU-intensive, too
gitweb_check_feature('grep')
or die_error(403, "Grep search is disabled");
}
if (!defined $searchtext) {
die_error(400, "Text field is empty");
}
if (!defined $hash) {
$hash = git_get_head_hash($project);
}
my %co = parse_commit($hash);
if (!%co) {
die_error(404, "Unknown commit object");
}
if (!defined $page) {
$page = 0;
}
if ($searchtype eq 'commit' ||
$searchtype eq 'author' ||
$searchtype eq 'committer') {
git_search_message(%co);
} elsif ($searchtype eq 'pickaxe') {
git_search_changes(%co);
} elsif ($searchtype eq 'grep') {
git_search_files(%co);
} else {
die_error(400, "Unknown search type");
}
}
sub git_search_help {
git_header_html();
git_print_page_nav('','', $hash,$hash,$hash);
print <Pattern is by default a normal string that is matched precisely (but without
regard to case, except in the case of pickaxe). However, when you check the re checkbox,
the pattern entered is recognized as the POSIX extended
regular expression (also case
insensitive).
commit
The commit messages and authorship information will be scanned for the given pattern.
EOT
my $have_grep = gitweb_check_feature('grep');
if ($have_grep) {
print <grep
All files in the currently selected tree (HEAD unless you are explicitly browsing
a different one) are searched for the given pattern. On large trees, this search can take
a while and put some strain on the server, so please use it with some consideration. Note that
due to git-grep peculiarity, currently if regexp mode is turned off, the matches are
case-sensitive.
EOT
}
print <author
Name and e-mail of the change author and date of birth of the patch will be scanned for the given pattern.
committer
Name and e-mail of the committer and date of commit will be scanned for the given pattern.
EOT
my $have_pickaxe = gitweb_check_feature('pickaxe');
if ($have_pickaxe) {
print <pickaxe
All commits that caused the string to appear or disappear from any file (changes that
added, removed or "modified" the string) will be listed. This search can take a while and
takes a lot of strain on the server, so please use it wisely. Note that since you may be
interested even in changes just changing the case as well, this search is case sensitive.
EOT
}
print "
\n";
git_footer_html();
}
sub git_shortlog {
git_log_generic('shortlog', \&git_shortlog_body,
$hash, $hash_parent);
}
## ......................................................................
## feeds (RSS, Atom; OPML)
sub git_feed {
my $format = shift || 'atom';
my $have_blame = gitweb_check_feature('blame');
# Atom: http://www.atomenabled.org/developers/syndication/
# RSS: http://www.notestips.com/80256B3A007F2692/1/NAMO5P9UPQ
if ($format ne 'rss' && $format ne 'atom') {
die_error(400, "Unknown web feed format");
}
# log/feed of current (HEAD) branch, log of given branch, history of file/directory
my $head = $hash || 'HEAD';
my @commitlist = parse_commits($head, 150, 0, $file_name);
my %latest_commit;
my %latest_date;
my $content_type = "application/$format+xml";
if (defined $cgi->http('HTTP_ACCEPT') &&
$cgi->Accept('text/xml') > $cgi->Accept($content_type)) {
# browser (feed reader) prefers text/xml
$content_type = 'text/xml';
}
if (defined($commitlist[0])) {
%latest_commit = %{$commitlist[0]};
my $latest_epoch = $latest_commit{'committer_epoch'};
exit_if_unmodified_since($latest_epoch);
%latest_date = parse_date($latest_epoch, $latest_commit{'committer_tz'});
}
print $cgi->header(
-type => $content_type,
-charset => 'utf-8',
%latest_date ? (-last_modified => $latest_date{'rfc2822'}) : (),
-status => '200 OK');
# Optimization: skip generating the body if client asks only
# for Last-Modified date.
return if ($cgi->request_method() eq 'HEAD');
# header variables
my $title = "$site_name - $project/$action";
my $feed_type = 'log';
if (defined $hash) {
$title .= " - '$hash'";
$feed_type = 'branch log';
if (defined $file_name) {
$title .= " :: $file_name";
$feed_type = 'history';
}
} elsif (defined $file_name) {
$title .= " - $file_name";
$feed_type = 'history';
}
$title .= " $feed_type";
$title = esc_html($title);
my $descr = git_get_project_description($project);
if (defined $descr) {
$descr = esc_html($descr);
} else {
$descr = "$project " .
($format eq 'rss' ? 'RSS' : 'Atom') .
" feed";
}
my $owner = git_get_project_owner($project);
$owner = esc_html($owner);
#header
my $alt_url;
if (defined $file_name) {
$alt_url = href(-full=>1, action=>"history", hash=>$hash, file_name=>$file_name);
} elsif (defined $hash) {
$alt_url = href(-full=>1, action=>"log", hash=>$hash);
} else {
$alt_url = href(-full=>1, action=>"summary");
}
print qq!\n!;
if ($format eq 'rss') {
print <
XML
print "$title\n" .
"$alt_url\n" .
"$descr\n" .
"en\n" .
# project owner is responsible for 'editorial' content
"$owner\n";
if (defined $logo || defined $favicon) {
# prefer the logo to the favicon, since RSS
# doesn't allow both
my $img = esc_url($logo || $favicon);
print "\n" .
"$img\n" .
"$title\n" .
"$alt_url\n" .
"\n";
}
if (%latest_date) {
print "$latest_date{'rfc2822'}\n";
print "$latest_date{'rfc2822'}\n";
}
print "gitweb v.$version/$git_version\n";
} elsif ($format eq 'atom') {
print <
XML
print "$title\n" .
"$descr\n" .
'' . "\n" .
'' . "\n" .
"" . href(-full=>1) . "\n" .
# use project owner for feed author
"$owner\n";
if (defined $favicon) {
print "" . esc_url($favicon) . "\n";
}
if (defined $logo) {
# not twice as wide as tall: 72 x 27 pixels
print "" . esc_url($logo) . "\n";
}
if (! %latest_date) {
# dummy date to keep the feed valid until commits trickle in:
print "1970-01-01T00:00:00Z\n";
} else {
print "$latest_date{'iso-8601'}\n";
}
print "gitweb\n";
}
# contents
for (my $i = 0; $i <= $#commitlist; $i++) {
my %co = %{$commitlist[$i]};
my $commit = $co{'id'};
# we read 150, we always show 30 and the ones more recent than 48 hours
if (($i >= 20) && ((time - $co{'author_epoch'}) > 48*60*60)) {
last;
}
my %cd = parse_date($co{'author_epoch'}, $co{'author_tz'});
# get list of changed files
open my $fd, "-|", git_cmd(), "diff-tree", '-r', @diff_opts,
$co{'parent'} || "--root",
$co{'id'}, "--", (defined $file_name ? $file_name : ())
or next;
my @difftree = map { chomp; $_ } <$fd>;
close $fd
or next;
# print element (entry, item)
my $co_url = href(-full=>1, action=>"commitdiff", hash=>$commit);
if ($format eq 'rss') {
print "\n" .
"" . esc_html($co{'title'}) . "\n" .
"" . esc_html($co{'author'}) . "\n" .
"$cd{'rfc2822'}\n" .
"$co_url\n" .
"$co_url\n" .
"" . esc_html($co{'title'}) . "\n" .
"" .
"\n" .
"" . esc_html($co{'title'}) . "\n" .
"$cd{'iso-8601'}\n" .
"\n" .
" " . esc_html($co{'author_name'}) . "\n";
if ($co{'author_email'}) {
print " " . esc_html($co{'author_email'}) . "\n";
}
print "\n" .
# use committer for contributor
"\n" .
" " . esc_html($co{'committer_name'}) . "\n";
if ($co{'committer_email'}) {
print " " . esc_html($co{'committer_email'}) . "\n";
}
print "\n" .
"$cd{'iso-8601'}\n" .
"\n" .
"$co_url\n" .
"\n" .
"
\n";
foreach my $difftree_line (@difftree) {
my %difftree = parse_difftree_raw_line($difftree_line);
next if !$difftree{'from_id'};
my $file = $difftree{'file'} || $difftree{'to_file'};
print "
" .
"[" .
$cgi->a({-href => href(-full=>1, action=>"blobdiff",
hash=>$difftree{'to_id'}, hash_parent=>$difftree{'from_id'},
hash_base=>$co{'id'}, hash_parent_base=>$co{'parent'},
file_name=>$file, file_parent=>$difftree{'from_file'}),
-title => "diff"}, 'D');
if ($have_blame) {
print $cgi->a({-href => href(-full=>1, action=>"blame",
file_name=>$file, hash_base=>$commit),
-title => "blame"}, 'B');
}
# if this is not a feed of a file history
if (!defined $file_name || $file_name ne $file) {
print $cgi->a({-href => href(-full=>1, action=>"history",
file_name=>$file, hash=>$commit),
-title => "history"}, 'H');
}
$file = esc_path($file);
print "] ".
"$file