bottleneck testcase based on rubbos
[bottlenecks.git] / rubbos / app / httpd-2.0.64 / test / check_chunked
1 #!/usr/bin/perl -w
2 #
3 # Licensed to the Apache Software Foundation (ASF) under one or more
4 # contributor license agreements.  See the NOTICE file distributed with
5 # this work for additional information regarding copyright ownership.
6 # The ASF licenses this file to You under the Apache License, Version 2.0
7 # (the "License"); you may not use this file except in compliance with
8 # the License.  You may obtain a copy of the License at
9 #
10 #     http://www.apache.org/licenses/LICENSE-2.0
11 #
12 # Unless required by applicable law or agreed to in writing, software
13 # distributed under the License is distributed on an "AS IS" BASIS,
14 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 # See the License for the specific language governing permissions and
16 # limitations under the License.
17 #
18 #
19 # This is meant to be used on the raw output of an HTTP/1.1 connection
20 # to check that the chunks are all correctly laid out.  It's easiest
21 # to use a tool like netcat to generate the output.  This script
22 # *insists* that \r exist in the output.
23 #
24 # You can find netcat at avian.org:/src/hacks/nc110.tgz.
25
26 use strict;
27
28 my $is_chunked = 0;
29
30 # must toss headers
31 while(<>) {
32     if (/^Transfer-Encoding:\s+chunked/i) {
33         $is_chunked = 1;
34     }
35     last if ($_ eq "\r\n");
36 }
37
38 $is_chunked || die "wasn't chunked\n";
39
40 for(;;) {
41     $_ = <> || die "unexpected end of file!\n";
42
43     m#^([0-9a-f]+) *\r$#i || die "bogus chunklen: $_";
44
45     my $chunklen = hex($1);
46
47     exit 0 if ($chunklen == 0);
48
49     chop; chop;
50     print "$_ ";
51
52     my $data = '';
53     read(ARGV, $data, $chunklen) == $chunklen || die "short read!\n";
54
55     $_ = <> || die "unexpected end of file!\n";
56
57     $_ eq "\r\n" || die "missing chunk trailer!\n";
58 }