1package HTTP::Proxy::HeaderFilter::standard;
2
3use strict;
4use HTTP::Proxy;
5use HTTP::Headers::Util qw( split_header_words );
6use HTTP::Proxy::HeaderFilter;
7use vars qw( @ISA );
8@ISA = qw( HTTP::Proxy::HeaderFilter );
9
10# known hop-by-hop headers
11my @hopbyhop =
12  qw( Connection Keep-Alive Proxy-Authenticate Proxy-Authorization
13      TE Trailers Transfer-Encoding Upgrade Proxy-Connection Public );
14
15# standard proxy header filter (RFC 2616)
16sub filter {
17    my ( $self, $headers, $message ) = @_;
18
19    # the Via: header
20    my $via = $message->protocol() || '';
21    if ( $self->proxy->via and $via =~ s!HTTP/!! ) {
22        $via .= " " . $self->proxy->via;
23        $headers->header(
24            Via => join ', ',
25            $message->headers->header('Via') || (), $via
26        );
27    }
28
29    # the X-Forwarded-For header
30    $headers->push_header(
31        X_Forwarded_For => $self->proxy->client_socket->peerhost )
32      if $message->isa( 'HTTP::Request' ) && $self->proxy->x_forwarded_for;
33
34    # make a list of hop-by-hop headers
35    my %h2h = map { (lc) => 1 } @hopbyhop;
36    my $hop = HTTP::Headers->new();
37    my $client = HTTP::Headers->new();
38    $h2h{ lc $_->[0] } = 1
39      for map { split_header_words($_) } $headers->header('Connection');
40
41    # hop-by-hop headers are set aside
42    # as well as LWP::UserAgent Client-* headers
43    $headers->scan(
44        sub {
45            my ( $k, $v ) = @_;
46            if ( $h2h{lc $k} ) {
47                $hop->push_header( $k => $v );
48                $headers->remove_header($k);
49            }
50            if( $k =~ /^Client-/ ) {
51                $client->push_header( $k => $v );
52                $headers->remove_header($k);
53            }
54        }
55    );
56
57    # set the hop-by-hop and client  headers in the proxy
58    # only the end-to-end headers are left in the message
59    $self->proxy->hop_headers($hop);
60    $self->proxy->client_headers($client);
61
62    # handle Max-Forwards
63    if ( $message->isa('HTTP::Request')
64        and defined $headers->header('Max-Forwards') ) {
65        my ( $max, $method ) =
66          ( $headers->header('Max-Forwards'), $message->method );
67        if ( $max == 0 ) {
68            # answer directly TRACE ou OPTIONS
69            if ( $method eq 'TRACE' ) {
70                my $response =
71                  HTTP::Response->new( 200, 'OK',
72                    HTTP::Headers->new( Content_Type => 'message/http'
73                    , Content_Length => 0),
74                    $message->as_string );
75                $self->proxy->response($response);
76            }
77            elsif ( $method eq 'OPTIONS' ) {
78                my $response = HTTP::Response->new(200);
79                $response->header( Allow => join ', ', @HTTP::Proxy::METHODS );
80                $self->proxy->response($response);
81            }
82        }
83        # The Max-Forwards header field MAY be ignored for all
84        # other methods defined by this specification (RFC 2616)
85        elsif ( $method =~ /^(?:TRACE|OPTIONS)/ ) {
86            $headers->header( 'Max-Forwards' => --$max );
87        }
88    }
89
90    # no encoding accepted (gzip, compress, deflate)
91    # if we plan to do anything with the response body
92    $headers->remove_header( 'Accept-Encoding' )
93        if @{ $self->proxy->{body}{response}{filters} };
94}
95
961;
97
98__END__
99
100=head1 NAME
101
102HTTP::Proxy::HeaderFilter::standard - An internal filter to respect RFC2616
103
104=head1 DESCRIPTION
105
106This is an internal filter used by HTTP::Proxy to enforce behaviour
107compliant with RFC 2616.
108
109=head1 METHOD
110
111This filter implements a single method that is called automatically:
112
113=over 4
114
115=item filter()
116
117Enforce RFC 2616-compliant behaviour, by adding the C<Via:> and
118C<X-Forwarded-For:> headers (except when the proxy was instructed not
119to add them), decrementing the C<Max-Forwards:> header and removing
120the hop-by-hop and L<LWP::UserAgent> headers.
121
122Note that the filter will automatically remove the C<Accept-Encoding>
123headers if the proxy has at least one L<HTTP::Proxy::BodyFilter> filter.
124(This is to ensure that the filters will receive uncompressed data.)
125
126=back
127
128=head1 SEE ALSO
129
130L<HTTP::Proxy>, L<HTTP::Proxy::HeaderFilter>, RFC 2616.
131
132=head1 AUTHOR
133
134Philippe "BooK" Bruhat, E<lt>book@cpan.orgE<gt>.
135
136Thanks to Gisle Aas, for directions regarding the handling of the
137hop-by-hop headers.
138
139=head1 COPYRIGHT
140
141Copyright 2003-2013, Philippe Bruhat.
142
143=head1 LICENSE
144
145This module is free software; you can redistribute it or modify it under
146the same terms as Perl itself.
147
148=cut
149
150