File Coverage

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

Criterion	Covered	Total	%
statement	99	112	88.3
branch	13	30	43.3
condition	4	10	40.0
subroutine	27	29	93.1
pod	20	23	86.9
total	163	204	79.9

package Net::SSH::Perl::Buffer;
use strict;
use warnings;

use constant MAX_BIGNUM => 2048;

{
    my %MP_MAP = (
        SSH1 => [ "use Math::GMP;", \&_get_mp_int_ssh1, \&_put_mp_int_ssh1 ],
        SSH2 => [ "1;", \&get_bignum2_bytes, \&put_bignum2_bytes],
    );

    sub new {
        my $class = shift;
        my $buf = bless { buf => '', offset => 0 }, $class;
        my %param = @_;
        my $mp = $MP_MAP{ $param{MP} || 'SSH1' };
        die "Unrecognized SSH protocol $param{MP}" unless $mp;
        eval $mp->[0];
        $buf->{_get_mp_int} = $mp->[1];
        $buf->{_put_mp_int} = $mp->[2];
        $buf;
    }
}

sub empty {
    my $buf = shift;
    $buf->{buf} = "";
    $buf->{offset} = 0;
}

sub append {
    my $buf = shift;
    $buf->{buf} .= $_[0];
}

sub consume {
    my $buf = shift;
    my $len = shift;
    substr $buf->{buf}, 0, $len, '';
}

sub bytes {
    my $buf = shift;
    my($off, $len, $rep) = @_;
    $off ||= 0;
    $len = length $buf->{buf} unless defined $len;
    return defined $rep ?
        substr($buf->{buf}, $off, $len, $rep) :
        substr($buf->{buf}, $off, $len);
}

sub length { length $_[0]->{buf} }
sub offset { $_[0]->{offset} }

sub dump {
    my $buf = shift;
    my @r;
    for my $c (split //, $buf->bytes(@_)) {
        push @r, sprintf "%02x", ord $c;
    }
    join ' ', @r
}

sub insert_padding {
    my $buf = shift;
    my $pad = 8 - ($buf->length + 4 - 8) % 8;
    my $junk = join '', map chr rand 128, 0..$pad-1;
    $buf->bytes(0, 0, $junk);
}

sub get_int8 {
    my $buf = shift;
    my $off = defined $_[0] ? shift : $buf->{offset};
    $buf->{offset} += 1;
    unpack "c", $buf->bytes($off, 1);
}

sub put_int8 {
    my $buf = shift;
    $buf->{buf} .= pack "c", $_[0];
}

sub get_int16 {
    my $buf = shift;
    my $off = defined $_[0] ? shift : $buf->{offset};
    $buf->{offset} += 2;
    unpack "n", $buf->bytes($off, 2);
}

sub put_int16 {
    my $buf = shift;
    $buf->{buf} .= pack "n", $_[0];
}

sub get_int32 {
    my $buf = shift;
    my $off = defined $_[0] ? shift : $buf->{offset};
    $buf->{offset} += 4;
    unpack "N", $buf->bytes($off, 4);
}

sub put_int32 {
    my $buf = shift;
    $buf->{buf} .= pack "N", $_[0];
}

sub get_char {
    my $buf = shift;
    my $off = defined $_[0] ? shift : $buf->{offset};
    $buf->{offset}++;
    $buf->bytes($off, 1);
}

sub put_char {
    my $buf = shift;
    $buf->{buf} .= $_[0];
}
*put_chars = \&put_char;

sub get_str {
    my $buf = shift;
    my $off = defined $_[0] ? shift : $buf->{offset};
    my $len = $buf->get_int32;
    $buf->{offset} += $len;
    $buf->bytes($off+4, $len);
}

sub put_str {
    my $buf = shift;
    my $str = shift;
    $str = "" unless defined $str;
    $buf->put_int32(CORE::length($str));
    $buf->{buf} .= $str;
}

sub get_mp_int { $_[0]->{_get_mp_int}->(@_) }
sub put_mp_int { $_[0]->{_put_mp_int}->(@_) }

sub _get_mp_int_ssh1 {
    my $buf = shift;
    my $off = defined $_[0] ? shift : $buf->{offset};
    my $bits = unpack "n", $buf->bytes($off, 2);
    my $bytes = int(($bits + 7) / 8);
    my $hex = join '', map { sprintf "%02x", ord } split //,
        $buf->bytes($off+2, $bytes);
    $buf->{offset} += 2 + $bytes;
    Math::GMP->new("0x$hex");
}

sub _put_mp_int_ssh1 {
    my $buf = shift;
    my $int = shift;
    my $bits = Math::GMP::sizeinbase_gmp($int, 2);
    my $hex_size = Math::GMP::sizeinbase_gmp($int, 16);
    my $tmp = Math::GMP::get_str_gmp($int, 16);
    $tmp = "0$tmp" if CORE::length($tmp) % 2;
    $tmp =~ s/(..)/ chr hex $1 /ge;
    $buf->put_int16($bits);
    $buf->put_chars($tmp);
}

sub put_bignum2_bytes {
    my $buf = shift;
    my $num = shift;

    # skip leading zero bytes
    substr($num,0,1,'') while ord(substr($num,0,1)) == 0;

    # prepend a zero byte if mosting significant bit is set
    # (to avoid interpretation as a negative number)
    $num = "\0" . $num
        if (ord(substr($num,0,1))) & 0x80;
    $buf->put_str($num);
}

sub get_bignum2_bytes {
    my $buf = shift;

    my $num = $buf->get_str;
    my $len = CORE::length($num);
    return unless $len;
    # refuse negative (MSB set) bignums
    return if ord(substr($num,0,1)) & 0x80;
    # refuse overlong bignums, allow prepended \0 to avoid MSB set
    return if $len > MAX_BIGNUM+1 ||
        ($len == MAX_BIGNUM+1 &&
        ord(substr($num,0,1)) != 0);
    # trim leading zero bytes
    substr($num,0,1,'') while ord(substr($num,0,1)) == 0;
    return $num;
}

1;
__END__