view release on metacpan or  search on metacpan

lib/Net/IMP/ProtocolPinning.pm  view on Meta::CPAN

		$DEBUG && debug("completed preliminary match rule $crs->[0]");
		$self->{off_buf}[$dir] += $removed;
		if ( $removed > $match_in_progress ) {
		    $pass_until = $self->{off_passed}[$dir]
			= $self->{off_buf}[$dir];
		}
		# no return, might match more

	    } elsif ( $matched > $match_in_progress ) {
		# keep rule open but issue extended IMP_PASS
		$DEBUG && debug("extended preliminary match rule $crs->[0]");
		$pass_until = $self->{off_passed}[$dir]
		    = $self->{off_buf}[$dir]+$matched;
		goto PASS_AND_RETURN; # need more data
	    } else {
		# keep rule open waiting for more data
		$DEBUG && debug("still preliminary(?) match rule $crs->[0]");
		goto PASS_AND_RETURN; # need more data
	    }

	} else {
	    # stream followed by packet, so rule cannot be extended
	    # remove from buf until end of last match
	    $DEBUG && debug("finished match rule $crs->[0] on packet $type");
	    substr($self->{buf}[$dir],0,$match_in_progress,'');
	    $self->{off_buf}[$dir] = $self->{off_passed}[$dir];
	}

	# match of previously matching rule done
	# remove it and continue with next rule if there are more data
	shift(@$crs);
	if (! @$crs) {
	    shift(@$rs);
	    # switch to other dir if this dir is done for now
	    if ( ! @$rs || ! $rs->[0] ) {
		my $ors = $self->{ruleset}[$dir ? 0:1];
		shift @$ors if @$ors && ! $ors->[0];
		goto CHECK_DONE if ! @$ors && ! @$rs;
	    }
	}
	if ( $type>0 or $self->{buf}[$dir] ne '' ) {
	    # unmatched data exist in data/buf
	    if ( ! @$rs ) {
		# all rules done from this direction, put back all
		# from buf to $data before calling NEXT_RULE
		$data = $self->{buf}[$dir];
		$self->{buf}[$dir] = '';
	    }
	    goto NEXT_RULE;
	}
	goto PASS_AND_RETURN; # wait for more data
    }

    # check against current set
    if ( $type>0 ) {
	# packet data
	if ( $self->{buf}[$dir] ne '' ) {
	    $self->run_callback([
		IMP_DENY,
		$dir,
		"packet data after unmatched streaming data"
	    ]);
	}
	for( my $i=0;$i<@$crs;$i++ ) {
	    if ( my ($len) = $match->($rules->[$crs->[$i]],\$data)) {
		# match
		$pass_until = $self->{off_passed}[$dir] =
		    $self->{off_buf}[$dir] += $len;
		if ( $self->{matched} ) {
		    # preserve hash of matched packet so that duplicates are
		    # detected later
		    $self->{matched}[$dir]{ md5(
			( $self->{matched_seed} //= pack("N",rand(2**32)) ).
			$data
		    )} = $crs->[$i]
		}

		if (@$crs>1) {
		    # remove rule, keep rest in ruleset
		    $DEBUG && debug(
			"full match rule $crs->[$i] - remove from ruleset");
		    splice(@$crs,$i,1);
		} else {
		    # remove ruleset with last rule in it
		    $DEBUG && debug(
			"full match rule $crs->[$i] - remove ruleset");
		    shift(@$rs);
		    # switch to other dir if this dir is done for now
		    if ( ! @$rs || ! $rs->[0] ) {
			my $ors = $self->{ruleset}[$dir ? 0:1];
			shift @$ors if @$ors && ! $ors->[0];
		    }
		}

		# pass data
		goto CHECK_DONE if ! @$rs;
		goto PASS_AND_RETURN; # wait for more data
	    }
	}

	# no rule from ruleset matched, check for duplicates
	if ( $self->{matched} and my $dup = $self->{matched}[$dir] ) {
	    my $r = $dup->{ md5($self->{matched_seed} . $data ) };
	    if ( defined $r ) {
		# matched again - pass data
		$pass_until = $self->{off_passed}[$dir]
		    = $self->{off_buf}[$dir] += length($data);
		$DEBUG && debug("ignore DUP[$dir] for rule $r");
		goto PASS_AND_RETURN; # wait for more data
	    }
	}

	# no rule and no duplicates matched, must be bad data
	$DEBUG && debug("no matching rule for ${type}[$dir] - deny");
	$self->{buf} = undef;
	$self->run_callback([
	    IMP_DENY,
	    $dir,
	    "rule#@$crs did not match"
	]);
	return;

    } else {
	# streaming data
	my $temp_fail;
	my $final_match;
	for( my $i=0;$i<@$crs;$i++ ) {
	    my ($len,$removed)
		= $match->($rules->[$crs->[$i]],\$self->{buf}[$dir]);
	    if ( ! defined $len ) {
		# will never match against rule
		next;
	    } elsif ( ! $len ) {
		# note that it might match if buf gets longer but check other
		# rules in ruleset if they match better
		$temp_fail = 1;
		next;
	    }

	    if ( ! $removed and @$crs == 1 and @$rs == 1 ) {
		# last rule for dir - no need to extend preliminary matches
		# as long as max_unbound is not restrictive
		my $ma = $self->{factory_args}{max_unbound};
		if ( ! defined( $ma && $ma->[$dir] )) {
		    $removed = $len;
		    substr($self->{buf}[$dir],0,$removed,'');
		}
	    }

	    # rule matched
	    if ( ! $removed ) {
		# match might not be final, wait for more data but put rule
		# at the beginning of ruleset if it's not already there
		unshift @$crs,splice(@$crs,$i,1) if $i>0;

		# advance off_passed, but keep off_buf
		$pass_until = $self->{off_passed}[$dir]
		    = $self->{off_buf}[$dir] + $len;

		# if this is was the last completely open rule we don't need
		# to check if the matched could be extended
		if (@$crs == 1 and @$rs == 1 ) {
		    # last rule on this side
		    my $ors = $self->{ruleset}[$dir?0:1];
		    if (
			# other side has no rules
			! @$ors
			# other side has empty rule
			or @$ors == 1 and ! $ors->[0]
			# other side has single rule which matched already
			or @$ors == 1 and @{ $ors->[0] } == 1 and
			    $self->{off_passed}[$dir?0:1]
			    - $self->{off_buf}[$dir?0:1] > 0 ) {

			# we are done and there is no need to extend the match
			@$ors = @$rs = ();
			goto CHECK_DONE;
		    }
		}

	    } else {
		# final match of rule
		$pass_until = $self->{off_passed}[$dir]
		    = $self->{off_buf}[$dir] += $len;
		if (@$crs>1) {
		    # remove rule, keep rest in ruleset
		    $DEBUG && debug(
			"full match rule $crs->[$i] - remove from ruleset");
		    splice(@$crs,$i,1);
		} else {
		    # remove ruleset with last rule in it
		    $DEBUG && debug(
			"full match rule $crs->[$i] - remove ruleset");
		    shift(@$rs);
		    # switch to other dir if this dir is done for now
		    if ( ! @$rs || ! $rs->[0] ) {
			my $ors = $self->{ruleset}[$dir ? 0:1];
			shift @$ors if @$ors && ! $ors->[0];
			goto CHECK_DONE if ! @$ors && ! @$rs;
		    }
		}
		$final_match = 1;
		# no allow_dup for streaming
	    }

	    # pass data
	    if ( $final_match and $self->{buf}[$dir] ne '' ) {
		# try to match more
		$data = $self->{buf}[$dir];
		$self->{buf}[$dir] = '';
		goto NEXT_RULE;
	    }
	    goto CHECK_DONE if ! @$rs;
	    goto PASS_AND_RETURN;
	}

	if ( ! $temp_fail ) {
	    # no rule and no duplicates matched, must be bad data
	    $DEBUG && debug("no matching rule for ${type}[$dir] - deny");
	    $self->{buf} = undef;
	    $self->run_callback([
		IMP_DENY,
		$dir,
		"rule#@$crs did not match"
	    ]);
	}
	goto PASS_AND_RETURN;
    }

    CHECK_DONE:
    return if @$rs; # still unmatched rules

    # pass only current data
    goto PASS_AND_RETURN if @{$self->{ruleset}[ $dir ? 0:1 ] };

    # rulesets for both dirs are done, pass all data
    $DEBUG && debug("all rules done - pass rest");
    $self->{buf} = undef;
    my @rv = (
	[ IMP_PASS,0,IMP_MAXOFFSET ],
	[ IMP_PASS,1,IMP_MAXOFFSET ]
    );
    for(0,1) {
	$self->{paused}[$_] or next;
	$self->{paused}[$_] = 0;
	unshift @rv, [ IMP_CONTINUE,$_ ];
    }
    $self->run_callback(@rv);
    return;

    PASS_AND_RETURN:
    return if ! $pass_until;
    $self->run_callback([ IMP_PASS, $dir, $pass_until ]);
    return;
}

# cfg2str and str2cfg are redefined because our config hash is deeper
# nested due to rules and max_unbound
sub cfg2str {
    my Net::IMP::ProtocolPinning $self = shift;
    my %cfg = @_;

    my $rules = delete $cfg{rules} or croak("no rules defined");