X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FStorage%2FBase%2FWithChecksum.pm;h=207f388c56078beb1fff9171066dc0b715d8c989;hb=1f3074ea2b80c4c8dfc081414f87285bc7892c82;hp=d2aa691ca78f12cfecb4586ace3c31f6028ebfb1;hpb=88651e76ff418daf49a8b2b7f3bf4604af87d6ff;p=gitmo%2FMooseX-Storage.git diff --git a/lib/MooseX/Storage/Base/WithChecksum.pm b/lib/MooseX/Storage/Base/WithChecksum.pm index d2aa691..207f388 100644 --- a/lib/MooseX/Storage/Base/WithChecksum.pm +++ b/lib/MooseX/Storage/Base/WithChecksum.pm @@ -2,20 +2,22 @@ package MooseX::Storage::Base::WithChecksum; use Moose::Role; -use Digest (); -use Storable (); +use Digest (); +use Data::Dumper (); + use MooseX::Storage::Engine; -our $VERSION = '0.01'; +our $VERSION = '0.02'; +our $AUTHORITY = 'cpan:STEVAN'; -our $DIGEST_MARKER = '__DIGEST__' +our $DIGEST_MARKER = '__DIGEST__'; sub pack { my ($self, @args ) = @_; my $e = MooseX::Storage::Engine->new( object => $self ); - my $collapsed = $e->collapse_object; + my $collapsed = $e->collapse_object(@args); $collapsed->{$DIGEST_MARKER} = $self->_digest_packed($collapsed, @args); @@ -27,8 +29,7 @@ sub unpack { # check checksum on data - my $old_checksum = $data->{$DIGEST_MARKER}; - delete $data->{$DIGEST_MARKER}; + my $old_checksum = delete $data->{$DIGEST_MARKER}; my $checksum = $class->_digest_packed($data, @args); @@ -36,36 +37,61 @@ sub unpack { || confess "Bad Checksum got=($checksum) expected=($old_checksum)"; my $e = MooseX::Storage::Engine->new(class => $class); - $class->new($e->expand_object($data)); + $class->new($e->expand_object($data, @args)); } sub _digest_packed { my ( $self, $collapsed, @args ) = @_; - my $d = shift @args; + my $d = $self->_digest_object(@args); + + { + local $Data::Dumper::Indent = 0; + local $Data::Dumper::Sortkeys = 1; + 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; +} + +sub _digest_object { + my ( $self, %options ) = @_; + my $digest_opts = $options{digest}; + + $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") ) { - $d = $d->clone; - } elsif ( $d->can("reset") ) { + return $d->clone; + } + elsif ( $d->can("reset") ) { $d->reset; - } else { + return $d; + } + else { die "Can't clone or reset digest object: $d"; } - } else { - $d = Digest->new($d || "SHA1", @args); + } + else { + return Digest->new($d || "SHA1", @args); } - - { - local $Storable::canonical = 1; - $d->add( Storable::nfreeze($collapsed) ); - } - - return $d->hexdigest; } - 1; __END__ @@ -74,12 +100,17 @@ __END__ =head1 NAME -MooseX::Storage::Base::WithChecksum - -=head1 SYNOPSIS +MooseX::Storage::Base::WithChecksum =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 @@ -108,9 +139,11 @@ to cpan-RT. Stevan Little Estevan.little@iinteractive.comE +Yuval Kogman + =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Infinity Interactive, Inc. +Copyright 2007-2008 by Infinity Interactive, Inc. L