#!/usr/bin/perl
#
# $Id: Packet.pm,v 1.3 2001/10/06 22:19:14 levine Exp $
#
# Copyright (C) 2001  James D. Levine (jdl@vinecorp.com)
#
#
#   This program is free software; you can redistribute it and/or
#   modify it under the terms of the GNU General Public License
#   as published by the Free Software Foundation; either version 2
#   of the License, or (at your option) any later version.
# 
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
# 
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 
#   02111-1307, USA.
#
####################################################################



####################################################################
#
# packet
#
# Basic Packet abstraction with utility methods
#
####################################################################


use strict;

package NWatch::packet;

sub protocol_name { ""; }

sub full_protocol_name
{
    my( $self ) = shift;


#    print "fpn: next is " . $self->next() . "\n";
#    print "fpn: defined next is " . (defined ($self->next())) . "\n";

    return $self->protocol_name() .
 	(
	 ( defined $self->next() ) ?  ( ":" .$self->next()->full_protocol_name() ) : ""
	 );
}

sub new
{
    my( $class, $data ) = @_;

    my $self =
    {
	data => $data,		# the entire packet
	fields => {},		# unpacked fields, referenced by name
	next => undef,		# proto stacked next on top
    };

    $self->{"creation-time"}  = 0+time;

    bless $self, $class;
#    print "Packet: setting creation-time to ". $self->{"creation-time"} . "\n";

    $self;
}

# return age in seconds
sub age
{
    time-  $_[0]->{ 'creation-time' };
}

sub set
{
    my( $self, $field, $value ) = @_;

    $self->{fields}->{ $field } = $value;
}

sub get
{
    my( $self, $field ) = @_;
    
    return $self->{fields}->{ $field };
}


sub set_or_get
{
    my $field = shift; my $self = shift; my $val = shift;
    $self->{$field} = $val if defined $val;
    return $self->{$field};
}

sub next   { set_or_get('next',   @_); }
sub data   { set_or_get('data',   @_); }


sub top_field
{
    my( $self, $fieldname ) = @_;

    my $p = $self;

    while( defined $p->next )
    {
	$p = $p->next;
    }

    return $p->get( $fieldname ) if defined $p;

    return undef;
}

sub field_path
{
    my( $self, $path ) = @_;

    my @elements = split ":", $path;

    return $self->retrieve_path( \@elements );
}


sub retrieve_path
{
    my( $self, $elems_ref ) = @_;

#    print "retrieve_path: elem count is: " . $#$elems_ref  . "\n";
#    print "self is $self \n";


    return undef if $#$elems_ref == -1;

    if( $#$elems_ref == 0 )
    {
	my $e = shift @$elems_ref;
#	print "end of path -- last elem is $e \n";
	my $val = $self->get( $e );

#	print "value returned will be $val \n";
	return $val;
    }


#    print "retrieve_path: first elem is: " . $elems_ref->[0] . "\n";
#    print "retrieve_path: next is " . $self->next() . "\n";

    my $next_elem = shift @$elems_ref;


    if( ( defined $self->next() )  &&  ( $self->next()->protocol_name()  eq $next_elem ) )
    {
	return $self->next()->retrieve_path( $elems_ref );
    }
    else
    {
	return undef;
    }
}

sub fieldpath_relative
{
    my( $self, $path ) = @_;

    my @elements = split ":", $path;

    return undef if $#elements == -1; # nothing in path
    

    # last element in path is the field of the top protocol
    my $field = pop @elements;	

    # the remaining (preceeding) elements in the path are a path from 
    # this protocol up the stack to the top protocol
    # for example, "ipv4:tcp:source_address" 
    # references the "source_address" field in the tcp proto
    
    # follow the path to retrieve the protocol, or undef if not in stack
    # if it's an empty path, proto_path returns $self
    my $proto = $self->proto_path( \@elements );

    return $proto->get( $field ) if( defined $proto );

    return undef;
}



# returns 1 if $self is an instance of the supplied protocol path

sub proto_isa
{
    my( $self, $proto_path_str ) = @_;

#    print "proto_isa looking for $proto_path_str \n";
#    print "self is $self\n";
#    print "self protoname is " . $self->protocol_name() . "\n";


    my @elements = split ":", $proto_path_str;

    return 0 if $#elements == -1; # nothing in path

    # first element must match self's protocol name
    my $first_elem = shift @elements;
    return 0 if $first_elem ne $self->protocol_name();

    my $pak = $self->proto_path( \@elements );

#    print "pak is $pak\n";
#    print "pak protoname is " . $pak->protocol_name() . "\n" if defined $pak;

    return( defined $pak );
}


sub proto_path
{
    my( $self, $elems_ref ) = @_;

#    print "proto_path: looking for " . ( join ":", @$elems_ref ) . "\n";

    return $self if $#$elems_ref == -1;	# empty path, I'm it

    my $next_elem = shift @$elems_ref;

#    print "proto_path: next_elem is " . $next_elem . " and self protocol_name() is " . $self->protocol_name() . "\n";
#    print "proto_path: self->next is " . $self->next() . "\n";
#    print "proto_path: self->next is " . $self->next() . "\n";


    if( ( defined $self->next() )  &&  ( $self->next()->protocol_name()  eq $next_elem ) )
    {
	return $self->next()->proto_path( $elems_ref );
    }
    else
    {
	return undef;
    }
}


1;