Acme-RFC4824

 view release on metacpan or  search on metacpan

examples/ipsfss_receive.pl  view on Meta::CPAN

sub process_packet {
    my ($user_data, $header, $packet) = @_;
    # assuming the packet is ethernet
    my $packet_type = unpack('H*', substr($packet, 12, 2));
    if ($packet_type ne '0800') {
        # not an IP packet, ignore it
        return;
    }
    print "Processing packet ...\n";
    print "Packet length: " . (length($packet) - 14) . "\n";
    my $sfss = Acme::RFC4824->new();
    my $ascii = $sfss->encode({
        TYPE     => 'ASCII',
        PACKET   => substr($packet, 14),
    });
    my @ascii_art = $sfss->encode({
        TYPE     => 'ASCII art',
        PACKET   => substr($packet, 14),
    });
    for (my $i = 0; $i < scalar @ascii_art; $i++) {

lib/Acme/RFC4824.pm  view on Meta::CPAN

    # type is ASCII or ASCII-ART
    my $type = 'ASCII';
    if (defined $arg_ref->{TYPE}) {
        $type = $arg_ref->{TYPE};
    }
    if ($type ne 'ASCII' && $type ne 'ASCII art') {
        croak "Invalid output type";
    }

    my $packet = $arg_ref->{PACKET};
    if (! defined $packet || ! length($packet)) {
        croak "You need to pass an IP packet";
    }

    my $checksum = 0;
    if (defined $arg_ref->{CHECKSUM}) {
        $checksum = $arg_ref->{CHECKSUM};
    };
    # TODO - implement CRC 16 support
    if ($checksum == 1) {
        croak "CRC 16 support not implemented (yet).";

lib/Acme/RFC4824.pm  view on Meta::CPAN

    elsif ($checksum > 1) {
        croak "Invalid checksum type";
    }

    my $framesize = $self->{default_framesize};
    if (exists $arg_ref->{FRAMESIZE}) {
        $framesize = $arg_ref->{FRAMESIZE};
    }
    # TODO - implement fragmenting
    # note: honor DF bit in IP packets
    if (length($packet) > $framesize) {
        croak "Fragmenting not implemented (yet).";
    }

    # TODO - implement support for gzipped frames
    my $gzip = $arg_ref->{GZIP};
    if ($gzip) {
        croak "GZIP support not implemented (yet).";
    }

    my $packet_ascii = $self->__unpack($packet);

lib/Acme/RFC4824.pm  view on Meta::CPAN

    $sfs_frame .= $packet_ascii;

    $sfs_frame .= 'AAAA'; # No checksum, so we just set it zeros 
    $sfs_frame .= 'R';    # Frame End, FEN

    if ($type eq 'ASCII') {
        return $sfs_frame;
    }
    else { # ASCII-ART
        my @sfss_ascii_art_frames = ();
        for (my $i = 0; $i < length($sfs_frame); $i++) {
            my $char = substr($sfs_frame, $i, 1);
            my $aa_repr = $self->ascii2art_map->{$char};
            if (! defined $aa_repr) {
                die "No ASCII-Art representation for '$char'";
            }
            push @sfss_ascii_art_frames, $aa_repr;
        }
        if (wantarray) {
            return @sfss_ascii_art_frames;
        }

t/01-encode_decode.t  view on Meta::CPAN

# test correct ASCII representation
is($ascii, 'QBAAAEFAAAAEAFMBHEAAAEAAGMIFAAKCFIBACAKCFIBAEABIFIAAKAACDMIOKGBKINFFNLABCPPPPFGPOAAAAACAEAFLEABADADAAABABAIAKFJNGDCFLAAAELLMKAEACAAAAAAAAR', 'Correct ASCII representation');

my $ascii_art_string = $sfss->encode({
    PACKET => $test_packet,
    TYPE   => 'ASCII art',
});
if ($ENV{DEBUG}) {
    diag "ASCII art string:\n" . $ascii_art_string;
}
# test that we get something back with a length
ok(length($ascii_art_string), 'ASCII art string has non-zero length');

my @ascii_art = $sfss->encode({
    PACKET => $test_packet,
    TYPE   => 'ASCII art',
});
if ($ENV{DEBUG}) {
    diag "ASCII art array:\n" . Dumper \@ascii_art;
}
# test that the number of characters in the ASCII string is the same as
# the number of ASCII art entries
is(scalar @ascii_art, length($ascii), 'ASCII art array has same number of elements as the string is long');

# test that the last entry is the representation of 'R' (FEN)
is($sfss->ascii2art_map()->{'R'}, $ascii_art[scalar @ascii_art - 1], 'Last symbol is R (FEN)');

# test packet from RFC 4824 authors
my $test_packet2 = pack('H*', '1e1f202122232425262728292a2b2c2d2e2f3031323334353637');
my $ascii2 = 'QABAABOBPCACBCCCDCECFCGCHCICJCKCLCMCNCOCPDADBDCDDDEDFDGDHLPOMR';
my $test = $sfss->decode({
    FRAME => $ascii2,
});