Do not mix Perl read() with sysread(). Data could get stuck in the

buffered IO and test run-regress-args-get-1073741824.pl would fail
on slow hardware.  Introduce a common function read_part() that
uses Perl read().  Limit debug output to one line per 1% of data.
Remove unused function http_server().  Fix whitespace.  Cleanup
Makefile.

11 files changed, 47 insertions, 133 deletions

diff --git a/regress/usr.sbin/httpd/tests/LICENSE b/regress/usr.sbin/httpd/tests/LICENSE
index 8f60827e696..a5303a4f523 100644
--- a/regress/usr.sbin/httpd/tests/LICENSE
+++ b/regress/usr.sbin/httpd/tests/LICENSE
@@ -1,4 +1,4 @@
-# Copyright (c) 2010-2015 Alexander Bluhm <bluhm@openbsd.org>
+# Copyright (c) 2010-2017 Alexander Bluhm <bluhm@openbsd.org>
 # Copyright (c) 2014,2015 Reyk Floeter <reyk@openbsd.org>
 #
 # Permission to use, copy, modify, and distribute this software for any
diff --git a/regress/usr.sbin/httpd/tests/Makefile b/regress/usr.sbin/httpd/tests/Makefile
index fb93c9d74ee..1c5c1eca8fc 100644
--- a/regress/usr.sbin/httpd/tests/Makefile
+++ b/regress/usr.sbin/httpd/tests/Makefile
@@ -1,4 +1,4 @@
-#	$OpenBSD: Makefile,v 1.7 2017/01/30 21:18:24 reyk Exp $
+#	$OpenBSD: Makefile,v 1.8 2017/07/14 13:31:44 bluhm Exp $
 
 # The following ports must be installed for the regression tests:
 # p5-IO-Socket-INET6	object interface for AF_INET and AF_INET6 domain sockets
@@ -28,11 +28,10 @@ REGRESS_TARGETS =	${TARGETS:S/^/run-regress-/}
 CLEANFILES +=		*.log httpd.conf ktrace.out stamp-*
 CLEANFILES +=		*.pem *.req *.crt *.key *.srl md5-*
 
-HTDOCS =		${.OBJDIR}/htdocs
 HTDOCS_FILES =		512 1048576 1073741824
-HTDOCS_MD5 =		${HTDOCS_FILES:S/^/${.OBJDIR}\/md5-/}
+HTDOCS_MD5 =		${HTDOCS_FILES:S,^,md5-,}
 HTDOCS_SPARSE =		yes
