—package
Text::Netstring;
use
strict;
require
Exporter;
#
# Copyright (c) 2003-2006 James Raftery <james@now.ie>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
# Please submit bug reports, patches and comments to the author.
# Latest information at http://romana.now.ie/
#
# $Id: Netstring.pm,v 1.13 2006/11/20 18:28:49 james Exp $
#
# See the Text::Netstring man page that was installed with this module for
# information on how to use the module.
#
@ISA
=
qw(Exporter)
;
# Items to export into caller's namespace by request.
@EXPORT_OK
=
qw(
netstring_encode netstring_decode netstring_verify netstring_read
)
;
$VERSION
=
'0.07'
;
sub
netstring_encode {
# is argument a list reference?
@_
= @{
$_
[0]}
if
(
scalar
(
@_
)==1 and
ref
(
$_
[0]) eq
"ARRAY"
);
my
@enc
=
map
{
length
(
$_
).
":${_},"
}
@_
;
wantarray
?
@enc
:
join
(
""
,
@enc
);
}
sub
netstring_decode {
# is argument a list reference?
@_
= @{
$_
[0]}
if
(
scalar
(
@_
)==1 and
ref
(
$_
[0]) eq
"ARRAY"
);
my
@dec
=
map
{ /^(\d+):(.*),$/s and
length
($2)==$1 ? $2 :
""
}
@_
;
wantarray
?
@dec
:
join
(
""
,
@dec
);
}
sub
netstring_verify {
# is argument a list reference?
@_
= @{
$_
[0]}
if
(
scalar
(
@_
)== 1 and
ref
(
$_
[0]) eq
"ARRAY"
);
my
@ver
=
map
{ /^(\d+):(.*),$/s and
length
($2)==$1 }
@_
;
wantarray
?
@ver
:
do
{
my
$i
=
shift
(
@ver
);
foreach
(
@ver
) {
$i
&&=
$_
};
$i
};
}
sub
netstring_read {
my
$sock
=
shift
or
return
undef
;
my
(
$r
,
$ns
);
my
$s
=
""
;
my
$len
= 0;
# read the length
for
(;;) {
defined
(
$r
=
read
(
$sock
,
$s
, 1)) or
return
undef
;
return
""
if
!
$r
;
last
if
$s
eq
":"
;
return
undef
if
$s
!~ /^[0-9]$/;
$len
= 10 *
$len
+
$s
;
return
undef
if
$len
> 200000000;
}
$ns
=
$len
.
":"
;
$s
=
""
;
# read the string 'body'
defined
(
$r
=
read
(
$sock
,
$s
,
$len
)) or
return
undef
;
return
""
if
(!
$r
and
$len
!= 0);
# zero length is OK
$ns
.=
$s
;
# read the trailing comma
defined
(
$r
=
read
(
$sock
,
$s
, 1)) or
return
undef
;
return
""
if
!
$r
;
return
undef
if
$s
ne
","
;
$ns
.=
$s
;
return
$ns
;
}
1;
__END__
=head1 NAME
Text::Netstring - Perl module for manipulation of netstrings
=head1 SYNOPSIS
use Text::Netstring qw(netstring_encode netstring_decode
netstring_verify netstring_read);
$ns = netstring_encode($text);
@ns = netstring_encode(@text);
$ns = netstring_encode(@text);
$text = netstring_decode($ns);
@text = netstring_decode(@ns);
$text = netstring_decode(@ns);
$valid = netstring_verify($string);
@valid = netstring_verify(@string);
$valid = netstring_verify(@string);
$ns = netstring_read($socket);
=head1 DESCRIPTION
This module is a collection of functions to make use of netstrings in
your perl programs. A I<netstring> is a string encoding used by, at
least, the QMTP and QMQP email protocols.
=over 4
=item netstring_encode()
Encode the argument string, list of strings, or referenced list of
strings as a netstring.
Supplying a scalar argument in a scalar context, or a list or list
reference argument in list context, does what you'd expect; encoding the
scalar or each element of the list as appropriate. Supplying a list or
list reference argument in a scalar context, however, returns a single
scalar which is the concatenation of each element of the list encoded as
a netstring.
=item netstring_decode()
Decode the argument netstring, list of netstrings, or referenced list of
netstrings returning the I<interpretation> of each. You should use
C<netstring_verify()> over any data before you try to decode it. An
invalid netstring will be returned as an empty string.
The same scalar/list context handling as for netstring_encode() applies.
=item netstring_verify()
Check the validity of the supplied netstring, list of netstrings or
referenced list of netstrings. Returns a C<TRUE> or C<FALSE> value, or
list of same, as appropriate. Supplying a list argument in a scalar
context will return a single boolean value which is C<TRUE> if and only
if each element of the argument list was successfully verified,
otherwise it's C<FALSE>.
=item netstring_read()
Read the next netstring from a socket reference supplied as an argument.
The function returns a scalar which is the netstring read from the
socket. You will need to use netstring_decode() on the return value to
obtain the string I<interpretation>. Returns undef in case of an error,
or an empty string ("") if a premature EOF was encountered.
This function will regard a netstring claiming to be larger than
200,000,000 characters as an error, yielding undef.
=back
=head1 EXAMPLES
use Text::Netstring qw(netstring_encode netstring_decode);
@s = ("foo", "bar");
$t = netstring_encode( scalar netstring_encode(@s) );
C<12:3:foo,3:bar,,> is the value of C<$t>
$s = ["5:whizz," , "4:bang,"];
$t = netstring_decode($s);
C<whizzbang> is the value of C<$t>
=head1 NOTES
The format of a netstring is described in http://cr.yp.to/proto/qmtp.txt
=head1 LICENSE
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. (Being a speaker of British english,
I'd call it a "licence" though)
=head1 AUTHOR
James Raftery <james@now.ie>.
=cut