/t/17-webserver-concat.t

http://github.com/perlbal/Perlbal · Perl · 96 lines · 72 code · 18 blank · 6 comment · 0 complexity · 415f585b3476ff2abe2be3a4ac6073cc MD5 · raw file

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