1package Net::SFTP::Foreign::Buffer; 2 3our $VERSION = '1.68_05'; 4 5use strict; 6use warnings; 7no warnings 'uninitialized'; 8 9use Carp; 10 11use constant HAS_QUADS => do { 12 local $@; 13 local $SIG{__DIE__}; 14 no warnings; 15 eval q{ 16 pack(Q => 0x1122334455667788) eq "\x11\x22\x33\x44\x55\x66\x77\x88" 17 } 18}; 19 20sub new { 21 my $class = shift; 22 my $data = ''; 23 @_ and put(\$data, @_); 24 bless \$data, $class; 25} 26 27sub make { bless \$_[1], $_[0] } 28 29sub bytes { ${$_[0]} } 30 31sub get_int8 { 32 length ${$_[0]} >=1 or return undef; 33 unpack(C => substr(${$_[0]}, 0, 1, '')); 34} 35 36sub get_int16 { 37 length ${$_[0]} >=2 or return undef; 38 unpack(n => substr(${$_[0]}, 0, 2, '')); 39} 40 41sub get_int32 { 42 length ${$_[0]} >=4 or return undef; 43 unpack(N => substr(${$_[0]}, 0, 4, '')); 44} 45 46sub get_int32_untaint { 47 my ($v) = substr(${$_[0]}, 0, 4, '') =~ /(.*)/s; 48 get_int32(\$v); 49} 50 51sub get_int64_quads { 52 length ${$_[0]} >= 8 or return undef; 53 unpack Q => substr(${$_[0]}, 0, 8, '') 54} 55 56sub get_int64_no_quads { 57 length ${$_[0]} >= 8 or return undef; 58 my ($big, $small) = unpack(NN => substr(${$_[0]}, 0, 8, '')); 59 if ($big) { 60 # too big for an integer, try to handle it as a float: 61 my $high = $big * 4294967296; 62 my $result = $high + $small; 63 unless ($result - $high == $small) { 64 # too big event for a float, use a BigInt; 65 require Math::BigInt; 66 $result = Math::BigInt->new($big); 67 $result <<= 32; 68 $result += $small; 69 } 70 return $result; 71 } 72 return $small; 73} 74 75*get_int64 = (HAS_QUADS ? \&get_int64_quads : \&get_int64_no_quads); 76 77sub get_int64_untaint { 78 my ($v) = substr(${$_[0]}, 0, 8, '') =~ /(.*)/s; 79 get_int64(\$v); 80} 81 82sub get_str { 83 my $self = shift; 84 length $$self >=4 or return undef; 85 my $len = unpack(N => substr($$self, 0, 4, '')); 86 length $$self >=$len or return undef; 87 substr($$self, 0, $len, ''); 88} 89 90sub get_str_list { 91 my $self = shift; 92 my @a; 93 if (my $n = $self->get_int32) { 94 for (1..$n) { 95 my $str = $self->get_str; 96 last unless defined $str; 97 push @a, $str; 98 } 99 } 100 return @a; 101} 102 103sub get_attributes { Net::SFTP::Foreign::Attributes->new_from_buffer($_[0]) } 104 105 106sub skip_bytes { substr(${$_[0]}, 0, $_[1], '') } 107 108sub skip_str { 109 my $self = shift; 110 my $len = $self->get_int32; 111 substr($$self, 0, $len, ''); 112} 113 114sub put_int8 { ${$_[0]} .= pack(C => $_[1]) } 115 116sub put_int32 { ${$_[0]} .= pack(N => $_[1]) } 117 118sub put_int64_quads { ${$_[0]} .= pack(Q => $_[1]) } 119 120sub put_int64_no_quads { 121 if ($_[1] >= 4294967296) { 122 my $high = int ( $_[1] / 4294967296); 123 my $low = int ($_[1] - $high * 4294967296); 124 ${$_[0]} .= pack(NN => $high, $low) 125 } 126 else { 127 ${$_[0]} .= pack(NN => 0, $_[1]) 128 } 129} 130 131*put_int64 = (HAS_QUADS ? \&put_int64_quads : \&put_int64_no_quads); 132 133sub put_str { 134 utf8::downgrade($_[1]) or croak "UTF8 data reached the SFTP buffer"; 135 ${$_[0]} .= pack(N => length($_[1])) . $_[1] 136} 137 138sub put_char { ${$_[0]} .= $_[1] } 139 140sub _attrs_as_buffer { 141 my $attrs = shift; 142 my $ref = ref $attrs; 143 Net::SFTP::Foreign::Attributes->isa($ref) 144 or croak("Object of class Net::SFTP::Foreign::Attributes " 145 . "expected, $ref found"); 146 $attrs->as_buffer; 147} 148 149sub put_attributes { ${$_[0]} .= ${_attrs_as_buffer $_[1]} } 150 151my %unpack = ( int8 => \&get_int8, 152 int32 => \&get_int32, 153 int64 => \&get_int64, 154 str => \&get_str, 155 attr => \&get_attributtes ); 156 157sub get { 158 my $buf = shift; 159 map { $unpack{$_}->($buf) } @_; 160} 161 162my %pack = ( int8 => sub { pack C => $_[0] }, 163 int32 => sub { pack N => $_[0] }, 164 int64 => sub { 165 if (HAS_QUADS) { 166 return pack(Q => $_[0]) 167 } 168 else { 169 if ($_[0] >= 4294967296) { 170 my $high = int ( $_[0] / 4294967296); 171 my $low = int ($_[0] - $high * 4294967296); 172 return pack(NN => $high, $low) 173 } 174 else { 175 return pack(NN => 0, $_[0]) 176 } 177 } 178 }, 179 str => sub { pack(N => length($_[0])), $_[0] }, 180 char => sub { $_[0] }, 181 attr => sub { ${_attrs_as_buffer $_[0]} } ); 182 183sub put { 184 my $buf =shift; 185 @_ & 1 and croak "bad number of arguments for put (@_)"; 186 my @parts; 187 while (@_) { 188 my $type = shift; 189 my $value = shift; 190 my $packer = $pack{$type} or Carp::confess("internal error: bad packing type '$type'"); 191 push @parts, $packer->($value) 192 } 193 $$buf.=join('', @parts); 194} 195 1961; 197__END__ 198 199=head1 NAME 200 201Net::SFTP::Foreign::Buffer - Read/write buffer class 202 203=head1 SYNOPSIS 204 205 use Net::SFTP::Foreign::Buffer; 206 my $buffer = Net::SFTP::Foreign::Buffer->new; 207 208=head1 DESCRIPTION 209 210I<Net::SFTP::Foreign::Buffer> provides read/write buffer functionality for 211SFTP. 212 213=head1 AUTHOR & COPYRIGHTS 214 215Please see the Net::SFTP::Foreign manpage for author, copyright, and 216license information. 217 218=cut 219