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