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