lib/PublicInbox/GitHTTPDumb.pm

   1 # Copyright (C) 2016 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # when no endpoints match, fallback to this and serve a static file
   5 # This can serve Smart HTTP in the future.
   6 package PublicInbox::GitHTTPDumb;
   7 use strict;
   8 use warnings;
   9 use Fcntl qw(:seek);
  10
  11 # n.b. serving "description" and "cloneurl" should be innocuous enough to
  12 # not cause problems.  serving "config" might...
  13 my @text = qw[HEAD info/refs
  14         objects/info/(?:http-alternates|alternates|packs)
  15         cloneurl description];
  16
  17 my @binary = qw!
  18         objects/[a-f0-9]{2}/[a-f0-9]{38}
  19         objects/pack/pack-[a-f0-9]{40}\.(?:pack|idx)
  20         !;
  21
  22 our $ANY = join('|', @binary, @text);
  23 my $BIN = join('|', @binary);
  24 my $TEXT = join('|', @text);
  25
  26 sub r {
  27         [ $_[0] , [qw(Content-Type text/plain Content-Length 0) ], [] ]
  28 }
  29
  30 sub serve {
  31         my ($cgi, $git, $path) = @_;
  32         my $type;
  33         if ($path =~ /\A(?:$BIN)\z/o) {
  34                 $type = 'application/octet-stream';
  35         } elsif ($path =~ /\A(?:$TEXT)\z/o) {
  36                 $type = 'text/plain';
  37         } else {
  38                 return r(404);
  39         }
  40         my $f = "$git->{git_dir}/$path";
  41         return r(404) unless -f $f && -r _;
  42         my @st = stat(_);
  43         my $size = $st[7];
  44
  45         # TODO: If-Modified-Since and Last-Modified
  46         open my $in, '<', $f or return r(404);
  47         my $code = 200;
  48         my $len = $size;
  49         my @h;
  50
  51         my $env = $cgi->{env} || \%ENV;
  52         my $range = $env->{HTTP_RANGE};
  53         if (defined $range && $range =~ /\bbytes=(\d*)-(\d*)\z/) {
  54                 ($code, $len) = prepare_range($cgi, $in, \@h, $1, $2, $size);
  55                 if ($code == 416) {
  56                         push @h, 'Content-Range', "bytes */$size";
  57                         return [ 416, \@h, [] ];
  58                 }
  59         }
  60
  61         push @h, 'Content-Type', $type, 'Content-Length', $len;
  62         sub {
  63                 my ($res) = @_; # Plack callback
  64                 my $fh = $res->([ $code, \@h ]);
  65                 my $buf;
  66                 my $n = 8192;
  67                 while ($len > 0) {
  68                         $n = $len if $len < $n;
  69                         my $r = read($in, $buf, $n);
  70                         last if (!defined($r) || $r <= 0);
  71                         $len -= $r;
  72                         $fh->write($buf);
  73                 }
  74                 $fh->close;
  75         }
  76 }
  77
  78 sub prepare_range {
  79         my ($cgi, $in, $h, $beg, $end, $size) = @_;
  80         my $code = 200;
  81         my $len = $size;
  82         if ($beg eq '') {
  83                 if ($end ne '') { # "bytes=-$end" => last N bytes
  84                         $beg = $size - $end;
  85                         $beg = 0 if $beg < 0;
  86                         $end = $size - 1;
  87                         $code = 206;
  88                 } else {
  89                         $code = 416;
  90                 }
  91         } else {
  92                 if ($beg > $size) {
  93                         $code = 416;
  94                 } elsif ($end eq '' || $end >= $size) {
  95                         $end = $size - 1;
  96                         $code = 206;
  97                 } elsif ($end < $size) {
  98                         $code = 206;
  99                 } else {
 100                         $code = 416;
 101                 }
 102         }
 103         if ($code == 206) {
 104                 $len = $end - $beg + 1;
 105                 if ($len <= 0) {
 106                         $code = 416;
 107                 } else {
 108                         seek($in, $beg, SEEK_SET) or return [ 500, [], [] ];
 109                         push @$h, qw(Accept-Ranges bytes Content-Range);
 110                         push @$h, "bytes $beg-$end/$size";
 111
 112                         # FIXME: Plack::Middleware::Deflater bug?
 113                         if (my $env = $cgi->{env}) {
 114                                 $env->{'psgix.no-compress'} = 1;
 115                         }
 116                 }
 117         }
 118         ($code, $len);
 119 }
 120
 121 1;