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