proxy.pl

   1 #!/usr/bin/perl
   2 #
   3 # http proxy for archives
   4 #
   5 use strict;
   6 use warnings;
   7 use HTTP::Proxy qw ( :log );
   8 use HTTP::Proxy::BodyFilter::save;
   9 use HTTP::Proxy::BodyFilter::simple;
  10 use HTTP::Proxy::HeaderFilter::simple;
  11
  12 our $info = {
  13         debug => 1,
  14         direct => [ qw/
  15 imageserver.ebscohost.com
  16         / ],
  17 };
  18 use Data::Dump qw(dump);
  19
  20 #
  21 # logger.pl
  22 #
  23
  24 use CGI::Util qw( unescape );
  25
  26 $|++; # STDOUT
  27
  28 # get the command-line parameters
  29 my %args = (
  30    peek    => [],
  31    header  => [],
  32    mime    => 'text/*',
  33 );
  34 {
  35     my $args = '(' . join( '|', keys %args ) . ')';
  36     for ( my $i = 0 ; $i < @ARGV ; $i += 2 ) {
  37         if ( $ARGV[$i] =~ /$args/o ) {
  38             if ( ref $args{$1} ) {
  39                 push @{ $args{$1} }, $ARGV[ $i + 1 ];
  40             }
  41             else {
  42                 $args{$1} = $ARGV[ $i + 1 ];
  43             }
  44             splice( @ARGV, $i, 2 );
  45             redo if $i < @ARGV;
  46         }
  47     }
  48 }
  49
  50 # the headers we want to see
  51 my @srv_hdr = (
  52     qw( Content-Type Set-Cookie Set-Cookie2 WWW-Authenticate Location ),
  53     @{ $args{header} }
  54 );
  55 my @clt_hdr =
  56   ( qw( Cookie Cookie2 Referer Referrer Authorization ), @{ $args{header} } );
  57
  58 # NOTE: Body request filters always receive the request body in one pass
  59 my $post_filter = HTTP::Proxy::BodyFilter::simple->new(
  60     begin  => sub { $_[0]->{binary} = 0; },
  61     filter => sub {
  62         my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
  63         print STDOUT "\n", $message->method, " ", $message->uri, "\n";
  64         print_headers( $message, @clt_hdr );
  65
  66         if ( $self->{binary} || $$dataref =~ /\0/ ) {
  67             $self->{binary} = 1;
  68             print STDOUT "    (not printing binary data)\n";
  69             return;
  70         }
  71
  72         # this is from CGI.pm, method parse_params()
  73         my (@pairs) = split( /[&;]/, $$dataref );
  74         for (@pairs) {
  75             my ( $param, $value ) = split( '=', $_, 2 );
  76             $param = unescape($param);
  77             $value = unescape($value);
  78             printf STDOUT "    %-20s => %s\n", $param, $value;
  79         }
  80     }
  81 );
  82
  83 my $get_filter = HTTP::Proxy::HeaderFilter::simple->new(
  84     sub {
  85         my ( $self, $headers, $message ) = @_;
  86         my $req = $message->request;
  87         if ( $req->method ne 'POST' ) {
  88             print STDOUT "\n", $req->method, " ", $req->uri, "\n";
  89             print_headers( $req, @clt_hdr );
  90         }
  91         print STDOUT $message->status_line, "\n";
  92         print_headers( $message, @srv_hdr );
  93     }
  94 );
  95
  96 sub print_headers {
  97     my $message = shift;
  98     for my $h (@_) {
  99         if ( $message->header($h) ) {
 100             print STDOUT "    $h: $_\n" for ( $message->header($h) );
 101         }
 102     }
 103 }
 104
 105 # create and start the proxy
 106 my $proxy = HTTP::Proxy->new(@ARGV);
 107
 108 # if we want to look at SOME sites
 109 if (@{$args{peek}}) {
 110     for (@{$args{peek}}) {
 111         $proxy->push_filter(
 112             host    => $_,
 113             method  => 'POST',
 114             request => $post_filter
 115         );
 116         $proxy->push_filter(
 117             host     => $_,
 118             response => $get_filter,
 119             mime     => $args{mime},
 120         );
 121     }
 122 }
 123 # otherwise, peek at all sites
 124 else {
 125     $proxy->push_filter(
 126         method  => 'POST',
 127         request => $post_filter
 128     );
 129     $proxy->push_filter( response => $get_filter, mime => $args{mime} );
 130 }
 131
 132 #
 133 # pdf.pl
 134 #
 135
 136 my $saved;
 137 $proxy->push_filter(
 138     # you should probably restrict this to certain hosts as well
 139     path => qr/\.pdf$/,
 140     mime => 'application/pdf',
 141     # save the PDF
 142     response => HTTP::Proxy::BodyFilter::save->new(
 143         template => "%f",
 144         prefix   => 'pdf'
 145     ),
 146     # send a HTML message instead
 147     response => HTTP::Proxy::BodyFilter::simple->new(
 148         begin => sub {
 149             my ( $self, $message ) = @_;    # for information, saorge
 150             $saved = 0;
 151         },
 152         filter => sub {
 153             my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
 154             $$dataref = $saved++ ? ""
 155               : sprintf '<p>Saving PDF file. Go <a href="%s">back</a></p>',
 156                         $message->request->header('referer');
 157         }
 158     ),
 159     # change the response Content-Type
 160     response => HTTP::Proxy::HeaderFilter::simple->new(
 161         sub {
 162             my ( $self, $headers, $response ) = @_;
 163             $headers->content_type('text/html');
 164         }
 165     ),
 166 );
 167
 168 #
 169 # admin interface
 170 #
 171
 172 my $admin_filter = HTTP::Proxy::HeaderFilter::simple->new( sub {
 173    my ( $self, $headers, $message ) = @_;
 174 warn "XXX ", $headers->header('x-forwarded-for'), ' ', $message->uri, "\n";
 175
 176         my $host = $message->uri->host;
 177         return unless $host eq $proxy->host;
 178
 179         $info->{debug} = not $info->{debug} if $message->uri->query =~ m{debug};
 180         warn "## ", dump( $headers, $message ) if $info->{debug};
 181
 182         my $host_port = $proxy->host . ':' . $proxy->port;
 183
 184         my $res = HTTP::Response->new( 200 );
 185
 186         if ( $message->uri->path =~ m/(proxy.pac|wpad.dat)/ ) {
 187                 $res->content_type('application/x-ns-proxy-autoconfig');
 188                 $res->content(qq|
 189
 190 function FindProxyForURL(url, host) {
 191 //      if (shExpMatch(url, "*.example.com:*/*"))               {return "DIRECT";}
 192
 193         if (shExpMatch(url, "*.js")) return "DIRECT";
 194         if (shExpMatch(url, "*.css")) return "DIRECT";
 195         if (shExpMatch(url, "*.gif")) return "DIRECT";
 196         if (shExpMatch(url, "*.png")) return "DIRECT";
 197         if (shExpMatch(url, "*.ico")) return "DIRECT";
 198         if (shExpMatch(url, "*.jpg")) return "DIRECT";
 199
 200 //       if (isInNet(host, "10.0.0.0",  "255.255.248.0"))    {
 201 //              return "PROXY fastproxy.example.com:8080";
 202 //      }
 203
 204         // we don't want to see this traffic!
 205         if (shExpMatch(url, "*.google.*")) return "DIRECT";
 206
 207         return "PROXY $host_port; DIRECT";
 208 }
 209
 210                 |);
 211                 $self->proxy->response( $res );
 212                 return;
 213         }
 214
 215         $res->content_type('text/html');
 216         $res->content(qq|
 217
 218 <h1>HTTP Proxy Archive</h1>
 219
 220 <a href="http://$host_port/proxy.pac">proxy.pac</a>
 221
 222         |
 223         . '<pre>' . dump($info) . '</pre>'
 224         . qq|<a href="?debug">debug</a>|
 225         );
 226
 227         $self->proxy->response( $res );
 228 } );
 229 $proxy->push_filter( request => $admin_filter );
 230
 231
 232 #
 233 # start
 234 #
 235
 236 warn "listen on host ", $proxy->host, " port ", $proxy->port, "\n";
 237
 238 $proxy->start;
 239