File: torture-test

package info (click to toggle)
libhttp-headers-actionpack-perl 0.09-4
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 364 kB
  • sloc: perl: 2,614; makefile: 2
file content (82 lines) | stat: -rw-r--r-- 1,362 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
#!perl

use strict;
use warnings;

use lib 'lib';

use File::Find qw( find );
use HTTP::Headers;
use HTTP::Headers::ActionPack;

my $pack = HTTP::Headers::ActionPack->new();

find(
    {
        wanted   => \&process,
        no_chdir => 1,
    },
    'headers',
);

my $count = 0;
sub process {
    my $file = $_;
    return unless -f $_;

    $count++;

    open my $fh, '<', $file;

    # First line is the request itself, not headers
    scalar <$fh>;

    my @h;
    while (<$fh>) {
        last unless /\S/;
        $_ =~ s/[\r\n]//g;

        push @h, $_;
    }

    _check_inflate(\@h);

    warn "\nProcessed $count files\n"
        if $count % 1000 == 0;

    return;
}

sub _check_inflate {
    my $headers
        = HTTP::Headers->new( map { split /:\s*/, $_, 2 } @{ $_[0] } );

    my @warnings;

    my $e;
    {
        local $SIG{__WARN__} = sub { push @warnings, @_ };
        local $@;
        eval {
            my ( $name, $value ) = split /:\s*/, $_[0], 2;
            $pack->inflate($headers);
        };

        $e = $@;
    }

    if ($e) {
        warn "** Error **\n";
        warn "     $_\n" for @{ $_[0] };
        warn "\n";
        warn "     $e\n";
        warn "\n\n";
    }

    if (@warnings) {
        warn "** Warnings **\n";
        warn "     $_[0]\n";
        warn "     $_\n" for @warnings;
        warn "\n\n";
    }
}