view release on metacpan or  search on metacpan

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

    my $frame   = $arg_ref->{FRAME};
    if (! defined $frame) {
        croak "You need to pass a frame to be decoded.";
    }
    my $last_frame_undo = rindex $frame, 'T';
    if ($last_frame_undo > 0) {
        # if a FUN was found, take everything to the right to be the
        # new frame.
        $frame = 'Q' . substr($frame, $last_frame_undo + 2);
    }
    while ($frame =~ m{ (.*) [^S]S (.*) }xms) {
        # delete the signal before a 'S' (SUN, signal undo)
        $frame = $1 . $2;
    }
    $frame =~ s/[U-Y]//g; # ignore ACK, KAL, NAK, RTR and RTT signals
    my ($header, $payload, $checksum) =
        ($frame =~ m{\A Q([A-E][A-B][A-P]{2}) ([A-P]+) ([A-P]{4})R \z}xms);
    if (! defined $header || ! defined $payload || ! defined $checksum) {
        croak "Invalid frame format.";
    }
    return $self->__pack($payload);
}

sub __pack {
    my $self  = shift;
    my $frame = shift;

    # convert from ASCII to hex
    $frame =~ tr/A-J/0-9/;
    $frame =~ tr/K-P/a-f/;
    return pack('H*', $frame);
}

sub __unpack {
    my $self = shift;
    my $data = shift;

    # unpack
    my $result = unpack('H*', $data);
    $result =~ tr/0-9/A-J/;
    $result =~ tr/a-f/K-P/;
    return $result;
}

sub encode {
    my $self    = shift;
    my $arg_ref = shift;

    my $sfs_frame = 'Q'; # Frame Start FST

    # 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).";
    }
    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);
    if (substr($packet_ascii, 0, 1) eq 'E') { # E=4: IPv4
        $sfs_frame .= 'B';
    }
    elsif (substr($packet_ascii, 0, 1) eq 'G') { # G=6: IPv6
        $sfs_frame .= 'C';
    }
    else {
        croak "Invalid IP version";
    }

    $sfs_frame .= 'A';    # Checksum Type: none
    $sfs_frame .= 'AA';   # Frame number 0x00

    $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;
        }
        else {
            return join "\n", @sfss_ascii_art_frames;
        }
    }
}
1;
__END__

=head1 NAME

Acme::RFC4824 - Internet Protocol over Semaphore Flag Signaling System (SFSS)

=head1 VERSION

Version 0.01

=head1 SYNOPSIS

This module is used to help you implement RFC 4824 - The Transmission
of IP Datagrams over the Semaphore Flag Signaling System (SFSS).

It can be used to convert IP datagrams to SFS frames and the other
way round. Furthemore, it can be used to display an ASCII art representation
of the SFS frame.

    use Acme::RFC4824;

    my $sfss = Acme::RFC4824->new();
    
    # get IP datagram from somewhere (for example Net::Pcap)
    # print a representation of the SFS frame
    print $sfss->encode({
        TYPE   => 'ASCII art',
        PACKET => $datagram, 
    });

    # get an ASCII representation of the SFS frame
    my $sfs_frame = $sfss->encode({
        TYPE   => 'ASCII',
        PACKET => $datagram,
    });

    # get an SFS frame from somewhere
    # (for example from someone signaling you)
    # get an IP datagram from the frame
    my $datagram = $sfss->decode({
        FRAME => $frame,
    });

=head1 EXPORT