funcs.pl (32fc6e3d) funcs.pl (1b3c3ba0)
1# $OpenBSD: funcs.pl,v 1.18 2015/01/05 22:41:37 bluhm Exp $
1# $OpenBSD: funcs.pl,v 1.19 2015/05/17 22:49:03 bluhm Exp $
2
2
3# Copyright (c) 2010-2014 Alexander Bluhm <bluhm@openbsd.org>
3# Copyright (c) 2010-2015 Alexander Bluhm <bluhm@openbsd.org>
4#
5# Permission to use, copy, modify, and distribute this software for any
6# purpose with or without fee is hereby granted, provided that the above
7# copyright notice and this permission notice appear in all copies.
8#
9# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR

--- 75 unchanged lines hidden (view full) ---

87sub http_client {
88 my $self = shift;
89
90 unless ($self->{lengths}) {
91 # only a single http request
92 my $len = shift // $self->{len} // 251;
93 my $cookie = $self->{cookie};
94 http_request($self, $len, "1.0", $cookie);
4#
5# Permission to use, copy, modify, and distribute this software for any
6# purpose with or without fee is hereby granted, provided that the above
7# copyright notice and this permission notice appear in all copies.
8#
9# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR

--- 75 unchanged lines hidden (view full) ---

87sub http_client {
88 my $self = shift;
89
90 unless ($self->{lengths}) {
91 # only a single http request
92 my $len = shift // $self->{len} // 251;
93 my $cookie = $self->{cookie};
94 http_request($self, $len, "1.0", $cookie);
95 http_response($self, $len);
95 return;
96 }
97
98 $self->{http_vers} ||= ["1.1", "1.0"];
99 my $vers = $self->{http_vers}[0];
100 my @lengths = @{$self->{redo}{lengths} || $self->{lengths}};
101 my @cookies = @{$self->{redo}{cookies} || $self->{cookies} || []};
102 while (defined (my $len = shift @lengths)) {
103 my $cookie = shift @cookies || $self->{cookie};
96 return;
97 }
98
99 $self->{http_vers} ||= ["1.1", "1.0"];
100 my $vers = $self->{http_vers}[0];
101 my @lengths = @{$self->{redo}{lengths} || $self->{lengths}};
102 my @cookies = @{$self->{redo}{cookies} || $self->{cookies} || []};
103 while (defined (my $len = shift @lengths)) {
104 my $cookie = shift @cookies || $self->{cookie};
104 eval { http_request($self, $len, $vers, $cookie) };
105 eval {
106 http_request($self, $len, $vers, $cookie);
107 http_response($self, $len);
108 };
105 warn $@ if $@;
106 if (@lengths && ($@ || $vers eq "1.0")) {
107 # reconnect and redo the outstanding requests
108 $self->{redo} = {
109 lengths => \@lengths,
110 cookies => \@cookies,
111 };
112 return;

--- 18 unchanged lines hidden (view full) ---

131 # encode the requested length or chunks into the url
132 my $path = ref($len) eq 'ARRAY' ? join("/", @$len) : $len;
133 # overwrite path with custom path
134 if (defined($self->{path})) {
135 $path = $self->{path};
136 }
137 my @request = ("$method /$path HTTP/$vers");
138 push @request, "Host: foo.bar" unless defined $header{Host};
109 warn $@ if $@;
110 if (@lengths && ($@ || $vers eq "1.0")) {
111 # reconnect and redo the outstanding requests
112 $self->{redo} = {
113 lengths => \@lengths,
114 cookies => \@cookies,
115 };
116 return;

--- 18 unchanged lines hidden (view full) ---

135 # encode the requested length or chunks into the url
136 my $path = ref($len) eq 'ARRAY' ? join("/", @$len) : $len;
137 # overwrite path with custom path
138 if (defined($self->{path})) {
139 $path = $self->{path};
140 }
141 my @request = ("$method /$path HTTP/$vers");
142 push @request, "Host: foo.bar" unless defined $header{Host};
139 push @request, "Content-Length: $len"
140 if $vers eq "1.1" && $method eq "PUT" &&
141 !defined $header{'Content-Length'};
143 if ($vers eq "1.1" && $method eq "PUT") {
144 if (ref($len) eq 'ARRAY') {
145 push @request, "Transfer-Encoding: chunked"
146 if !defined $header{'Transfer-Encoding'};
147 } else {
148 push @request, "Content-Length: $len"
149 if !defined $header{'Content-Length'};
150 }
151 }
142 foreach my $key (sort keys %header) {
143 my $val = $header{$key};
144 if (ref($val) eq 'ARRAY') {
145 push @request, "$key: $_"
146 foreach @{$val};
147 } else {
148 push @request, "$key: $val";
149 }
150 }
151 push @request, "Cookie: $cookie" if $cookie;
152 push @request, "";
153 print STDERR map { ">>> $_\n" } @request;
154 print map { "$_\r\n" } @request;
152 foreach my $key (sort keys %header) {
153 my $val = $header{$key};
154 if (ref($val) eq 'ARRAY') {
155 push @request, "$key: $_"
156 foreach @{$val};
157 } else {
158 push @request, "$key: $val";
159 }
160 }
161 push @request, "Cookie: $cookie" if $cookie;
162 push @request, "";
163 print STDERR map { ">>> $_\n" } @request;
164 print map { "$_\r\n" } @request;
155 write_char($self, $len) if $method eq "PUT";
165 if ($method eq "PUT") {
166 if (ref($len) eq 'ARRAY') {
167 if ($vers eq "1.1") {
168 write_chunked($self, @$len);
169 } else {
170 write_char($self, $_) foreach (@$len);
171 }
172 } else {
173 write_char($self, $len);
174 }
175 }
156 IO::Handle::flush(\*STDOUT);
157 # XXX client shutdown seems to be broken in relayd
158 #shutdown(\*STDOUT, SHUT_WR)
159 # or die ref($self), " shutdown write failed: $!"
160 # if $vers ne "1.1";
176 IO::Handle::flush(\*STDOUT);
177 # XXX client shutdown seems to be broken in relayd
178 #shutdown(\*STDOUT, SHUT_WR)
179 # or die ref($self), " shutdown write failed: $!"
180 # if $vers ne "1.1";
181}
161
182
183sub http_response {
184 my ($self, $len) = @_;
185 my $method = $self->{method} || "GET";
186
187 my $vers;
162 my $chunked = 0;
163 {
164 local $/ = "\r\n";
165 local $_ = <STDIN>;
166 defined
167 or die ref($self), " missing http $len response";
168 chomp;
169 print STDERR "<<< $_\n";
188 my $chunked = 0;
189 {
190 local $/ = "\r\n";
191 local $_ = <STDIN>;
192 defined
193 or die ref($self), " missing http $len response";
194 chomp;
195 print STDERR "<<< $_\n";
170 m{^HTTP/$vers 200 OK$}
196 m{^HTTP/(\d\.\d) 200 OK$}
171 or die ref($self), " http response not ok"
172 unless $self->{httpnok};
197 or die ref($self), " http response not ok"
198 unless $self->{httpnok};
199 $vers = $1;
173 while (<STDIN>) {
174 chomp;
175 print STDERR "<<< $_\n";
176 last if /^$/;
177 if (/^Content-Length: (.*)/) {
178 if ($self->{httpnok}) {
179 $len = $1;
180 } else {

--- 118 unchanged lines hidden (view full) ---

299 if ($method eq "PUT" &&
300 /^Content-Length: (.*)/) {
301 $1 == $len or die ref($self),
302 " bad content length $1";
303 }
304 $cookie ||= $1 if /^Cookie: (.*)/;
305 }
306 }
200 while (<STDIN>) {
201 chomp;
202 print STDERR "<<< $_\n";
203 last if /^$/;
204 if (/^Content-Length: (.*)/) {
205 if ($self->{httpnok}) {
206 $len = $1;
207 } else {

--- 118 unchanged lines hidden (view full) ---

326 if ($method eq "PUT" &&
327 /^Content-Length: (.*)/) {
328 $1 == $len or die ref($self),
329 " bad content length $1";
330 }
331 $cookie ||= $1 if /^Cookie: (.*)/;
332 }
333 }
307 # XXX reading to EOF does not work with relayd
308 #read_char($self, $vers eq "1.1" ? $len : undef)
309 read_char($self, $len)
310 if $method eq "PUT";
334 if ($method eq "PUT" ) {
335 if (ref($len) eq 'ARRAY') {
336 read_chunked($self);
337 } else {
338 read_char($self, $len);
339 }
340 }
311
312 my @response = ("HTTP/$vers 200 OK");
313 $len = defined($len) ? $len : scalar(split /|/,$url);
341
342 my @response = ("HTTP/$vers 200 OK");
343 $len = defined($len) ? $len : scalar(split /|/,$url);
314 if (ref($len) eq 'ARRAY') {
315 push @response, "Transfer-Encoding: chunked"
316 if $vers eq "1.1";
317 } else {
318 push @response, "Content-Length: $len"
319 if $vers eq "1.1" && $method eq "GET";
344 if ($vers eq "1.1" && $method eq "GET") {
345 if (ref($len) eq 'ARRAY') {
346 push @response, "Transfer-Encoding: chunked";
347 } else {
348 push @response, "Content-Length: $len";
349 }
320 }
321 foreach my $key (sort keys %header) {
322 my $val = $header{$key};
323 if (ref($val) eq 'ARRAY') {
324 push @response, "$key: $_"
325 foreach @{$val};
326 } else {
327 push @response, "$key: $val";
328 }
329 }
330 push @response, "Set-Cookie: $cookie" if $cookie;
331 push @response, "";
332
333 print STDERR map { ">>> $_\n" } @response;
334 print map { "$_\r\n" } @response;
335
350 }
351 foreach my $key (sort keys %header) {
352 my $val = $header{$key};
353 if (ref($val) eq 'ARRAY') {
354 push @response, "$key: $_"
355 foreach @{$val};
356 } else {
357 push @response, "$key: $val";
358 }
359 }
360 push @response, "Set-Cookie: $cookie" if $cookie;
361 push @response, "";
362
363 print STDERR map { ">>> $_\n" } @response;
364 print map { "$_\r\n" } @response;
365
336 if (ref($len) eq 'ARRAY') {
337 if ($vers eq "1.1") {
338 write_chunked($self, @$len);
366 if ($method eq "GET") {
367 if (ref($len) eq 'ARRAY') {
368 if ($vers eq "1.1") {
369 write_chunked($self, @$len);
370 } else {
371 write_char($self, $_) foreach (@$len);
372 }
339 } else {
373 } else {
340 write_char($self, $_) foreach (@$len);
374 write_char($self, $len);
341 }
375 }
342 } else {
343 write_char($self, $len) if $method eq "GET";
344 }
345 IO::Handle::flush(\*STDOUT);
346 } while ($vers eq "1.1");
347 $self->{redo}-- if $self->{redo};
348}
349
350sub write_chunked {
351 my $self = shift;

--- 18 unchanged lines hidden (view full) ---

370sub check_logs {
371 my ($c, $r, $s, %args) = @_;
372
373 return if $args{nocheck};
374
375 check_len($c, $r, $s, %args);
376 check_md5($c, $r, $s, %args);
377 check_loggrep($c, $r, $s, %args);
376 }
377 IO::Handle::flush(\*STDOUT);
378 } while ($vers eq "1.1");
379 $self->{redo}-- if $self->{redo};
380}
381
382sub write_chunked {
383 my $self = shift;

--- 18 unchanged lines hidden (view full) ---

402sub check_logs {
403 my ($c, $r, $s, %args) = @_;
404
405 return if $args{nocheck};
406
407 check_len($c, $r, $s, %args);
408 check_md5($c, $r, $s, %args);
409 check_loggrep($c, $r, $s, %args);
410 $r->loggrep("lost child")
411 and die "relayd lost child";
378}
379
380sub check_len {
381 my ($c, $r, $s, %args) = @_;
382
383 $args{len} ||= 251 unless $args{lengths};
384
385 my @clen = $c->loggrep(qr/^LEN: /) or die "no client len"

--- 80 unchanged lines hidden --- 		412}
413
414sub check_len {
415 my ($c, $r, $s, %args) = @_;
416
417 $args{len} ||= 251 unless $args{lengths};
418
419 my @clen = $c->loggrep(qr/^LEN: /) or die "no client len"

--- 80 unchanged lines hidden ---