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