Directory listing for $name

use strict; use warnings; use IPC::Open2; package GitFileServer; use bytes; ## ## Some helper functions, not specific to git cat-file handling ## sub TRACE { my $fmt = shift; printf STDERR "[$$] $fmt\n", @_; } sub max { my ($a, $b) = @_; return $a if $a > $b; return $b; } sub min { my ($a, $b) = @_; return $a if $a < $b; return $b; } ## this is ripped out gitweb, it could obviously be improved/cached sub _mimetype { my $filename = shift; my $mimemap = '/etc/mime.types'; my %mimemap; open(MIME, $mimemap) or return undef; while () { next if m/^#/; # skip comments my ($mime, $exts) = split(/\t+/); if (defined $exts) { my @exts = split(/\s+/, $exts); foreach my $ext (@exts) { $mimemap{$ext} = $mime; } } } close(MIME); $filename =~ /\.([^.]*)$/; return $mimemap{$1}; } sub _html_dir { my ($name, @dir) = @_; my @output; push @output, "Content-type: text/html\n\n"; push @output, "\n"; push @output, " Directory listing for $name\n"; push @output, " \n"; push @output, " \n"; push @output, " \n"; while ($#dir > 0) { my $n = shift @dir; my $m = shift @dir; if ($m =~ m/^1/) { push @output, " \n"; } else { push @output, " \n"; } } push @output, "

	Name
[$m]	$n
[$m]	$n/

\n"; push @output, " "; push @output, "\n"; return @output; } ## ## And now our git cat-file handling stuff ## sub new { my $class = shift; my @args = @_; my %opts = (); my $self; if (defined $args[0]) { if ($#args % 2 != 1) { # Not a hash. $#args == 0 or die "Bad usage\n"; %opts = ( repo => $args[0] ); } else { %opts = @args; } } $self->{repo} = $opts{repo} || '.'; if (defined $opts{func_mimetype}) { $self->{func_mimetype} = $opts{func_mimetype}; } else { $self->{func_mimetype} = \&_mimetype; } if (defined $opts{func_dirlist}) { $self->{func_dirlist} = $opts{func_dirlist}; } else { $self->{func_dirlist} = \&_html_dir; } my ($r, $w); $self->{gitpid} = IPC::Open2::open2($r, $w, "git --git-dir=" . $self->{repo} . " cat-file --batch" ); $self->{reader} = $r; $self->{writer} = $w; bless $self, $class; } sub get { my $self = shift; my ($fh, $branch, $name) = @_; my ($got, $id, $type, $size); my $r = $self->{reader}; my $w = $self->{writer}; TRACE "WRITING to git-cat-file: %s:%s", $branch, $name; print $w "$branch:$name\n"; while (1) { $got = <$r>; chomp $got; last if $got; TRACE "PHANTOM READ from git-cat-file, repeating ..."; } ($id, $type, $size) = split / /, $got; TRACE "READ: %s %s %d [%d]", $id, $type, $size, length($got); if ($type eq 'blob') { $self->_do_blob($fh, $name, $size); } elsif ($type eq 'tree') { $self->_do_tree($fh, $name, $size); } else { TRACE "Unknown object"; return undef; } return 1; } sub _do_blob { my ($self, $fh, $name, $size) = @_; printf $fh "Content-type: %s\n", $self->{func_mimetype}($name); printf $fh "Content-Length: %d\n", $size; printf $fh "Content-Disposition: inline; filename=\"%s\"\n", $name; print $fh "\n"; my $r = $self->{reader}; my $buf; while ($size > 0) { my $len = min($size, 4096); read($r, $buf, $len); print $fh $buf; $size -= $len; } } sub _do_tree { my ($self, $fh, $name, $size) = @_; my $buffer; read($self->{reader}, $buffer, $size); my @d; while (length($buffer) > 0) { my ($string) = unpack "Z*", $buffer; my ($m, $n) = split / /, $string; push @d, $n; push @d, sprintf("%06d",$m); substr $buffer, 0, length($string)+21, ''; } print $fh $self->{func_dirlist}($name, @d); } sub _html_dir_unused { my $name = shift; my %dir = @_; print "\n"; print " Directory listing for $name\n"; print " \n"; print " \n"; print " \n"; foreach my $entry (keys %dir) { if ($dir{$entry} =~ m/^4/) { print " $name/$entry\n"; } elsif ($dir{$entry} =~ m/^100/) { print " $name/$entry\n"; } } print "

	Name

\n"; print " "; print "\n"; } 1;