CGI-Cookie-Splitter-0.02/0000755000076500007650000000000010557437723017767 5ustar nothingmuchnothingmuch00000000000000CGI-Cookie-Splitter-0.02/Changes0000644000076500007650000000021710557350242021250 0ustar nothingmuchnothingmuch000000000000000.02 - Change the CGI::Simple prereq so it works better on debian - Increase the serialization overhead futz number 0.01 - Initial release CGI-Cookie-Splitter-0.02/lib/0000755000076500007650000000000010557437707020537 5ustar nothingmuchnothingmuch00000000000000CGI-Cookie-Splitter-0.02/lib/CGI/0000755000076500007650000000000010557437707021141 5ustar nothingmuchnothingmuch00000000000000CGI-Cookie-Splitter-0.02/lib/CGI/Cookie/0000755000076500007650000000000010557437707022352 5ustar nothingmuchnothingmuch00000000000000CGI-Cookie-Splitter-0.02/lib/CGI/Cookie/Splitter.pm0000644000076500007650000001531310557437610024512 0ustar nothingmuchnothingmuch00000000000000#!/usr/bin/perl package CGI::Cookie::Splitter; use strict; use warnings; use vars qw/$VERSION/; $VERSION = "0.02"; use Scalar::Util qw/blessed/; use CGI::Simple::Util qw/escape unescape/; use Carp qw/croak/; sub new { my ( $class, %params ) = @_; $params{size} = 4096 unless exists $params{size}; croak "size has to be a positive integer ($params{size} is invalid)" unless $params{size} =~ /^\d+$/ and $params{size} > 1; bless \%params, $class; } sub size { $_[0]{size} } sub split { my ( $self, @cookies ) = @_; map { $self->split_cookie($_) } @cookies; } sub split_cookie { my ( $self, $cookie ) = @_; return $cookie unless $self->should_split( $cookie ); return $self->do_split_cookie( $self->new_cookie( $cookie, name => $self->mangle_name( $cookie->name, 0 ), value => CORE::join("&",map { escape($_) } $cookie->value) # simplifies the string splitting ) ); } sub do_split_cookie { my ( $self, $head ) = @_; my $tail = $self->new_cookie( $head, value => '', name => $self->mangle_name_next( $head->name ) ); my $max_value_size = $self->size - ( $self->cookie_size( $head ) - length( escape($head->value) ) ); $max_value_size -= 30; # account for overhead the cookie serializer might add die "Internal math error, please file a bug for CGI::Cookie::Splitter: max size should be > 0, but is $max_value_size (perhaps other attrs are too big?)" unless ( $max_value_size > 0 ); my ( $head_v, $tail_v ) = $self->split_value( $max_value_size, $head->value ); $head->value( $head_v ); $tail->value( $tail_v ); die "Internal math error, please file a bug for CGI::Cookie::Splitter" unless $self->cookie_size( $head ) <= $self->size; # 10 is not enough overhead return $head unless $tail_v; return ( $head, $self->do_split_cookie( $tail ) ); } sub split_value { my ( $self, $max_size, $value ) = @_; my $adjusted_size = $max_size; my ( $head, $tail ); return ( $value, '' ) if length($value) <= $adjusted_size; split_value: { croak "Can't reduce the size of the cookie anymore (adjusted = $adjusted_size, max = $max_size)" unless $adjusted_size > 0; $head = substr( $value, 0, $adjusted_size ); $tail = substr( $value, $adjusted_size ); if ( length(my $escaped = escape($head)) > $max_size ) { my $adjustment = int( ( length($escaped) - length($head) ) / 3 ) + 1; die "Internal math error, please file a bug for CGI::Cookie::Splitter" unless $adjustment; $adjusted_size -= $adjustment; redo split_value; } } return ( $head, $tail ); } sub cookie_size { my ( $self, $cookie ) = @_; length( $cookie->as_string ); } sub new_cookie { my ( $self, $cookie, %params ) = @_; for (qw/name secure path domain expires value/) { next if exists $params{$_}; $params{"-$_"} = $cookie->$_; } blessed($cookie)->new( %params ); } sub should_split { my ( $self, $cookie ) = @_; $self->cookie_size( $cookie ) > $self->size; } sub join { my ( $self, @cookies ) = @_; my %split; my @ret; foreach my $cookie ( @cookies ) { my ( $name, $index ) = $self->demangle_name( $cookie->name ); if ( $name ) { $split{$name}[$index] = $cookie; } else { push @ret, $cookie; } } foreach my $name ( keys %split ) { my $split_cookie = $split{$name}; croak "The cookie $name is missing some chunks" if grep { !defined } @$split_cookie; push @ret, $self->join_cookie( $name => @$split_cookie ); } return @ret; } sub join_cookie { my ( $self, $name, @cookies ) = @_; $self->new_cookie( $cookies[0], name => $name, value => $self->join_value( map { $_->value } @cookies ) ); } sub join_value { my ( $self, @values ) = @_; return [ map { unescape($_) } split('&', CORE::join("", @values)) ]; } sub mangle_name_next { my ( $self, $mangled ) = @_; my ( $name, $index ) = $self->demangle_name( $mangled ); $self->mangle_name( $name, $index+1 ); # can't trust magic incr because it might overflow and fudge 'chunk' } sub mangle_name { my ( $self, $name, $index ) = @_; return sprintf '_bigcookie_%s_chunk%d', $name, $index; } sub demangle_name { my ( $self, $mangled_name ) = @_; my ( $name, $index ) = ( $mangled_name =~ /^_bigcookie_(.+?)_chunk(\d+)$/ ); return ( $name, $index ); } __PACKAGE__; __END__ =pod =head1 NAME CGI::Cookie::Splitter - Split big cookies into smaller ones. =head1 SYNOPSIS use CGI::Cookie::Splitter; my $splitter = CGI::Cookie::Splitter->new( size => 123, # defaults to 4096 ); @small_cookies = $splitter->split( @big_cookies ); @big_cookies = $splitter->join( @small_cookies ); =head1 DESCRIPTION RFC 2109 reccomends that the minimal cookie size supported by the client is 4096 bytes. This has become a pretty standard value, and if your server sends larger cookies than that it's considered a no-no. This module provides a pretty simple interface to generate small cookies that are under a certain limit, without wasting too much effort. =head1 METHODS =over 4 =item new %params The only supported parameters right now are C. It defaults to 4096. =item split @cookies This method accepts a list of CGI::Cookie objects (or look alikes) and returns a list of CGI::Cookies. Whenever an object with a total size that is bigger than the limit specified at construction time is encountered it is replaced in the result list with several objects of the same class, which are assigned serial names and have a smaller size and the same domain/path/expires/secure parameters. =item join @cookies This is the inverse of C. =item should_split $cookie Whether or not the cookie should be split =item mangle_name_next $name Demangles name, increments the index and remangles. =item mangle_name $name, $index =item demangle_name $mangled_name These methods encapsulate a name mangling scheme for changing the cookie names to allo wa 1:n relationship. The default mangling behavior is not 100% safe because cookies with a safe size are not mangled. As long as your cookie names don't start with the substring C<_bigcookie_> you should be OK ;-) =back =head1 SUBCLASSING This module is designed to be easily subclassed... If you need to split cookies using a different criteria then you should look into that. =head1 SEE ALSO L, L, L, L, RFC 2109 =head1 VERSION CONTROL This module is maintained using Darcs. You can get the latest version from L, and use C to commit changes. =head1 AUTHOR Yuval Kogman, C =head1 COPYRIGHT & LICENCE Copyright (c) 2006 the aforementioned authors. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut CGI-Cookie-Splitter-0.02/Makefile.PL0000644000076500007650000000042310557437454021741 0ustar nothingmuchnothingmuch00000000000000use ExtUtils::MakeMaker; WriteMakefile ( NAME => 'CGI::Cookie::Splitter', VERSION_FROM => 'lib/CGI/Cookie/Splitter.pm', INSTALLDIRS => 'site', PL_FILE => {}, SIGN => 1, PREREQ_PM => { 'CGI::Simple' => '0', 'Test::use::ok' => '0', }, ) ; CGI-Cookie-Splitter-0.02/MANIFEST0000644000076500007650000000026310557437707021123 0ustar nothingmuchnothingmuch00000000000000Changes lib/CGI/Cookie/Splitter.pm Makefile.PL MANIFEST This list of files META.yml t/basic.t SIGNATURE Public-key signature (added by MakeMaker) CGI-Cookie-Splitter-0.02/META.yml0000644000076500007650000000061310557437707021242 0ustar nothingmuchnothingmuch00000000000000--- #YAML:1.0 name: CGI-Cookie-Splitter version: 0.02 abstract: ~ license: ~ generated_by: ExtUtils::MakeMaker version 6.31 distribution_type: module requires: CGI::Simple: 0 Test::use::ok: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 CGI-Cookie-Splitter-0.02/SIGNATURE0000644000076500007650000000205710557437723021257 0ustar nothingmuchnothingmuch00000000000000This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 99a155c9e71068e0400c2a9bcd7e2558ab371971 Changes SHA1 51c1f8e15be8846610b29221f125abae9ac3f1db MANIFEST SHA1 dfeac16a99140b9932f6e1c643f4665ac38700c1 META.yml SHA1 45c656a21b65c90777a5b82e657ab592f351e2ac Makefile.PL SHA1 a252fbec4634a7fe8e5b3c412ddd5c242e672cb8 lib/CGI/Cookie/Splitter.pm SHA1 f1e217abe342e8544c172e30cd520c5138f18f6f t/basic.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.5 (Darwin) iD8DBQFFvj/TVCwRwOvSdBgRAsUsAJ4/4seg3j1V6027HH6j8tuWTeBTPgCfR+QY DT1VzPUubjjL4hIePZiaK0c= =OfSm -----END PGP SIGNATURE----- CGI-Cookie-Splitter-0.02/t/0000755000076500007650000000000010557437707020234 5ustar nothingmuchnothingmuch00000000000000CGI-Cookie-Splitter-0.02/t/basic.t0000644000076500007650000000574510557437627021516 0ustar nothingmuchnothingmuch00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; use ok "CGI::Cookie::Splitter"; my @cookie_classes = grep { eval "require $_; 1" } qw/CGI::Simple::Cookie CGI::Cookie/; my @cases = ( # big numbers are used to mask the overhead of the other fields { size_limit => 4096, num_cookies => 1, cookie => { -name => "a", -value => [ qw/foo bar gorch baz/ ], -damain => "www.example.com", -path => "/foo", -secure => 0, }, }, { size_limit => 1000, num_cookies => 11, cookie => { -name => "b", -value => ("a" x 10_000), }, }, { size_limit => 10_000, num_cookies => 1, cookie => { -name => "c", -value => "this is a simple value", } }, { size_limit => 1000, num_cookies => 11, cookie => { -name => "d", -domain => ".foo.com", -value => [ ("a" x 1000) x 10 ], }, }, { size_limit => 1000, num_cookies => 15, # feck cookie => { -name => "e", -path => "/bar/gorch", -value => [ ("a" x 10) x 1000 ], }, }, { size_limit => 1000, num_cookies => 3, cookie => { -name => "f", secure => 1, -value => { foo => ("a" x 1000), bar => ("b" x 1000) }, }, }, ); foreach my $class ( @cookie_classes ) { foreach my $case ( @cases ) { my ( $size_limit, $num_cookies ) = @{ $case }{qw/size_limit num_cookies/}; my $big = $class->new(%{ $case->{cookie} }); can_ok( "CGI::Cookie::Splitter", "new" ); my $splitter = CGI::Cookie::Splitter->new( size => $size_limit ); # 50 is padding for the other attrs isa_ok( $splitter, "CGI::Cookie::Splitter" ); can_ok( $splitter, "split" ); my @small = $splitter->split( $big ); is( scalar(@small), $num_cookies, "returned several smaller cookies" ); my $i = 0; foreach my $cookie ( @small ) { cmp_ok( length($cookie->as_string), "<=", $size_limit, "cookie size is under specified limit" ); if ( $splitter->should_split($big) ) { is_deeply( [ $splitter->demangle_name($cookie->name) ], [ $big->name => $i++ ], "name mangling looks good (" . $cookie->name . ")" ); } } my @big = $splitter->join( @small ); is( scalar(@big), 1, "one big cookie from small cookies" ); foreach my $field ( qw/name value domain path secure/ ) { is_deeply( [ $big[0]->$field ], [ $big->$field ], "'$field' is the same" ); } } my @all_cookies = map { $class->new( %{ $_->{cookie} } ) } @cases; my $splitter = CGI::Cookie::Splitter->new; my @split = $splitter->split( @all_cookies ); foreach my $cookie ( @split ) { cmp_ok( length($cookie->as_string), "<=", 4096, "cookie size is under specified limit" ); }; my @all_joined = $splitter->join( @split ); is( scalar(@all_joined), scalar(@all_cookies), "count is the same after join" ); @all_joined = sort { $a->name cmp $b->name } @all_joined; while( @all_joined and my($joined, $orig) = ( shift @all_joined, shift @all_cookies ) ) { foreach my $field ( qw/name value domain path secure/ ) { is_deeply( eval { [ $joined->$field ] }, eval { [ $orig->$field ] }, "'$field' is the same" ); } } }