From ce95017bf16f7937013134fc5188900d3e2cd9c7 Mon Sep 17 00:00:00 2001 From: Reyk Floeter Date: Wed, 16 Aug 2017 09:27:36 +0200 Subject: sync --- regress/tests/funcs.pl | 182 ++++++++++++++++++++++--------------------------- 1 file changed, 83 insertions(+), 99 deletions(-) (limited to 'regress/tests/funcs.pl') 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 +# Copyright (c) 2010-2017 Alexander Bluhm # # 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 $_ = ; @@ -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 () { @@ -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 $_ = ; + local $_ = ; + defined or die ref($self), " missing boundary"; + chomp; + print STDERR "<<< $_\n"; + /^--$boundary(--)?$/ + or die ref($self), " boundary not found: $_"; + if (not $1) { + while () { + 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 $_ = ; - 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 () { - 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 { -- cgit v1.2.3-54-g00ecf