PageRenderTime 80ms CodeModel.GetById 20ms app.highlight 56ms RepoModel.GetById 1ms app.codeStats 0ms

/t/35-reproxy.t

http://github.com/perlbal/Perlbal
Perl | 222 lines | 181 code | 30 blank | 11 comment | 4 complexity | 20d8b3d6f8267bca11cb871c355b719f MD5 | raw file
  1#!/usr/bin/perl
  2
  3use strict;
  4use Perlbal::Test;
  5use Perlbal::Test::WebServer;
  6use Perlbal::Test::WebClient;
  7use Test::More 'no_plan';
  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 $webport = new_port();
 19my $dir = tempdir();
 20my $deadport = new_port();
 21
 22my $pb_port = new_port();
 23
 24my $conf = qq{
 25CREATE POOL a
 26
 27CREATE SERVICE test
 28SET test.role = reverse_proxy
 29SET test.listen = 127.0.0.1:$pb_port
 30SET test.persist_client = 1
 31SET test.persist_backend = 1
 32SET test.pool = a
 33SET test.connect_ahead = 0
 34SET test.enable_reproxy = 1
 35SET test.reproxy_cache_maxsize = 150
 36ENABLE test
 37
 38CREATE SERVICE ws
 39SET ws.role = web_server
 40SET ws.listen = 127.0.0.1:$webport
 41SET ws.docroot = $dir
 42SET ws.dirindexing = 0
 43SET ws.persist_client = 1
 44ENABLE ws
 45
 46};
 47
 48my $msock = start_server($conf);
 49ok($msock, 'perlbal started');
 50
 51add_all();
 52
 53# make first web client
 54my $wc = Perlbal::Test::WebClient->new;
 55$wc->server("127.0.0.1:$pb_port");
 56$wc->keepalive(1);
 57$wc->http_version('1.0');
 58
 59# see if a single request works
 60my $resp = $wc->request('status');
 61ok($resp, 'status response ok');
 62
 63# make a file on disk, verifying we can get it via disk/URL
 64my $file_content = "foo bar yo this is my content.\n" x 1000;
 65open(F, ">$dir/foo.txt");
 66print F $file_content;
 67close(F);
 68ok(filecontent("$dir/foo.txt") eq $file_content, "file good via disk");
 69{
 70    my $wc2 = Perlbal::Test::WebClient->new;
 71    $wc2->server("127.0.0.1:$webport");
 72    $wc2->keepalive(1);
 73    $wc2->http_version('1.0');
 74    $resp = $wc2->request('foo.txt');
 75    ok($resp && $resp->content eq $file_content, 'file good via network');
 76}
 77
 78# try to get that file, via internal file redirect
 79ok_reproxy_file();
 80ok_reproxy_file();
 81ok($wc->reqdone >= 2, "2 on same conn");
 82
 83# reproxy URL support
 84ok_reproxy_url();
 85ok_reproxy_url();
 86ok($wc->reqdone >= 4, "4 on same conn");
 87
 88# reproxy URL support, w/ 204s from backend
 89ok_reproxy_url_204();
 90ok_reproxy_url_204();
 91
 92# reproxy cache support
 93{
 94    my $sig_counter = 0;
 95    local $SIG{USR1} = sub  { $sig_counter++ };
 96
 97    is($sig_counter, 0, "Prior to first hit, counter should be zero.");
 98    ok_reproxy_url_cached("One");
 99    ok_reproxy_url_cached_ims("One");
100    is($sig_counter, 1, "First hit to populate the cache.");
101    ok_reproxy_url_cached("Two");
102    ok_reproxy_url_cached_ims("Two");
103    is($sig_counter, 1, "Second hit should be cached.");
104    sleep 2;
105    is($sig_counter, 1, "Prior to third hit, counter should still be 1.");
106    ok_reproxy_url_cached("Three");
107    ok_reproxy_url_cached_ims("Three");
108    is($sig_counter, 2, "Third hit isn't cached, now 2.");
109    ok_reproxy_url_cached("Four");
110    ok_reproxy_url_cached_ims("Four");
111    is($sig_counter, 2, "Forth hit should be cached again, still 2.");
112}
113
114# back and forth every combo
115#  FROM / TO:  status  file  url
116#  status        X      X    X
117#  file          X      X    X
118#  url           X      X    X
119foreach_aio {
120    my $mode = shift;
121
122    ok_status();
123    ok_status();
124    ok_reproxy_file();
125    ok_reproxy_url();
126    ok_status();
127    ok_reproxy_url();
128    ok_reproxy_url();
129    ok_reproxy_file();
130    ok_reproxy_file();
131    ok_reproxy_url();
132    ok_reproxy_file();
133    ok_status();
134    ok($wc->reqdone >= 12, "AIO mode $mode: 9 transitions");
135};
136
137# try to reproxy to a list of URLs, where the first one is bogus, and last one is good
138ok_reproxy_url_list();
139
140{
141    my $resp = $wc->request("reproxy_url:http://127.0.0.1:$webport/bar.txt http://127.0.0.1:$webport/foo.txt");
142    ok($resp->content eq $file_content, "reproxy URL w/ 404 one first");
143}
144
145# responses to HEAD requests should not have a body
146{
147    $wc->keepalive(0);
148    my $resp = $wc->request({
149        method => "HEAD",
150    }, "reproxy_url:http://127.0.0.1:$webport/foo.txt");
151    ok($resp && $resp->content eq '', "no response body when req method is HEAD");
152    $wc->keepalive(1);
153}
154
155my $lm;
156
157sub ok_reproxy_url_cached {
158    my $resp = $wc->request("reproxy_url_cached:1:http://127.0.0.1:$webport/foo.txt");
159    ok($resp && $resp->content eq $file_content, "reproxy with cache: $_[0]");
160    like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
161    $lm = $resp->header("Last-Modified");
162}
163
164sub ok_reproxy_url_cached_ims {
165    die "Last-Modified hasn't been set yet" unless defined $lm;
166    my $resp = $wc->request({ headers => "If-Modified-Since: $lm\r\n", }, "reproxy_url_cached:1:http://127.0.0.1:$webport/foo.txt");
167    ok($resp, "Got a response");
168    is($resp->code, 304, "reproxy with cache ims, got 304 correctly: $_[0]");
169    like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
170}
171
172sub ok_reproxy_url_list {
173    my $resp = $wc->request("reproxy_url_multi:$deadport:$webport:/foo.txt");
174    ok($resp->content eq $file_content, "reproxy URL w/ dead one first");
175    like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
176}
177
178sub ok_reproxy_file {
179    my $resp = $wc->request("reproxy_file:$dir/foo.txt");
180    ok($resp && $resp->content eq $file_content, "reproxy file");
181    like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
182}
183
184sub ok_reproxy_url {
185    my $resp = $wc->request("reproxy_url:http://127.0.0.1:$webport/foo.txt");
186    ok($resp->content eq $file_content, "reproxy URL") or diag(dump_res($resp));
187    is($resp->code, 200, "response code is 200");
188    like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
189}
190
191sub ok_reproxy_url_204 {
192    my $resp = $wc->request("reproxy_url204:http://127.0.0.1:$webport/foo.txt");
193    ok($resp->content eq $file_content, "reproxy URL") or diag(dump_res($resp));
194    is($resp->code, 200, "204 response code is 200");
195    like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
196}
197
198sub ok_status {
199    my $resp = $wc->request('status');
200    ok($resp && $resp->content =~ /\bpid\b/, 'status ok');
201}
202
203sub add_all {
204    foreach (@web_ports) {
205        manage("POOL a ADD 127.0.0.1:$_") or die;
206    }
207}
208
209sub remove_all {
210    foreach (@web_ports) {
211        manage("POOL a REMOVE 127.0.0.1:$_") or die;
212    }
213}
214
215sub flush_pools {
216    remove_all();
217    add_all();
218}
219
220
221
2221;