/t/32-selector.t

http://github.com/perlbal/Perlbal · Perl · 162 lines · 114 code · 34 blank · 14 comment · 12 complexity · 0f873cfad41a9dd5ac2d82af93fadc2f MD5 · raw file

  1. #!/usr/bin/perl
  2. use strict;
  3. use Perlbal::Test;
  4. use Perlbal::Test::WebServer;
  5. use Perlbal::Test::WebClient;
  6. use Test::More tests => 38;
  7. # option setup
  8. my $start_servers = 2; # web servers to start
  9. # setup a few web servers that we can work with
  10. my @web_ports = map { start_webserver() } 1..$start_servers;
  11. @web_ports = grep { $_ > 0 } map { $_ += 0 } @web_ports;
  12. ok(scalar(@web_ports) == $start_servers, 'web servers started');
  13. # setup a simple perlbal that uses the above server
  14. my $dir = tempdir();
  15. my $pb_port = new_port();
  16. my $conf = qq{
  17. LOAD Vhosts
  18. CREATE POOL a
  19. CREATE SERVICE ss
  20. SET ss.listen = 127.0.0.1:$pb_port
  21. SET ss.role = selector
  22. SET ss.plugins = vhosts
  23. SET ss.persist_client = on
  24. VHOST ss proxy = pr
  25. VHOST ss webserver = ws
  26. VHOST ss *.webserver = ws
  27. VHOST ss manage = mgmt
  28. ENABLE ss
  29. CREATE SERVICE pr
  30. SET pr.role = reverse_proxy
  31. SET pr.persist_client = 1
  32. SET pr.persist_backend = 1
  33. SET pr.pool = a
  34. SET pr.connect_ahead = 0
  35. ENABLE pr
  36. CREATE SERVICE ws
  37. SET ws.role = web_server
  38. SET ws.docroot = $dir
  39. SET ws.dirindexing = 0
  40. SET ws.persist_client = 1
  41. SET ws.enable_put = 1
  42. SET ws.enable_delete = 1
  43. ENABLE ws
  44. };
  45. my $msock = start_server($conf);
  46. ok($msock, 'perlbal started');
  47. foreach (@web_ports) {
  48. manage("POOL a ADD 127.0.0.1:$_") or die;
  49. }
  50. # make first web client
  51. my $wc = Perlbal::Test::WebClient->new;
  52. $wc->server("127.0.0.1:$pb_port");
  53. $wc->keepalive(1);
  54. $wc->http_version('1.0');
  55. my $resp;
  56. # see if a single request works
  57. okay_status();
  58. is($wc->reqdone, 1, "one done");
  59. # put a file
  60. my $file_content = "foo bar yo this is my content.\n" x 1000;
  61. $resp = $wc->request({
  62. method => "PUT",
  63. content => $file_content,
  64. host => "webserver",
  65. }, 'foo.txt');
  66. ok($resp && $resp->code =~ /^2\d\d$/, "Good PUT");
  67. is($wc->reqdone, 2, "two done");
  68. # see if it made it
  69. ok(filecontent("$dir/foo.txt") eq $file_content, "file good via disk");
  70. okay_network();
  71. is($wc->reqdone, 3, "three done");
  72. # try a post
  73. my $blob = "x bar yo yo yeah\r\n\r\n" x 5000;
  74. my $bloblen = length $blob;
  75. $resp = $wc->request({
  76. method => "POST",
  77. content => $blob,
  78. host => "proxy",
  79. }, 'status');
  80. ok($resp && $resp->content =~ /^method = POST$/m && $resp->content =~ /^length = $bloblen$/m, "proxy post");
  81. is($wc->reqdone, 4, "four done");
  82. okay_network();
  83. is($wc->reqdone, 5, "five done");
  84. okay_status();
  85. is($wc->reqdone, 6, "six done");
  86. # test that persist_client is based on the selector service, not the selected service
  87. ok(manage("SET pr.persist_client = 0"), "pr.persist_client off");
  88. okay_status();
  89. is($wc->reqdone, 7, "seven done");
  90. okay_status();
  91. is($wc->reqdone, 8, "eight done");
  92. ok(manage("SET ss.persist_client = 0"), "ss.persist_client off");
  93. okay_status();
  94. is($wc->reqdone, 0, "zero done");
  95. ok(manage("SET ss.persist_client = 1"), "ss.persist_client on");
  96. okay_status();
  97. is($wc->reqdone, 1, "one done");
  98. ok(manage("SET pr.persist_client = 1"), "pr.persist_client on");
  99. # test the vhost matching
  100. $resp = $wc->request({ host => "foo.proxy" }, 'status');
  101. ok($resp && $resp->code =~ /^[45]/, "foo.proxy - bad");
  102. $resp = $wc->request({ host => "foo.webserver" }, 'foo.txt');
  103. ok($resp && $resp->code =~ /^2/, "foo.webserver - good") or diag(dump_res($resp));
  104. $resp = $wc->request({ host => "foo.bar.webserver" }, 'foo.txt');
  105. ok($resp && $resp->code =~ /^2/, "foo.bar.webserver - good");
  106. $resp = $wc->request({ host => "bob" }, 'foo.txt');
  107. ok($resp && $resp->code =~ /^[45]/, "bob - bad");
  108. ok(manage("VHOST ss * = ws"), "enabling a default");
  109. $resp = $wc->request({ host => "bob" }, 'foo.txt');
  110. ok($resp && $resp->code =~ /^2/, "bob - good");
  111. # test sending a request to a management service
  112. $resp = $wc->request({ host => "manage" }, 'foo');
  113. ok($resp && $resp->code =~ /^5/, "mapping to invalid service");
  114. # test some management commands (quiet_failure makes the test framework not warn when
  115. # these commands fail, since we expect them to)
  116. ok(! manage("VHOST ss * ws", quiet_failure => 1), "missing equals");
  117. ok(! manage("VHOST bad_service * = ws", quiet_failure => 1), "bad service");
  118. ok(! manage("VHOST ss *!sdfsdf = ws", quiet_failure => 1), "bad hostname");
  119. ok(! manage("VHOST ss * = ws!!sdf", quiet_failure => 1), "bad target");
  120. sub okay_status {
  121. my $resp = $wc->request({ host => "proxy" }, 'status');
  122. ok($resp && $resp->content =~ /\bpid\b/, 'status response ok') or diag(dump_res($resp));
  123. }
  124. sub okay_network {
  125. my $resp = $wc->request({ host => "webserver" }, 'foo.txt');
  126. ok($resp && $resp->content eq $file_content, 'file good via network') or diag(dump_res($resp));
  127. }
  128. 1;