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