+ my $headers;
+
+ while ( my $header = <$sock> ) {
+ $request .= $header;
+ chomp $header;
+ last if $header =~ m{^\s*$};
+ my ( $n, $v ) = split(/:\s*/, $header);
+ $v =~ s/[\r\n]+$//;
+ $headers->{ lc $n } = $v;
+ }
+
+ warn "<<<< $ip START\n$request\n";
+
+ return $sock->connected unless $headers;
+
+ warn "missing $_ header\n" foreach grep { ! defined $headers->{ lc $_ } } ( 'SOAPAction' );
+
+ my $body;
+ if ( my $len = $headers->{'content-length'} ) {
+ read( $sock, $body, $len );
+ } elsif ( $headers->{'transfer-encoding'} =~ m/^chunked/i ) {
+ while ( my $len = <$sock> ) {
+ $len =~ s/[\r\n]+$//;
+ $len = hex($len);
+ last if $len == 0;
+ read( $sock, my $chunk, $len );
+ $body .= $chunk;
+ my $padding = <$sock>;
+ }
+ } else {
+ warn "empty request\n";
+ }