view release on metacpan or  search on metacpan

lib/App/HTTP_Proxy_IMP/IMP.pm  view on Meta::CPAN

use Compress::Raw::Zlib;
no warnings 'experimental'; # smartmatch
use Carp;

my %METHODS_RFC2616 = map { ($_,1) } qw( GET HEAD POST PUT DELETE OPTIONS CONNECT TRACE );
my %METHODS_WITHOUT_RQBODY = map { ($_,1) } qw( GET HEAD DELETE CONNECT );
my %METHODS_WITH_RQBODY = map { ($_,1) } qw( POST PUT );
my %CODE_WITHOUT_RPBODY = map { ($_,1) } qw(204 205 304);
my %METHODS_WITHOUT_RPBODY = map { ($_,1) } qw(HEAD);

# we want plugins to suppport the HTTP Request innterface
my $interface = [
    IMP_DATA_HTTPRQ,
    [ 
	IMP_PASS,
	IMP_PREPASS,
	IMP_REPLACE,
	IMP_TOSENDER,
	IMP_DENY,
	IMP_LOG,
	IMP_ACCTFIELD,
	IMP_PAUSE,
	IMP_CONTINUE,
	IMP_FATAL,
    ]
];

sub can_modify {
    return shift->{can_modify};
}

# create a new factory object
sub new_factory {
    my ($class,%args) = @_;
    my @factory;
    for my $module (@{ delete $args{mod} || [] }) {
	if ( ref($module)) {
	    # assume it is already an IMP factory object
	    push @factory, $module;
	    next;
	}

	# --filter mod=args
	my ($mod,$args) = $module =~m{^([a-z][\w:]*)(?:=(.*))?$}i
	    or die "invalid module $module";
	eval "require $mod" or die "cannot load $mod args=$args: $@";
	my %args = $mod->str2cfg($args//'');
	my $factory = $mod->new_factory(%args) 
	    or croak("cannot create Net::IMP factory for $mod");
	$factory = 
	    $factory->get_interface( $interface ) &&
	    $factory->set_interface( $interface )
	    or croak("$mod does not implement the interface supported by us");
	push @factory,$factory;
    }

    @factory or return;
    if (@factory>1) {
	# for cascading filters we need Net::IMP::Cascade
	require Net::IMP::Cascade;
	my $cascade = Net::IMP::Cascade->new_factory( parts => [ @factory ]) 
	    or croak("cannot create Net::IMP::Cascade factory");
	$cascade = $cascade->set_interface( $interface ) or 
	    croak("cascade does not implement the interface supported by us");
	@factory = $cascade;
    }
    my $factory = $factory[0];

    my $self = bless {
	%args,
	imp => $factory, # IMP factory object
	can_modify => 0, # does interface support IMP_REPLACE, IMP_TOSENDER
    }, $class;
    lock_ref_keys($self);

    # update can_modify
    CHKIF: for my $if ( $factory->get_interface ) {
	my ($dt,$rt) = @$if;
	for (@$rt) {
	    $_ ~~ [ IMP_REPLACE, IMP_TOSENDER ] or next;
	    $self->{can_modify} =1;
	    last CHKIF;
	}
    }
	
    return $self;
}

# create a new analyzer based on the factory
sub new_analyzer {
    my ($factory,$request,$meta) = @_;

    my %meta = %$meta;
    # IMP uses different *addr than Net::Inspect, translate
    # [s]ource -> [c]lient, [d]estination -> [s]erver
    $meta{caddr} = delete $meta{saddr};
    $meta{cport} = delete $meta{sport};
    $meta{saddr} = delete $meta{daddr};
    $meta{sport} = delete $meta{dport};

    my $analyzer = $factory->{imp}->new_analyzer( meta => \%meta );

    my $self = bless {
	request => $request, # App::HTTP_Proxy_IMP::Request object
	imp => $analyzer,
	# incoming data, put into analyzer
	# \@list of [ buf_base,buf,type,callback,$cb_arg ] per dir 
	ibuf => [ 
	    [ [0,''] ],
	    [ [0,''] ],
	],  
	pass => [0,0],      # pass allowed up to given offset (per dir)
	prepass => [0,0],   # prepass allowed up to given offset (per dir)
	fixup_header => [], # sub to fixup content-length in header once known
	eof => [0,0],       # got eof in dir ?
	decode => undef,    # decoder for content-encoding decode{type}[dir]
	pass_encoded => undef, # pass body encoded (analyzer will not change body)
	method => undef,    # request method
	logsub => $factory->{logsub},  # how to log IMP_OG
    }, ref($factory);
    lock_ref_keys($self);
    weaken($self->{request});

    # set callback, this might trigger callback immediately if there are 
    # results pending