view release on metacpan or  search on metacpan

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

	    my $cache_hash = $cache;
	    $cache = sub {
		my $id = shift;
		my $e;
		if ( ! @_ ){ # get
		    $e = $cache_hash->{$id} or return;
		} else {
		    my ($cert,$key) = @_;
		    $e = $cache_hash->{$id} = {
			cert => $cert,
			key => $key,
		    };
		}
		my $f = "$cachedir/$id.pem";
		if ( @_ || ! -f $f and open( my $fh,">",$f )) {
		    debug("save mitm certificate and key to $cachedir/$id.pem");
		    print $fh PEM_cert2string($e->{cert}),
			PEM_key2string($e->{key})
		} else {
		    utime(undef,undef,$f);
		}
		$e->{atime} = time();
		return ($e->{cert},$e->{key});
	    };
	}

	$mitm = IO::Socket::SSL::Intercept->new(
	    proxy_cert_file => $f,
	    proxy_key_file  => $f,
	    cache => $cache,
	    serial => $serial,
	);
    }

    my $imp_factory;
    my $filter = $self->{filter};
    if ($filter && @$filter ) {
	my $ns = $self->{impns};
	my @mod;
	my $ev = App::HTTP_Proxy_IMP::EventLoop->new;
	for my $f (@$filter) {
	    if ( ref($f) ) {
		# already factory object
		push @mod,$f;
		next;
	    }

	    my $f = $f; # copy
	    my $args = $f =~s{=(.*)}{} && $1;

	    my $found;
	    for my $prefix ('', map { "${_}::" } @$ns) {
		my $mod = $prefix.$f;
		if ( eval "require $mod" ) {
		    $found = $mod;
		    last;
		}
	    }
	    croak("IMP module $f could not be loaded: $@") if ! $found;
	    my %args = $args ? $found->str2cfg($args) :();
	    my @err = $found->validate_cfg(%args);
	    die "bad config for $found: @err" if @err;
	    push @mod, $found->new_factory(%args, eventlib => $ev )
	}

	my $logsub = $self->{logrx} && do {
	    my $rx = $self->{logrx};
	    sub {
		my ($level,$msg,$dir,$off,$len) = @_;
		$level =~ $rx or return;
		print STDERR "[$level]($dir:$off,$len) $msg\n";
	    };
	};
	$imp_factory = App::HTTP_Proxy_IMP::IMP->new_factory(
	    mod => \@mod,
	    logsub => $logsub,
	);
    }

    if ( $self->{childs} ) {
	$self->{childs} = [ map { undef } (1..$self->{childs}) ];
    }

    my $capath;
    if ( ! $mitm ) {
	# no interception = no certificate checking
    } elsif ( $self->{no_check_certificate} ) {
	# no certificate checking
    } elsif ( $capath = $self->{capath} ) {
	# use this capath
    } else {
	# try to guess capath
	if ( eval { require Mozilla::CA } ) {
	    $capath = Mozilla::CA::SSL_ca_file();
	} elsif ( glob("/etc/ssl/certs/*.pem") ) {
	    $capath = "/etc/ssl/certs";
	} elsif ( -f "/etc/ssl/certs.pem" && -r _ && -s _ ) {
	    $capath = "/etc/ssl/certs.pem";
	} else {
	    croak "cannot determine CA path, needed for SSL interception"
	}
    }

    # create connection fabric, attach request handling
    my $req  = App::HTTP_Proxy_IMP::Request->new;
    my $conn = App::HTTP_Proxy_IMP::Conn->new($req, 
	pcapdir     => $pcapdir, 
	mitm        => $mitm,
	capath      => $capath,
	imp_factory => $imp_factory
    );

    # create listeners
    my @listen;

    $self->{addr} = [ $self->{addr} ] 
	if $self->{addr} && ref($self->{addr}) ne 'ARRAY';
    for my $spec (@{$self->{addr}}) {
	my ($addr,$upstream) = 
	    ref($spec) eq 'ARRAY' ? @$spec:
	    ref($spec) ? ( $spec,undef ):