[PATCH] FIFO header order support in HTTP::Headers
Michael Greb <[email protected]>
| Newsgroups | gmane.comp.lang.perl.modules.lwp |
|---|---|
| Message-ID | <[email protected]> |
Greetings,
We are currently using HTTP::Daemon to prototype a project and have a
need to access headers in the order they were sent over the network.
Our particular use case is cryptographically signing a subset of the
headers and sending this signature as an additional header.
A specified set of headers are to be included in the signature if
present in the request. We join the content of these headers (with
"\n") then calculate the expected signature and compare it to the
value submitted by the client. In order to get the same signature, we
must join the header content in the same order as the client. If we
only needed to support perl clients using LWP::UserAgent, this
wouldn't be an issue as HTTP::Daemon and LWP::UserAgent both use
HTTP::Headers and the order the headers will be presented to the
consuming script is predictable. Unfortunately, we must support
multiple languages.
The HTTP client is allowed to join the headers in preparation for
signing in any order it wishes so long as it then sends the headers in
the same order over the network. The attached patch stores the order
headers are added to the HTTP::Headers object in an arrayref ($self-
>{_wire_order}). The header_field_names and scan methods are
extended to take an optional value that if present and true cause the
headers to be returned/visited based on the order of elements in $self-
>{_wire_order} rather than the existing 'best practices' order. The
next logical step would be similar extension to the as_string method.
This code has been tested and, thanks to great tests, I was able to
catch missing the clear method in my first go at the functionality.
All tests currently pass except for a few[1] that seem to be related
to the new run_handler method[2]. I'm a bit unsure that the push
within the _header method does the right thing in all cases
(particularly adding an additional value to an existing header and
replacing an existing header with a new value).
This patch does include an update to the relevant docs but does not
include new tests. Should the functionality be deemed useful for
inclusion in libwww-perl I can go ahead and extend the as_string
method and add some new tests to match the new functionality.
[1]
Failed Test Stat Wstat Total Fail Failed List of Failed
-------------------------------------------------------------------------------
local/get.t 2 2 100.00% 1-2
local/http-get.t 21 4 19.05% 5-6 19-20
local/http.t 18 1 5.56% 5
I spent a bit of time investigating this and it seems the callback
coderef LWP::Simple::getprint() does not receive the arguments it
expects:
carrotcake:lwp mgreb$ /usr/bin/perl -I./lib -MLWP::Simple -e
'getprint("http://google.com")'
P
HASH(0x8d77c0)P
HASH(0x8c502c)P
HASH(0x8e0a3c)P
[2] commit c554ba9ec3f95e7632df6d5ddcdad3a929cf4556
Mike
--
Michael Greb
Linode.com
609-593-7103 ext 1205
0001-FIFO-header-order-support-in-HTTP-Headers.patch
(application/octet-stream, 3 KB)
From 7b0d75122bcd25a81086d5fe93fc6abf35f4ebf6 Mon Sep 17 00:00:00 2001 From: Michael Greb <[email protected]> Date: Thu, 4 Sep 2008 10:30:18 -0400 Subject: [PATCH] FIFO header order support in HTTP::Headers --- lib/HTTP/Headers.pm | 29 +++++++++++++++++++++++------ 1 files changed, 23 insertions(+), 6 deletions(-) diff --git a/lib/HTTP/Headers.pm b/lib/HTTP/Headers.pm index 8e1e9c1..a50d220 100644 --- a/lib/HTTP/Headers.pm +++ b/lib/HTTP/Headers.pm @@ -67,6 +67,7 @@ sub new { my($class) = shift; my $self = bless {}, $class; + $self->{_wire_order} = []; $self->header(@_) if @_; # set up initial headers $self; } @@ -91,7 +92,7 @@ sub header sub clear { my $self = shift; - %$self = (); + %$self = (_wire_order => []); } @@ -171,9 +172,11 @@ sub _header push(@new, @$val); } $self->{$field} = @new > 1 ? \@new : $new[0]; + push @{$self->{_wire_order}}, $field; } elsif ($op ne 'PUSH') { delete $self->{$field}; + @{$self->{_wire_order}} = grep !/\Q$field\E/, @{$self->{_wire_order}}; } } @old; @@ -192,17 +195,21 @@ sub _sorted_field_names sub header_field_names { my $self = shift; - return map $standard_case{$_} || $_, $self->_sorted_field_names - if wantarray; - return keys %$self; + return @{$self->{_wire_order}} unless wantarray; + if (shift) { + return map $standard_case{$_} || $_, @{$self->{_wire_order}}; + } + else { + return map { $_ =~ /^_/ ? () : $standard_case{$_} || $_ } $self->_sorted_field_names; + } } sub scan { - my($self, $sub) = @_; + my($self, $sub, $no_sort) = @_; my $key; - foreach $key ($self->_sorted_field_names) { + foreach $key ($no_sort ? @{$self->{_wire_order}} : $self->_sorted_field_names) { next if $key =~ /^_/; my $vals = $self->{$key}; if (ref($vals) eq 'ARRAY') { @@ -503,14 +510,21 @@ This will remove all header fields. =item $h->header_field_names +=item $h->header_field_names( $dont_sort ) + Returns the list of distinct names for the fields present in the header. The field names have case as suggested by HTTP spec, and the names are returned in the recommended "Good Practice" order. +The optional $dont_sort parameter specifies that field names are to be +returned in the order they were seen. + In scalar context return the number of distinct field names. =item $h->scan( \&process_header_field ) +=item $h->scan( \&process_header_field, $dont_sort ) + Apply a subroutine to each header field in turn. The callback routine is called with two parameters; the name of the field and a single value (a string). If a header field is multi-valued, then the @@ -522,6 +536,9 @@ Any return values of the callback routine are ignored. The loop can be broken by raising an exception (C<die>), but the caller of scan() would have to trap the exception itself. +The optional $dont_sort parameter specifies that the headers should be +visited in the order they were seen. + =item $h->as_string =item $h->as_string( $eol ) -- 1.5.5.3
PGP.sig
(application/pgp-signature, 186 B) - not displayed