/t/32-selector.t

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