about summary refs log tree commit homepage
diff options
context:
space:
mode:
-rw-r--r--lib/PublicInbox/Mbox.pm5
-rw-r--r--lib/PublicInbox/WwwStream.pm13
-rw-r--r--t/psgi_mount.t38
3 files changed, 50 insertions, 6 deletions
diff --git a/lib/PublicInbox/Mbox.pm b/lib/PublicInbox/Mbox.pm
index 6d902e6c..67b671f5 100644
--- a/lib/PublicInbox/Mbox.pm
+++ b/lib/PublicInbox/Mbox.pm
@@ -60,10 +60,12 @@ sub getline {
 
 sub close {} # noop
 
+# /$INBOX/$MESSAGE_ID/raw
 sub emit_raw {
         my ($ctx) = @_;
         my $mid = $ctx->{mid};
         my $ibx = $ctx->{-inbox};
+        $ctx->{base_url} = $ibx->base_url($ctx->{env});
         my ($mref, $more, $id, $prev, $next);
         if (my $over = $ibx->over) {
                 my $smsg = $over->next_by_mid($mid, \$id, \$prev) or return;
@@ -97,7 +99,7 @@ sub msg_hdr ($$;$) {
                 $header_obj->header_set($d);
         }
         my $ibx = $ctx->{-inbox};
-        my $base = $ibx->base_url($ctx->{env});
+        my $base = $ctx->{base_url};
         $mid = $ctx->{mid} unless defined $mid;
         $mid = mid_escape($mid);
         my @append = (
@@ -246,6 +248,7 @@ use PublicInbox::Hval qw/to_filename/;
 sub new {
         my ($class, $ctx, $cb) = @_;
         my $buf = '';
+        $ctx->{base_url} = $ctx->{-inbox}->base_url($ctx->{env});
         bless {
                 buf => \$buf,
                 gz => IO::Compress::Gzip->new(\$buf, Time => 0),
diff --git a/lib/PublicInbox/WwwStream.pm b/lib/PublicInbox/WwwStream.pm
index 7399b0ad..f5338c39 100644
--- a/lib/PublicInbox/WwwStream.pm
+++ b/lib/PublicInbox/WwwStream.pm
@@ -19,7 +19,15 @@ sub close {}
 
 sub new {
         my ($class, $ctx, $cb) = @_;
-        bless { nr => 0, cb => $cb || *close, ctx => $ctx }, $class;
+
+        my $base_url = $ctx->{-inbox}->base_url($ctx->{env});
+        chop $base_url; # no trailing slash for clone
+        bless {
+                nr => 0,
+                cb => $cb || *close,
+                ctx => $ctx,
+                base_url => $base_url,
+        }, $class;
 }
 
 sub response {
@@ -83,8 +91,7 @@ sub _html_end {
         my $desc = ascii_html($ibx->description);
 
         my (%seen, @urls);
-        my $http = $ibx->base_url($ctx->{env});
-        chop $http; # no trailing slash for clone
+        my $http = $self->{base_url};
         my $max = $ibx->max_git_epoch;
         my $dir = (split(m!/!, $http))[-1];
         if (defined($max)) { # v2
diff --git a/t/psgi_mount.t b/t/psgi_mount.t
index 05dbd736..8da2bc89 100644
--- a/t/psgi_mount.t
+++ b/t/psgi_mount.t
@@ -60,11 +60,24 @@ test_psgi($app, sub {
         unlike($res->content, qr!\b\Qhttp://[^/]+/test/\E!,
                 'No URLs which are not mount-aware');
 
-        # redirects
+        $res = $cb->(GET('/a/test/new.html'));
+        like($res->content, qr!git clone --mirror http://[^/]+/a/test\b!,
+                'clone URL in new.html is mount-aware');
+
         $res = $cb->(GET('/a/test/blah%40example.com/'));
         is($res->code, 200, 'OK with URLMap mount');
+        like($res->content, qr!git clone --mirror http://[^/]+/a/test\b!,
+                'clone URL in /$INBOX/$MESSAGE_ID/ is mount-aware');
+
         $res = $cb->(GET('/a/test/blah%40example.com/raw'));
         is($res->code, 200, 'OK with URLMap mount');
+        like($res->content, qr!^List-Archive: <http://[^/]+/a/test/>!m,
+                'List-Archive set in /raw mboxrd');
+        like($res->content,
+                qr!^Archived-At: <http://[^/]+/a/test/blah\@example\.com/>!m,
+                'Archived-At set in /raw mboxrd');
+
+        # redirects
         $res = $cb->(GET('/a/test/m/blah%40example.com.html'));
         is($res->header('Location'),
                 'http://localhost/a/test/blah@example.com/',
@@ -72,7 +85,28 @@ test_psgi($app, sub {
 
         $res = $cb->(GET('/test/blah%40example.com/'));
         is($res->code, 404, 'intentional 404 with URLMap mount');
-
 });
 
+SKIP: {
+        my @mods = qw(DBI DBD::SQLite Search::Xapian IO::Uncompress::Gunzip);
+        foreach my $mod (@mods) {
+                eval "require $mod" or skip "$mod not available: $@", 2;
+        }
+        my $ibx = $config->lookup_name('test');
+        PublicInbox::SearchIdx->new($ibx, 1)->index_sync;
+        test_psgi($app, sub {
+                my ($cb) = @_;
+                my $res = $cb->(GET('/a/test/blah@example.com/t.mbox.gz'));
+                my $gz = $res->content;
+                my $raw;
+                IO::Uncompress::Gunzip::gunzip(\$gz => \$raw);
+                like($raw, qr!^List-Archive: <http://[^/]+/a/test/>!m,
+                        'List-Archive set in /t.mbox.gz mboxrd');
+                like($raw,
+                        qr!^Archived-At:\x20
+                                <http://[^/]+/a/test/blah\@example\.com/>!mx,
+                        'Archived-At set in /t.mbox.gz mboxrd');
+        });
+}
+
 done_testing();