/t/17-webserver-concat.t

 1#!/usr/bin/perl
 2
 3use strict;
 4use Perlbal::Test;
 5
 6use Test::More tests => 20;
 7require HTTP::Request;
 8
 9my $port = new_port();
10my $dir = tempdir();
11
12my $conf = qq{
13SERVER aio_mode = none
14
15CREATE SERVICE test
16SET test.role = web_server
17SET test.listen = 127.0.0.1:$port
18SET test.docroot = $dir
19SET test.dirindexing = 0
20SET test.persist_client = 1
21SET test.enable_concatenate_get = 1
22ENABLE test
23};
24
25my $http = "http://127.0.0.1:$port";
26
27my $msock = start_server($conf);
28ok($msock, "manage sock");
29my $ua = ua();
30ok($ua, "ua");
31
32sub set_disk {
33    my ($relpath, $contents) = @_;
34    open(F, ">$dir$relpath") or die "Couldn't open $dir$relpath: $!\n";
35    print F $contents;
36    close F;
37}
38
39our $last_res;
40sub get {
41    my $url = shift;
42    my $req = HTTP::Request->new(GET => $url);
43    my $res = $last_res = $ua->request($req);
44    return $res->is_success ? $res->content : undef;
45}
46
47# write two files to disk
48mkdir "$dir/foo";
49mkdir "$dir/foo/bar";
50my $chunk1 = "a" x 50 . "\n";
51my $chunk2 = "b" x 50 . "\n";
52set_disk("/foo/a.txt", $chunk1);
53set_disk("/foo/b.txt", $chunk2);
54set_disk("/foo/bar/a.txt", $chunk1);
55set_disk("/foo/bar/b.txt", $chunk2);
56
57# test trailing slash
58is(get("${http}/foo??a.txt,b.txt"), undef, "need trailing slash");
59is($last_res->code, 500, "got 500 without trailing slash");
60
61# test bogus directory
62is(get("${http}/bogus/??a.txt,b.txt"), undef, "bogus directory");
63is($last_res->code, 404, "got 404 for bogus directory");
64
65# test bogus file
66is(get("${http}/foo/??a.txt,bogus.txt"), undef, "bogus file");
67is($last_res->code, 404, "got 404 for bogus file");
68
69is(get("${http}/foo/??a.txt,b.txt"), "$chunk1$chunk2", "basic concat works");
70is(get("${http}/foo/??a.txt,bar/b.txt"), "$chunk1$chunk2", "concat w/ directory");
71is(get("${http}/foo/??a.txt,a.txt"), "$chunk1$chunk1", "dup concat");
72
73# test that if-modified-since 304 works and w/o a content-length
74{
75    my $req = HTTP::Request->new(GET => "${http}/foo/??a.txt,bar/b.txt");
76    my $res = $ua->request($req);
77    ok($res, "got response again");
78    my $lastmod = $res->header("Last-Modified");
79    like($lastmod, qr/\bGMT$/, "and it has a last modified");
80    $req = HTTP::Request->new(GET => "${http}/foo/??a.txt,bar/b.txt");
81    $req->header("If-Modified-Since" => $lastmod);
82
83    my $ua_keep = LWP::UserAgent->new(keep_alive => 2);
84    $res = $ua_keep->request($req);
85    ok($res, "got response again");
86    is($res->code, 304, "the response is a 304");
87    like($res->header("Last-Modified"), qr/\bGMT$/, "and it has a last modified");
88    ok(! $res->header("Content-Length"), "No content-length");
89    like($res->header("Connection"), qr/\bkeep-alive\b/, "and it's keep-alive");
90}
91
92manage("SET test.enable_concatenate_get = 0");
93is(get("${http}/foo/??a.txt,a.txt"), undef, "denied");
94is($last_res->code, 403, "got 403");
95
961;