-CLEANFILES +=		${HTDOCS_FILES:S/^/${HTDOCS}\//} ${HTDOCS}/*.log
+CLEANFILES +=		htdocs/*
 
 # Set variables so that make runs with and without obj directory.
 # Only do that if necessary to keep visible output short.
@@ -49,27 +48,25 @@ PERLPATH =	${.CURDIR}/
 # test parameters.  Generally they consist of client, httpd, server.
 
 .for a in ${ARGS}
-run-regress-$a: ${HTDOCS} $a ${HTDOCS_MD5}
+run-regress-$a: $a ${HTDOCS_MD5}
 	@echo '\n======== $@ ========'
 	time SUDO=${SUDO} KTRACE=${KTRACE} HTTPD=${HTTPD} perl ${PERLINC} ${PERLPATH}httpd.pl ${.OBJDIR} ${PERLPATH}$a
 .endfor
 
-# htdocs
-
-${HTDOCS}:
-	@mkdir -m 0755 -p ${HTDOCS}
+# populate htdocs
 
 .for d in ${HTDOCS_FILES}
-${HTDOCS}/$d:
+htdocs/$d:
 	@echo '\n======== file: $d ========'
+	mkdir -m 0755 -p ${@:H}
 .if (${HTDOCS_SPARSE} != "yes")
-	@dd if=/dev/arandom of=$@ count=$$(($d / 512)) bs=512
+	dd if=/dev/arandom of=$@ count=$$(($d / 512)) bs=512
 .else
-	@dd of=$@ seek=$$(($d / 512)) bs=512 count=0 status=none
+	dd of=$@ seek=$$(($d / 512)) bs=512 count=0 status=none
 .endif
 
-${.OBJDIR}/md5-$d: ${HTDOCS}/$d
-	@md5 -q ${HTDOCS}/$d > $@
+md5-$d: htdocs/$d
+	md5 -q htdocs/$d >$@
 .endfor
 
 # create certificates for TLS
diff --git a/regress/usr.sbin/httpd/tests/args-get-1048576.pl b/regress/usr.sbin/httpd/tests/args-get-1048576.pl
index 9253aec6cdc..fa06bba63e6 100644
--- a/regress/usr.sbin/httpd/tests/args-get-1048576.pl
+++ b/regress/usr.sbin/httpd/tests/args-get-1048576.pl
@@ -6,7 +6,7 @@ our %args = (
     client => {
 	path => "$len",
 	len => $len,
-        http_vers => [ "1.0" ],
+	http_vers => [ "1.0" ],
     },
     len => 1048576,
     md5 => path_md5("$len")
diff --git a/regress/usr.sbin/httpd/tests/args-get-1073741824.pl b/regress/usr.sbin/httpd/tests/args-get-1073741824.pl
index 2b4c5f41668..c27e00daaa7 100644
--- a/regress/usr.sbin/httpd/tests/args-get-1073741824.pl
+++ b/regress/usr.sbin/httpd/tests/args-get-1073741824.pl
@@ -6,7 +6,7 @@ my @lengths = ($len, $len);
 our %args = (
     client => {
 	path => "$len",
-        http_vers => [ "1.0" ],
+	http_vers => [ "1.0" ],
 	lengths => \@lengths,
     },
     md5 => path_md5("$len"),
diff --git a/regress/usr.sbin/httpd/tests/args-get-512.pl b/regress/usr.sbin/httpd/tests/args-get-512.pl
index 20e92c48889..6a0b79aa1f4 100644
--- a/regress/usr.sbin/httpd/tests/args-get-512.pl
+++ b/regress/usr.sbin/httpd/tests/args-get-512.pl
@@ -6,7 +6,7 @@ my @lengths = ($len, $len, $len);
 our %args = (
     client => {
 	path => "$len",
-        http_vers => [ "1.0" ],
+	http_vers => [ "1.0" ],
 	lengths => \@lengths,
     },
     md5 => path_md5("$len"),
diff --git a/regress/usr.sbin/httpd/tests/args-get-range-512.pl b/regress/usr.sbin/httpd/tests/args-get-range-512.pl
index 6247f2768b7..2bac65c47bd 100644
--- a/regress/usr.sbin/httpd/tests/args-get-range-512.pl
+++ b/regress/usr.sbin/httpd/tests/args-get-range-512.pl
@@ -6,7 +6,7 @@ my $path = 1048576;
 our %args = (
     client => {
 	path => $path,
-        http_vers => [ "1.1" ],
+	http_vers => [ "1.1" ],
 	code => "206 Partial Content",
 	header => {
 		"Range" => "bytes=0-511",
diff --git a/regress/usr.sbin/httpd/tests/args-get-range-multipart.pl b/regress/usr.sbin/httpd/tests/args-get-range-multipart.pl
index cd2abae0b6e..7f587377489 100644
--- a/regress/usr.sbin/httpd/tests/args-get-range-multipart.pl
+++ b/regress/usr.sbin/httpd/tests/args-get-range-multipart.pl
@@ -5,7 +5,7 @@ my $len = 512;
 our %args = (
     client => {
 	path => $len,
-        http_vers => [ "1.1" ],
+	http_vers => [ "1.1" ],
 	code => "206 Partial Content",
 	header => {
 		"Range" => "bytes=0-255,256-300,301-",
diff --git a/regress/usr.sbin/httpd/tests/args-get-slash.pl b/regress/usr.sbin/httpd/tests/args-get-slash.pl
index cd07569642b..e3e7a3bfc54 100644
--- a/regress/usr.sbin/httpd/tests/args-get-slash.pl
+++ b/regress/usr.sbin/httpd/tests/args-get-slash.pl
@@ -7,7 +7,7 @@ our %args = (
 	    my $self = shift;
 	    print "GET /\r\n\r\n";
 	},
-        nocheck => 1
+	nocheck => 1
     },
     httpd => {
 	loggrep => {
diff --git a/regress/usr.sbin/httpd/tests/args-tls-get-range-512.pl b/regress/usr.sbin/httpd/tests/args-tls-get-range-512.pl
index fad092cc1ab..47f41f277e7 100644
--- a/regress/usr.sbin/httpd/tests/args-tls-get-range-512.pl
+++ b/regress/usr.sbin/httpd/tests/args-tls-get-range-512.pl
@@ -6,7 +6,7 @@ my $path = 1048576;
 our %args = (
     client => {
 	path => $path,
-        http_vers => [ "1.1" ],
+	http_vers => [ "1.1" ],
 	code => "206 Partial Content",
 	header => {
 		"Range" => "bytes=0-511",
diff --git a/regress/usr.sbin/httpd/tests/args-tls-get-range-multipart.pl b/regress/usr.sbin/httpd/tests/args-tls-get-range-multipart.pl
index aa61904f378..13b3ef18c9c 100644
--- a/regress/usr.sbin/httpd/tests/args-tls-get-range-multipart.pl
+++ b/regress/usr.sbin/httpd/tests/args-tls-get-range-multipart.pl
@@ -5,7 +5,7 @@ my $len = 1048576;
 our %args = (
     client => {
 	path => $len,
-        http_vers => [ "1.1" ],
+	http_vers => [ "1.1" ],
 	code => "206 Partial Content",
 	header => {
 		"Range" => "bytes=0-255,256-10240,10241-",
diff --git a/regress/usr.sbin/httpd/tests/funcs.pl b/regress/usr.sbin/httpd/tests/funcs.pl
index 2707c144c19..fde38073467 100644
--- a/regress/usr.sbin/httpd/tests/funcs.pl
+++ b/regress/usr.sbin/httpd/tests/funcs.pl
@@ -1,6 +1,6 @@
-#	$OpenBSD: funcs.pl,v 1.7 2017/02/01 10:26:06 reyk 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
@@ -234,7 +234,6 @@ sub http_response {
 	} elsif ($chunked) {
 		read_chunked($self);
 	} else {
-		#$len = $vers eq "1.1" ? $len : undef;
 		read_char($self, $len)
 		    if $method eq "GET";
 	}
@@ -310,21 +309,7 @@ sub read_multipart {
 		}
 		last unless $part > 0;
 
-		my $max = $part;
-		my $rlen = POSIX::BUFSIZ;
-		my $r;
-		do {
-			if ($rlen > $max) {
-				$rlen = $max;
-			}
-			$r = read(STDIN, my $buf, $rlen);
-			last if not $r;
-			$_ = $buf;
-			$ctx->add($_);
-			$max = $max - $r;
-		} while ($max && $r == $rlen);
-
-		$len = $len + $part;
+		$len += read_part($self, $ctx, $part);
 	}
 
 	print STDERR "LEN: ", $len, "\n";
@@ -344,7 +329,7 @@ sub errignore {
 }
 
 ########################################################################
-# Server funcs
+# Common funcs
 ########################################################################
 
 sub read_char {
@@ -352,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($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 ($ctx, $max) = @_;
 
-		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 {