"tags" => \&git_tags,
"tree" => \&git_tree,
"snapshot" => \&git_snapshot,
+ "object" => \&git_object,
# those below don't need $project
"opml" => \&git_opml,
"project_list" => \&git_project_list,
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, $hash_base) = @_;
+
+ # we can normalize symlink target only if $hash_base is provided
+ return unless $hash_base;
+
+ # 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 <tr> element
sub git_print_tree_entry {
if (S_ISLNK(oct $t->{'mode'})) {
my $link_target = git_get_link_target($t->{'hash'});
if ($link_target) {
- print " -> " . esc_path($link_target);
+ my $norm_target = normalize_link_target($link_target, $basedir, $hash_base);
+ if (defined $norm_target) {
+ print " -> " .
+ $cgi->a({-href => href(action=>"object", hash_base=>$hash_base,
+ file_name=>$norm_target),
+ -title => $norm_target}, esc_path($link_target));
+ } else {
+ print " -> " . esc_path($link_target);
+ }
}
}
print "</td>\n";
git_footer_html();
}
+sub git_object {
+ # object is defined by:
+ # - hash or hash_base alone
+ # - hash_base and file_name
+ my $type;
+
+ # - hash or hash_base alone
+ if ($hash || ($hash_base && !defined $file_name)) {
+ my $object_id = $hash || $hash_base;
+
+ my $git_command = git_cmd_str();
+ open my $fd, "-|", "$git_command cat-file -t $object_id 2>/dev/null"
+ or die_error('404 Not Found', "Object does not exist");
+ $type = <$fd>;
+ chomp $type;
+ close $fd
+ or die_error('404 Not Found', "Object does not exist");
+
+ # - hash_base and file_name
+ } elsif ($hash_base && defined $file_name) {
+ $file_name =~ s,/+$,,;
+
+ system(git_cmd(), "cat-file", '-e', $hash_base) == 0
+ or die_error('404 Not Found', "Base object does not exist");
+
+ # here errors should not hapen
+ open my $fd, "-|", git_cmd(), "ls-tree", $hash_base, "--", $file_name
+ or die_error(undef, "Open git-ls-tree failed");
+ my $line = <$fd>;
+ close $fd;
+
+ #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
+ unless ($line && $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/) {
+ die_error('404 Not Found', "File or directory for given base does not exist");
+ }
+ $type = $2;
+ $hash = $3;
+ } else {
+ die_error('404 Not Found', "Not enough information to find object");
+ }
+
+ print $cgi->redirect(-uri => href(action=>$type, -full=>1,
+ hash=>$hash, hash_base=>$hash_base,
+ file_name=>$file_name),
+ -status => '302 Found');
+}
+
sub git_blobdiff {
my $format = shift || 'html';