X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FStorage%2FBase%2FWithChecksum.pm;h=73459c201f90c517466a150bbc7115d1f3c0bb05;hb=e44b5f5498b782752d2c91b6796698c86143a2f0;hp=fb40bcfb14265e504e578f731cc1112368826a79;hpb=06a66732eb48842ce6bea1259cf4570cc34d99ff;p=gitmo%2FMooseX-Storage.git diff --git a/lib/MooseX/Storage/Base/WithChecksum.pm b/lib/MooseX/Storage/Base/WithChecksum.pm index fb40bcf..73459c2 100644 --- a/lib/MooseX/Storage/Base/WithChecksum.pm +++ b/lib/MooseX/Storage/Base/WithChecksum.pm @@ -1,43 +1,41 @@ - package MooseX::Storage::Base::WithChecksum; use Moose::Role; +with 'MooseX::Storage::Basic'; + use Digest (); use Data::Dumper (); -use MooseX::Storage::Engine; - -our $VERSION = '0.01'; +our $VERSION = '0.32'; +our $AUTHORITY = 'cpan:STEVAN'; our $DIGEST_MARKER = '__DIGEST__'; -sub pack { - my ($self, @args ) = @_; +around pack => sub { + my $orig = shift; + my $self = shift; + my @args = @_; - my $e = MooseX::Storage::Engine->new( object => $self ); + my $collapsed = $self->$orig( @args ); - my $collapsed = $e->collapse_object(@args); - $collapsed->{$DIGEST_MARKER} = $self->_digest_packed($collapsed, @args); - + return $collapsed; -} +}; -sub unpack { - my ($class, $data, @args) = @_; +around unpack => sub { + my ($orig, $class, $data, @args) = @_; # check checksum on data - my $old_checksum = delete $data->{$DIGEST_MARKER}; - + my $checksum = $class->_digest_packed($data, @args); ($checksum eq $old_checksum) - || confess "Bad Checksum got=($checksum) expected=($old_checksum)"; + || confess "Bad Checksum got=($checksum) expected=($old_checksum)"; - my $e = MooseX::Storage::Engine->new(class => $class); - $class->new($e->expand_object($data, @args)); -} + $class->$orig( $data, @args ); +}; sub _digest_packed { @@ -48,7 +46,18 @@ sub _digest_packed { { local $Data::Dumper::Indent = 0; local $Data::Dumper::Sortkeys = 1; - $d->add( Data::Dumper::Dumper($collapsed) ); + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Useqq = 0; + local $Data::Dumper::Deparse = 0; # FIXME? + my $str = Data::Dumper::Dumper($collapsed); + # NOTE: + # Canonicalize numbers to strings even if it + # mangles numbers inside strings. It really + # does not matter since its just the checksum + # anyway. + # - YK/SL + $str =~ s/(?add( $str ); } return $d->hexdigest; @@ -57,29 +66,31 @@ sub _digest_packed { sub _digest_object { my ( $self, %options ) = @_; my $digest_opts = $options{digest}; - - $digest_opts = [ $digest_opts ] + + $digest_opts = [ $digest_opts ] if !ref($digest_opts) or ref($digest_opts) ne 'ARRAY'; - + my ( $d, @args ) = @$digest_opts; if ( ref $d ) { if ( $d->can("clone") ) { return $d->clone; - } + } elsif ( $d->can("reset") ) { $d->reset; return $d; - } + } else { die "Can't clone or reset digest object: $d"; } - } + } else { - return Digest->new($d || "SHA1", @args); + return Digest->new($d || "SHA-1", @args); } } +no Moose::Role; + 1; __END__ @@ -88,12 +99,17 @@ __END__ =head1 NAME -MooseX::Storage::Base::WithChecksum - -=head1 SYNOPSIS +MooseX::Storage::Base::WithChecksum - A more secure serialization role =head1 DESCRIPTION +This is an early implementation of a more secure Storage role, +which does integrity checks on the data. It is still being +developed so I recommend using it with caution. + +Any thoughts, ideas or suggestions on improving our technique +are very welcome. + =head1 METHODS =over 4 @@ -114,7 +130,7 @@ MooseX::Storage::Base::WithChecksum =head1 BUGS -All complex software has bugs lurking in it, and this module is no +All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. @@ -126,7 +142,7 @@ Yuval Kogman =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Infinity Interactive, Inc. +Copyright 2007-2008 by Infinity Interactive, Inc. L