aboutsummaryrefslogtreecommitdiff
path: root/regress/tests/funcs.pl
diff options
context:
space:
mode:
Diffstat (limited to 'regress/tests/funcs.pl')
-rw-r--r--regress/tests/funcs.pl182
1 files changed, 83 insertions, 99 deletions
diff --git a/regress/tests/funcs.pl b/regress/tests/funcs.pl
index beda09a..fde3807 100644
--- a/regress/tests/funcs.pl
+++ b/regress/tests/funcs.pl
@@ -1,6 +1,6 @@
-# $OpenBSD: funcs.pl,v 1.6 2016/05/03 19:13:04 bluhm Exp $
+# $OpenBSD: funcs.pl,v 1.8 2017/07/14 13:31:44 bluhm Exp $
-# Copyright (c) 2010-2015 Alexander Bluhm <bluhm@openbsd.org>
+# Copyright (c) 2010-2017 Alexander Bluhm <bluhm@openbsd.org>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
@@ -188,9 +188,12 @@ sub http_request {
sub http_response {
my ($self, $len) = @_;
my $method = $self->{method} || "GET";
+ my $code = $self->{code} || "200 OK";
my $vers;
my $chunked = 0;
+ my $multipart = 0;
+ my $boundary;
{
local $/ = "\r\n";
local $_ = <STDIN>;
@@ -198,8 +201,8 @@ sub http_response {
or die ref($self), " missing http $len response";
chomp;
print STDERR "<<< $_\n";
- m{^HTTP/(\d\.\d) 200 OK$}
- or die ref($self), " http response not ok"
+ m{^HTTP/(\d\.\d) $code$}
+ or die ref($self), " http response not $code"
unless $self->{httpnok};
$vers = $1;
while (<STDIN>) {
@@ -207,7 +210,7 @@ sub http_response {
print STDERR "<<< $_\n";
last if /^$/;
if (/^Content-Length: (.*)/) {
- if ($self->{httpnok}) {
+ if ($self->{httpnok} or $self->{multipart}) {
$len = $1;
} else {
$1 == $len or die ref($self),
@@ -217,12 +220,20 @@ sub http_response {
if (/^Transfer-Encoding: chunked$/) {
$chunked = 1;
}
+ if (/^Content-Type: multipart\/byteranges; boundary=(.*)$/) {
+ $multipart = 1;
+ $boundary = $1;
+ }
}
}
- if ($chunked) {
+ die ref($self), " no multipart response"
+ if ($self->{multipart} && $multipart == 0);
+
+ if ($multipart) {
+ read_multipart($self, $boundary);
+ } elsif ($chunked) {
read_chunked($self);
} else {
- #$len = $vers eq "1.1" ? $len : undef;
read_char($self, $len)
if $method eq "GET";
}
@@ -265,6 +276,47 @@ sub read_chunked {
}
}
+sub read_multipart {
+ my $self = shift;
+ my $boundary = shift;
+ my $ctx = Digest::MD5->new();
+ my $len = 0;
+
+ for (;;) {
+ my $part = 0;
+ {
+ local $/ = "\r\n";
+ local $_ = <STDIN>;
+ local $_ = <STDIN>;
+ defined or die ref($self), " missing boundary";
+ chomp;
+ print STDERR "<<< $_\n";
+ /^--$boundary(--)?$/
+ or die ref($self), " boundary not found: $_";
+ if (not $1) {
+ while (<STDIN>) {
+ chomp;
+ if (/^Content-Length: (.*)/) {
+ $part = $1;
+ }
+ if (/^Content-Range: bytes (\d+)-(\d+)\/(\d+)$/) {
+ $part = $2 - $1 + 1;
+ }
+ print STDERR "<<< $_\n";
+ last if /^$/;
+ }
+ }
+ }
+ last unless $part > 0;
+
+ $len += read_part($self, $ctx, $part);
+ }
+
+ print STDERR "LEN: ", $len, "\n";
+ print STDERR "MD5: ", $ctx->hexdigest, "\n";
+
+}
+
sub errignore {
$SIG{PIPE} = 'IGNORE';
$SIG{__DIE__} = sub {
@@ -277,7 +329,7 @@ sub errignore {
}
########################################################################
-# Server funcs
+# Common funcs
########################################################################
sub read_char {
@@ -285,107 +337,39 @@ sub read_char {
my $max = shift // $self->{max};
my $ctx = Digest::MD5->new();
- my $len = 0;
- if (defined($max) && $max == 0) {
- print STDERR "Max\n";
- } else {
- while ((my $r = sysread(STDIN, my $buf, POSIX::BUFSIZ))) {
- my $pct;
- $_ = $buf;
- $len += $r;
- $ctx->add($_);
- $pct = ($len / $max) * 100.0;
- printf(STDERR "%.2f%%\n", $pct);
- if (defined($max) && $len >= $max) {
- print STDERR "\nMax";
- last;
- }
- }
- print STDERR "\n";
- }
+ my $len = read_part($self, $ctx, $max);
print STDERR "LEN: ", $len, "\n";
print STDERR "MD5: ", $ctx->hexdigest, "\n";
}
-sub http_server {
+sub read_part {
my $self = shift;
- my %header = %{$self->{header} || { Server => "Perl/".$^V }};
- my $cookie = $self->{cookie} || "";
+ my ($ctx, $max) = @_;
- my($method, $url, $vers);
- do {
- my $len;
- {
- local $/ = "\r\n";
- local $_ = <STDIN>;
- return unless defined $_;
- chomp;
- print STDERR "<<< $_\n";
- ($method, $url, $vers) = m{^(\w+) (.*) HTTP/(1\.[01])$}
- or die ref($self), " http request not ok";
- $method =~ /^(GET|PUT)$/
- or die ref($self), " unknown method: $method";
- ($len, my @chunks) = $url =~ /(\d+)/g;
- $len = [ $len, @chunks ] if @chunks;
- while (<STDIN>) {
- chomp;
- print STDERR "<<< $_\n";
- last if /^$/;
- if ($method eq "PUT" &&
- /^Content-Length: (.*)/) {
- $1 == $len or die ref($self),
- " bad content length $1";
- }
- $cookie ||= $1 if /^Cookie: (.*)/;
- }
- }
- if ($method eq "PUT" ) {
- if (ref($len) eq 'ARRAY') {
- read_chunked($self);
- } else {
- read_char($self, $len);
- }
- }
-
- my @response = ("HTTP/$vers 200 OK");
- $len = defined($len) ? $len : scalar(split /|/,$url);
- if ($vers eq "1.1" && $method eq "GET") {
- if (ref($len) eq 'ARRAY') {
- push @response, "Transfer-Encoding: chunked";
- } else {
- push @response, "Content-Length: $len";
- }
+ my $opct = 0;
+ my $len = 0;
+ for (;;) {
+ if (defined($max) && $len >= $max) {
+ print STDERR "Max\n";
+ last;
}
- foreach my $key (sort keys %header) {
- my $val = $header{$key};
- if (ref($val) eq 'ARRAY') {
- push @response, "$key: $_"
- foreach @{$val};
- } else {
- push @response, "$key: $val";
- }
+ my $rlen = POSIX::BUFSIZ;
+ if (defined($max) && $rlen > $max - $len) {
+ $rlen = $max - $len;
}
- push @response, "Set-Cookie: $cookie" if $cookie;
- push @response, "";
-
- print STDERR map { ">>> $_\n" } @response;
- print map { "$_\r\n" } @response;
-
- if ($method eq "GET") {
- if (ref($len) eq 'ARRAY') {
- if ($vers eq "1.1") {
- write_chunked($self, @$len);
- } else {
- write_char($self, $_) foreach (@$len);
- }
- } else {
- write_char($self, $len);
- }
+ defined(my $n = read(STDIN, my $buf, $rlen))
+ or die ref($self), " read failed: $!";
+ $n or last;
+ $len += $n;
+ $ctx->add($buf);
+ my $pct = ($len / $max) * 100.0;
+ if ($pct >= $opct + 1) {
+ printf(STDERR "%.2f%% $len/$max\n", $pct);
+ $opct = $pct;
}
- IO::Handle::flush(\*STDOUT);
- } while ($vers eq "1.1");
- $self->{redo}-- if $self->{redo};
+ }
+ return $len;
}
sub write_chunked {
7apu2bq3rhoylwmucxizk54afw5jyda7pho4j5zdcqpwkufke7zdzwad.onion