File Coverage

blib/lib/Net/SSH/Perl/Cipher.pm

Criterion	Covered	Total	%
statement	88	108	81.4
branch	12	22	54.5
condition	8	12	66.6
subroutine	28	32	87.5
pod	6	12	50.0
total	142	186	76.3

# $Id: Cipher.pm,v 1.12 2008/09/24 19:21:20 turnstep Exp $

package Net::SSH::Perl::Cipher;

use strict;
use warnings;
use Carp qw( croak );
use Crypt::Digest::SHA512 qw( sha512 );

use vars qw( %CIPHERS %CIPHERS_SSH2 %CIPH_REVERSE %SUPPORTED );
BEGIN {
    %CIPHERS = (
        None => 0,
        IDEA => 1,
        DES  => 2,
        DES3 => 3,
        RC4 => 5,
        Blowfish => 6,
        AES128_CTR => 7,
        AES192_CTR => 8,
        AES256_CTR => 9,
        AES128_CBC => 10,
        AES192_CBC => 11,
        AES256_CBC => 12,
        ChachaPoly => 13,
    );
    %CIPHERS_SSH2 = (
        '3des-cbc' => 'DES3',
        'blowfish-cbc' => 'Blowfish',
        'arcfour' => 'RC4',
        'aes128-ctr' => 'AES128_CTR',
        'aes192-ctr' => 'AES192_CTR',
        'aes256-ctr' => 'AES256_CTR',
        'aes128-cbc' => 'AES128_CBC',
        'aes192-cbc' => 'AES192_CBC',
        'aes256-cbc' => 'AES256_CBC',
        '[e-mail]' => 'ChachaPoly',
    );
    %CIPH_REVERSE = reverse %CIPHERS;
}

sub _determine_supported {
    for my $ciph (keys %CIPHERS) {
        my $pack = sprintf "%s::%s", __PACKAGE__, $ciph;
        eval "use $pack";
        $SUPPORTED{$CIPHERS{$ciph}}++ unless $@;
    }
}

sub new {
    my $class = shift;
    my $type = shift;
    my($ciph);
    unless ($type eq "None") {
        $type = $CIPHERS_SSH2{$type} || $type;
        my $ciph_class = join '::', __PACKAGE__, $type;
        (my $lib = $ciph_class . ".pm") =~ s!::!/!g;
        require $lib;
        $ciph = $ciph_class->new(@_);
    }
    else {
        $ciph = bless { }, __PACKAGE__;
    }
    $ciph;
}

sub new_from_key_str {
    my $class = shift;
    defined $_[1] ?
        $class->new($_[0], sha512($_[1])) :
        $class->new(@_);
}

sub enabled { $_[0]->{enabled} }
sub enable { $_[0]->{enabled} = 1 }
sub authlen { 0 }
sub ivlen { shift->blocksize }

sub id {
    my $this = shift;
    my $type;
    if (my $class = ref $this) {
        my $pack = __PACKAGE__;
        ($type = $class) =~ s/^${pack}:://;
    }
    else {
        $type = $this;
    }
    $CIPHERS{$type};
}

sub name {
    my $this = shift;
    my $name;
    if (my $class = ref $this) {
        my $pack = __PACKAGE__;
        ($name = $class) =~ s/^${pack}:://;
    }
    else {
        $name = $CIPH_REVERSE{$this};
    }
    $name;
}

sub mask {
    my $mask = 0;
    $mask |= (1<<$_) for keys %SUPPORTED;
    $mask;
}

sub supported {
    unless (keys %SUPPORTED) {
        _determine_supported();
    }
    my $protocol = 1;
    shift, $protocol = shift
        if not ref $_[0] and $_[0] and $_[0] eq 'protocol';
    unless(@_) {
        return [ keys %SUPPORTED ] unless 2 == $protocol;
        return [ grep $SUPPORTED{$_}, map $CIPHERS{$_}, values %CIPHERS_SSH2 ];
    }

    my $id = ref $_[0] ? shift->id : shift;
    return $id == 0 || exists $SUPPORTED{$id} unless @_;
    my $ssupp = shift;
    mask() & $ssupp & (1 << $id);
}

sub encrypt { $_[1] }

sub decrypt { $_[1] }

1;
__END__