AC-DC

 view release on metacpan or  search on metacpan

META.yml  view on Meta::CPAN

--- #YAML:1.0
name:               AC-DC
version:            1.1
abstract:           Asynchronous IO Framework. plus.
author:
    - AdCopy <http://www.adcopy.com>
license:            perl
distribution_type:  module
configure_requires:
    ExtUtils::MakeMaker:  0
requires:
    Digest::SHA1:        0
    MIME::Base64:        0
    POSIX:               0
    Sys::Hostname:       0
    Sys::Syslog:         0
    Time::HiRes:         0
    Time::Local:         0

lib/AC/DC/Protocol.pm  view on Meta::CPAN

use Carp qw(croak confess);
use Digest::SHA1;
use Fcntl;
use POSIX;
use Socket;
use Time::HiRes 'time';
use strict;

# header:
#	 proto version(32)
#	 message type(32)
#	 auth length(32)
#	 data length(32)
#	 content length(32)
#	 msgidno(32)
#	 flags(32):	is-reply(0), want-reply(1), is-error(2), data-encrypted(3), content-encrypted(4)
#
# followed by:
#       Auth PB(auth-length)
#	Data PB(data-length)
#       Content(content-length)

lib/AC/DC/Protocol.pm  view on Meta::CPAN

    $MSGTYPE{$name} = $d;
    $MSGREV{$num}   = $name;

}

################################################################

sub encode_header {
    my $me = shift;
    my %p = @_;
    # type, auth_length, data_length, content_length, msgidno,
    # is_reply, want_reply, is_error

    my $mt = $MSGTYPE{ $p{type} };
    confess "unknown message type $p{type}\n" unless defined $mt;

    my $flags = ( $p{is_reply}         ? 1 : 0 )
	     | ( $p{want_reply}        ? 2 : 0 )
	     | ( $p{is_error}          ? 4 : 0 )
             | ( $p{data_encrypted}    ? 8 : 0 )
             | ( $p{content_encrypted} ? 16 : 0 );

    return pack( "NNNNNNN",
		 $VERSION, $mt->{num}, $p{auth_length}, $p{data_length}, $p{content_length}, $p{msgidno}, $flags );

lib/AC/DC/Protocol.pm  view on Meta::CPAN

    my $headr = shift;

    my( $ver, $mt, $al, $dl, $cl, $id, $fl )
	= unpack("NNNNNNN", $headr);

    my %p = (
        auth_length	=> $al,
	data_length	=> $dl,
	content_length	=> $cl,
	msgidno		=> $id,
	type		=> $MSGREV{$mt},
    );

    confess "unknown protocol version $ver\n" unless $ver == $VERSION;
    confess "unknown protocol message $mt\n"  unless $p{type};

    $p{is_reply}   = ($fl & 1) ? 1 : 0;
    $p{want_reply} = ($fl & 2) ? 1 : 0;
    $p{is_error}   = ($fl & 4) ? 1 : 0;
    $p{data_encrypted} = ($fl & 8) ? 1 : 0;
    $p{content_encrypted} = ($fl & 16) ? 1 : 0;

    return \%p;
}

lib/AC/DC/Protocol.pm  view on Meta::CPAN

}

sub _encode_common {
    my $me    = shift;
    my $how   = shift;
    my $proto = shift;
    my $data  = shift;
    my $cont  = shift;	# reference
    my $auth  = shift;	# NYI

    my $mt = $MSGTYPE{ $proto->{type} };
    confess "unknown message type $proto->{type}\n" unless defined $mt;

    my $apb = $auth ? ACPAuth->encode( $auth ) : '';
    my $gpb = $data ? $mt->{$how}->encode( $data ) : '';

    if( $proto->{data_encrypted} && $gpb ){
        $gpb = $me->encrypt( $auth, $gpb );
    }

    my $hdr = $me->encode_header(
        type		  => $proto->{type},
        want_reply	  => $proto->{want_reply},
        is_reply	  => $proto->{is_reply},
        msgidno		  => $proto->{msgidno},
        data_encrypted	  => $proto->{data_encrypted},
        content_encrypted => $proto->{content_encrypted},
        auth_length	  => length($apb),
        data_length	  => length($gpb),
        content_length 	  => ($cont ? length($$cont) : 0),
       );

lib/AC/DC/Protocol.pm  view on Meta::CPAN

    return $hdr . $apb . $gpb;

}

sub _decode_common {
    my $me    = shift;
    my $how   = shift;
    my $reply = shift;
    my $data  = shift;

    my $mt = $MSGTYPE{ $reply->{type} };
    confess "unknown message type $reply->{type}\n" unless defined $mt;

    return unless $data || $reply->{data};
    my $res = $mt->{$how}->decode( $data || $reply->{data} || '' );
    return $res;
}

sub encode_request {
    my $me = shift;

    return $me->_encode_common( 'reqc', @_ );