############################################################################ # base class for packet flows ############################################################################ use strict; use warnings; package Net::Inspect::Flow; use fields qw(upper_flow); sub new { my ($class,$flow) = @_; if ( ! ref($class)) { # create new my $self = fields::new($class); $self->{upper_flow} = $flow; return $self; } else { my $self = fields::new(ref($class)); $self->{upper_flow} = $flow || ( $class->{upper_flow} && $class->{upper_flow}->new ); # clone return $self; } } sub new_any { shift; return Net::Inspect::Flow::Any->new(@_) } # does nothing per default sub expire {} package Net::Inspect::Flow::Any; use Digest::MD5 'md5_hex'; use fields qw(flows); sub new { my ($class,@methods) = @_; if (@methods) { my $clname = "Net::Inspect::Flow::Any::". md5_hex(join("\0",sort @methods)); if ( ! UNIVERSAL::can($clname,'new') ) { # dynamically create class eval "package $clname; use base 'Net::Inspect::Flow::Any';1" or die $@; for my $method (@methods) { no strict 'refs'; *{ "${clname}::$method" } = sub { my $self = shift; for my $flow (@{$self->{flows}}) { if ( wantarray ) { my @rv = $flow->$method(@_) or next; return @rv } else { defined( my $rv = $flow->$method(@_)) or next; return $rv } } return; }; } } return $clname->new; } if ( ! ref $class ) { my $self = fields::new($class); $self->{flows} = []; return $self } else { my $self = fields::new(ref($class)); # clone attached flows $self->{flows} = [ map { $_->new } @{ $class->{flows} } ]; return $self; } } sub attach { my ($self,$flow) = @_; push @{ $self->{flows} }, $flow; } sub detach { my ($self,$flow) = @_; @{ $self->{flows} } = grep { $_ != $flow } @{ $self->{flows} }; } sub attached { my $self = shift; return @{ $self->{flows} } } 1; __END__ =head1 NAME Net::Inspect::Flow - base interface for Net::Inspect::* flows =head1 SYNOPSIS my $tcp = Net::Inspect::L4::TCP->new(...); my $raw = Net::Inspect::L3::IP->new($tcp); ... =head1 DESCRIPTION Net::Inspect::Flow implements the interface for all flow objects, e.g. that they have an upper flow object. It provides a member C<upper_flow> on which the forwardinh hooks should be called. =over 4 =item new(flow) Create object, subclasses should call Net::Inspect::Flow::new to initialize object. The given flow will be used for calling the hooks from the newly created flow. If called on object instead of class the object should clone itself. In this case the flow from the cloned object will be cloned too, unless a new flow is given. =item new_any(methods) Create if necessary a class derived from C<Net::Inspect::Flow::Any>, which contains the given methods additionally to the methods of C<Net::Inspect::Flow::Any>. These methods loop over the attached C<flows> and call the method with the same name on the flow and returns the first defined result. C<Net::Inspect::Flow::Any> provides the following methods: =over 4 =item attach(flow) adds flow to internal list of flows =item detach(flow) detaches flow from internal list of flows =item attached returns internal list of flows =back