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 # proxy-auth.pl
 180 #
 181
 182
 183 use HTTP::Proxy qw( :log );
 184 use MIME::Base64 qw( encode_base64 );
 185
 186 # the encoded user:password pair
 187 # login:  http
 188 # passwd: proxy
 189 my $token = "Basic " . encode_base64( "http:proxy", '' );
 190
 191 # the authentication filter
 192 $proxy->push_filter(
 193     request => HTTP::Proxy::HeaderFilter::simple->new(
 194         sub {
 195             my ( $self, $headers, $request ) = @_;
 196
 197             # check the token against all credentials
 198             my $ok = 0;
 199             $_ eq $token && $ok++
 200                 for $self->proxy->hop_headers->header('Proxy-Authorization');
 201
 202             # no valid credential
 203             if ( !$ok ) {
 204                 my $response = HTTP::Response->new(407);
 205                 $response->header(
 206                     Proxy_Authenticate => 'Basic realm="HTTP::Proxy"' );
 207                 $self->proxy->response($response);
 208             }
 209         }
 210     )
 211 );
 212
 213
 214 #
 215 # admin interface
 216 #
 217
 218 sub debug_on { -e 'var/debug' }
 219 sub debug_dump { -e 'var/debug' && warn "## ", dump( @_ ) }
 220
 221 my $admin_filter = HTTP::Proxy::HeaderFilter::simple->new( sub {
 222    my ( $self, $headers, $message ) = @_;
 223 warn "XXX [", $headers->header('x-forwarded-for'), '] ', $message->uri, "\n";
 224
 225         print $message->headers_as_string if debug_on;
 226
 227         my $host = $message->uri->host;
 228         var_save 'hits' => $host;
 229         return unless $host eq $proxy->host;
 230
 231         if ( my $q = $message->uri->query ) {
 232                 if ( $q =~ m{debug} ) {
 233                         -e 'var/debug' ? unlink 'var/debug' : open(my $touch,'>','var/debug');
 234                 }
 235         }
 236         debug_dump( $headers, $message );
 237
 238         my $host_port = $proxy->host . ':' . $proxy->port;
 239
 240         my $res = HTTP::Response->new( 200 );
 241
 242         if ( $message->uri->path =~ m/(proxy.pac|wpad.dat)/ ) {
 243                 $res->content_type('application/x-ns-proxy-autoconfig');
 244                 $res->content(qq|
 245
 246 function FindProxyForURL(url, host) {
 247 //      if (shExpMatch(url, "*.example.com:*/*"))               {return "DIRECT";}
 248
 249         if (shExpMatch(url, "*.js")) return "DIRECT";
 250         if (shExpMatch(url, "*.css")) return "DIRECT";
 251         if (shExpMatch(url, "*.gif")) return "DIRECT";
 252         if (shExpMatch(url, "*.png")) return "DIRECT";
 253         if (shExpMatch(url, "*.ico")) return "DIRECT";
 254         if (shExpMatch(url, "*.jpg")) return "DIRECT";
 255
 256 //       if (isInNet(host, "10.0.0.0",  "255.255.248.0"))    {
 257 //              return "PROXY fastproxy.example.com:8080";
 258 //      }
 259
 260         // we don't want to see this traffic!
 261         if (shExpMatch(url, "*.google.*")) return "DIRECT";
 262
 263         return "PROXY $host_port; DIRECT";
 264 }
 265
 266                 |);
 267                 $self->proxy->response( $res );
 268                 return;
 269         }
 270
 271         $res->content_type('text/html');
 272         $res->content(qq|
 273
 274 <h1>HTTP Proxy Archive</h1>
 275
 276 <div style="background: #ff0; padding: 1em;">
 277
 278 Copy following url into automatic proxy configuration and enable it:
 279 <p>
 280 <a href="http://$host_port/proxy.pac">http://$host_port/proxy.pac</a>
 281
 282 </div>
 283
 284         |
 285         . qq|<a href=/>/</a> <a href="?debug">debug</a>|
 286         );
 287
 288         $self->proxy->response( $res );
 289 } );
 290 $proxy->push_filter( request => $admin_filter );
 291
 292
 293 #
 294 # start
 295 #
 296
 297 warn "listen on host ", $proxy->host, " port ", $proxy->port, "\n";
 298
 299 $proxy->start;
 300