package HTTP::Proxy;
use HTTP::Daemon;
use HTTP::Date qw(time2str);
use LWP::UserAgent;
use LWP::ConnCache;
use Fcntl ':flock'; # import LOCK_* constants
use IO::Select;
use Sys::Hostname; # hostname()
use Carp;
use strict;
use vars qw( $VERSION $AUTOLOAD @METHODS
@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
require Exporter;
@ISA = qw(Exporter);
@EXPORT = (); # no export by default
@EXPORT_OK = qw( ERROR NONE PROXY STATUS PROCESS SOCKET HEADERS FILTERS
DATA CONNECT ENGINE ALL );
%EXPORT_TAGS = ( log => [@EXPORT_OK] ); # only one tag
$VERSION = '0.20';
my $CRLF = "\015\012"; # "\r\n" is not portable
# standard filters
use HTTP::Proxy::HeaderFilter::standard;
# constants used for logging
use constant ERROR => -1; # always log
use constant NONE => 0; # never log
use constant PROXY => 1; # proxy information
use constant STATUS => 2; # HTTP status
use constant PROCESS => 4; # sub-process life (and death)
use constant SOCKET => 8; # low-level connections
use constant HEADERS => 16; # HTTP headers
use constant FILTERS => 32; # Messages from filters
use constant DATA => 64; # Data received by the filters
use constant CONNECT => 128; # Data transmitted by the CONNECT method
use constant ENGINE => 256; # Internal information from the Engine
use constant ALL => 511; # All of the above
# modules that need those constants to be defined
use HTTP::Proxy::Engine;
use HTTP::Proxy::FilterStack;
# Methods we can forward
my %METHODS;
# HTTP (RFC 2616)
$METHODS{http} = [qw( CONNECT DELETE GET HEAD OPTIONS POST PUT TRACE )];
# WebDAV (RFC 2518)
$METHODS{webdav} = [
@{ $METHODS{http} },
qw( COPY LOCK MKCOL MOVE PROPFIND PROPPATCH UNLOCK )
];
# Delta-V (RFC 3253)
$METHODS{deltav} = [
@{ $METHODS{webdav} },
qw( BASELINE-CONTROL CHECKIN CHECKOUT LABEL MERGE MKACTIVITY
MKWORKSPACE REPORT UNCHECKOUT UPDATE VERSION-CONTROL ),
];
# the whole method list
@METHODS = HTTP::Proxy->known_methods();
# useful regexes (from RFC 2616 BNF grammar)
my %RX;
$RX{token} = qr/[-!#\$%&'*+.0-9A-Z^_`a-z|~]+/;
$RX{mime} = qr($RX{token}/$RX{token});
$RX{method} = '(?:' . join ( '|', @METHODS ) . ')';
$RX{method} = qr/$RX{method}/;
sub new {
my $class = shift;
my %params = @_;
# some defaults
my %defaults = (
agent => undef,
chunk => 4096,
daemon => undef,
host => 'localhost',
logfh => *STDERR,
logmask => NONE,
max_connections => 0,
max_keep_alive_requests => 10,
port => 8080,
stash => {},
timeout => 60,
via => hostname() . " (HTTP::Proxy/$VERSION)",
x_forwarded_for => 1,
);
# non modifiable defaults
my $self = bless { conn => 0, loop => 1 }, $class;
=1= |