package Catalyst::Plugin::SecureCookies;
use strict;

use CGI::Cookie;
use Symbol;
use Class::Accessor::Fast;
use Digest::SHA1;
use Crypt::CBC;
use MIME::Base64;

our $VERSION = 0.01;
our $CIPHER;

=head1 NAME

Catalyst::Plugin::SecureCookies - Tamper-resistant, encrypted HTTP Cookies

=head1 SYNOPSIS

 use Catalyst qw/SecureCookies/;
 MyApp->config->{SecureCookies} = {
     key       => $blowfish_key,
     ssl       => 1       # send the checksum over ssl
 };
 MyApp->setup;

 # later, in another part of MyApp...

 $c->request->exp_secure_cookies( $expiration );
 $c->request->set_secure_cookie( 'my_cookie_name', $value );
 my $secure_data = $c->request->get_secure_cookie('my_cookie_name');

=head1 DESCRIPTION

=head2 Overview

When HTTP cookies are used to store a user's state or identity it's
important that your application is able to distinguish legitimate
cookies from those that have been edited or created by a malicious
user.

This module creates a pair of cookies which encrypt a form so the
user cannot modify cookie contents.

=head2 Implementation

SecureCookies is implemented using Crypt::CBC and MIME::Base64
to encrypt and encode a urlencoded string representing a perl
hash.  The encoded string is then hashed using Digest::SHA1 to
prepare a sort of "checksum" or hash to make sure the user did
not modify the cookie.

=head1 CONFIGURATION

=over 4

=item key

 MyApp->config->{SecureCookies}->{key} = $secret_key;

This parameter is B<required>, and sets the secret key that is used to
encrypt the cookies with Crypt::CBC Blowfish.  This needs to be a
16 hex character string.


=item ssl

 MyApp->config->{SecureCookies}->{ssl} = 0;
   # or
 MyApp->config->{SecureCookies}->{ssl} = 1;

This parameter is optional, and will default to C<1> if not set.

If C<1>, the checksum or hash cookie will be sent over SSL for
added security.  This will prevent replay attacks from being
used against the server.

If C<0>, the checksum will be sent as a normal, non-secure cookie.

=back

=head1 DIAGNOSTICS

=over 4

=back

=cut

=head1 METHODS

=head2 Catalyst Request Object Methods

=over 4

=cut

*{Symbol::qualify_to_ref('SecureCookies', 'Catalyst::Request')} =
  Class::Accessor::Fast::make_accessor('Catalyst::Request', 'SecureCookies');


=item C<< $c->request->get_secure_cookie($cookie_name) >>

If a cookie was successfully authenticated then this method will
return the value of the cookie.

=cut

*{Symbol::qualify_to_ref('get_secure_cookie', 'Catalyst::Request')} = sub {
    my $self = shift;
    my $name = shift;

    return $self->SecureCookies->{$name};
};

# add a secure cookie to the output
*{Symbol::qualify_to_ref('set_secure_cookie', 'Catalyst::Response')} = sub {
    my $self  = shift;
    my $name  = shift;
    my $value = shift;
    $self->{SecureCookies}->{$name} = $value;
};


## set the cookie exp time
*{Symbol::qualify_to_ref('exp_secure_cookies', 'Catalyst::Response')} =
  Class::Accessor::Fast::make_accessor('Catalyst::Request', 'exp_secure_cookies');

sub setup {
    my $self = shift;

    $self->config->{SecureCookies}->{ssl} ||= 1;


    return $self->NEXT::setup(@_);
}

# remove and check hash in Cookie Values
sub prepare_cookies {
    my $c = shift;
    $c->NEXT::prepare_cookies(@_);

    ## pull out our secure dudes
    $c->request->{SecureCookies} = {};
    my $rJ = $c->request->cookie( 'rJ' );
    my $rC = $c->request->cookie( 'rC' );

    ## decrypt them
    if( $rJ && $rC ) {
	## decode it
	my $secret_form = &_decrypt( $c,
				     $rJ->value,   # encoded cookie
				     $rC->value ); # it's checksum
	if( $secret_form ) {
	    foreach my $key (keys %$secret_form) {
		$c->request->{SecureCookies}->{$key} = $secret_form->{$key};
	    }
	}
    }
    
    return $c;
}

# alter all Cookie Values to include a hash
sub finalize_cookies {
    my $c = shift;

    my $sc = $c->response->{SecureCookies};

    if( $sc ) {
	## pull in the existing secure cookies
	my $sco = $c->req->SecureCookies;
	if( $sco ) {
	    foreach my $key (keys %$sco) {
		if( ! defined($sc->{$key}) ) {
		    $sc->{$key} = $sco->{$key};
		}
	    }
	}

	## first encode the form
	my ($encoded, $csum) = &_encrypt( $c, $sc );

	## ssl, yes or no?
	my $ssl = $c->config->{SecureCookies}->{ssl};
	my $ssl_val = $ssl ? 1 : 0;

	## expiration?
	my $exp = $c->response->exp_secure_cookies();

	## make the two cookies
	$c->response->cookies->{rJ} = { value => $encoded,
				        expires => $exp };
	$c->response->cookies->{rC} = { value => $csum,
				        expires => $exp };

	my $domain = $c->config->{SecureCookies}->{cookie_domain};
	if( $domain ) {
		$c->response->cookies->{rJ}->{domain} = ".$domain";
		$c->response->cookies->{rJ}->{path} = '/';
		$c->response->cookies->{rC}->{domain} = ".$domain";
		$c->response->cookies->{rC}->{path} = '/';
	}
    }

    $c->NEXT::finalize_cookies(@_);
    return $c;
}

=item B<_encrypt>

Description:
  Takes a hashref representing web form elements, encrypts the components, creates a base64 safe url string

Args:
  $form_hasref - hashref of vars

Return:
  $encoded     - the encoded form
  $csum        - the checksum

=cut

sub _encrypt {
    my ( $c, $form_hashref ) = @_;

    my $cipher = &_get_cipher( $c->config->{SecureCookies}->{key} );

    ## first url encode it
    my $encoded = &_url_encode_hashref( $form_hashref );

    ## now we encrypt and mime encode it
    my $encrypted = $cipher->encrypt( $encoded );
#    $encrypted =~ s/^RandomIV//;
    my $mimed = &_base64_encode_url( $encrypted );

    ## checksum it
    my $ctx = new Digest::SHA1;
    $ctx->add( $mimed );
    my $csum = substr( &_base64_encode_url( $ctx->digest ), 3, 4 );

    ## give em what they want
    return ($mimed, $csum);
}

=item B<_decrypt>

Description:
  Takes a base64 safe url string representing form elements, decrypts the components, creates a hashref
m
Args:
  $encoded      - encoded form
  $csum         - csum for the form

Return:
  $form_hashref - hashref of the variables

=cut

sub _decrypt {
    my ( $c, $encoded, $csum ) = @_;

    my $cipher = &_get_cipher( $c->config->{SecureCookies}->{key} );

    ## calc a csum for the encrypted block
    my $ctx = new Digest::SHA1;
    $ctx->add( $encoded );

    my $this_csum = substr( &_base64_encode_url( $ctx->digest ), 3, 4 );

    ## compare it
    if( $csum ne $this_csum ) { return undef; }

    ## ok, the csum is good, decrypt
    my $encrypted = &_base64_decode_url( $encoded );
#    $encrypted = "RandomIV".$encrypted;
    my $dec = $cipher->decrypt( $encrypted );

    ## get the form
    my $form_hashref = &_url_decode_hashref( $dec );

    return $form_hashref;

}

=item B<_base64_encode_url>

Description:
 - safely encode using base64 to be used in urls

=cut

sub _base64_encode_url {
    my ($data, $separator) = @_;

    my $mimed = encode_base64( $data, $separator );

    ## convert to web friendlies
    $mimed =~ s/\s//g;
    $mimed =~ tr/[\+\/\=]/[\_\-.]/;
    return $mimed;
}

=item B<_base64_decode_url>

Description:
 - safely decode base64 from urls

=cut

sub _base64_decode_url {
    my ($mimed) = @_;

    ## convert from web friendlies
    $mimed =~ tr/[\_\-.]/[\+\/\=]/;

    return decode_base64( $mimed );
}

sub _get_cipher {
    my $key = shift;
    if ( !$CIPHER ) {
	$CIPHER = new Crypt::CBC( -key => pack("H16", $key), 
				  -cipher => 'Blowfish' );
    }
    return $CIPHER;
}

sub _url_encode_hashref {
    my ($form_hashref) = @_;

    ## bail if it's not a form
    if( !defined($form_hashref) ) { return ''; }

    ## run through the data, convert
    my @pairs;
    foreach my $key (keys %{$form_hashref}) {
	## grab the value
	my $val = $form_hashref->{$key};

	## support for array
	my @vals;
	if( ref($val) eq 'ARRAY' ) {
	    @vals = @$val;
	}
	else {
	    push( @vals, $val );
	}


	## encode the key and val
	foreach my $val1 (@vals) {
	    my $keye = &_urlencode_string( defined ( $key )  ? $key  : '' );
	    my $vale = &_urlencode_string( defined ( $val1 ) ? $val1 : '' );

	    ## save
	    push( @pairs, "$keye=$vale" );
	}
    }

    ## return the string
    return join( "&", @pairs );
}


=item B<decode_url_hashref>

Description:

convert a get string ( key1=val1&key2=val2 ) to a hash representing a
web form. If you are really using a get string, you must be sure to
only pass in the text after the question mark.

Args:
  $url_encoded   - parse this text

Return:
  $form       - hashref of the variables

=cut

sub _url_decode_hashref {
    my ($url_encoded) = @_;

    my %form;
    foreach (split(/&/,$url_encoded)) {

	## convert plus's to spaces
	s/\+/ /g;

	## split into key and value.
	my ($key, $val) = split(/\=/,$_,2 );

	## convert %XX from hex numbers to alphanumeric
	$key =~ s/%(..)/pack("c",hex($1))/ge if $key;
	$val =~ s/%(..)/pack("c",hex($1))/ge if $val;

	## associate key and value, multiple vars get tab delimination
	$form{$key} .= "\t" if ( defined($form{$key}) );
	$form{$key} .= $val if ( defined($val) );
    }

    return \%form;
}


=item B<_urlencode_string>

Description:
  convert $string into a url safe format

=cut

sub _urlencode_string {
    my ($string) = @_;

    ## standard urlencode
    $string =~ s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
    $string =~ s/ /\+/g;

    return $string;
}

=back

=head1 SEE ALSO

L<Catalyst>, L<Digest::SHA1>, L<Crypt::CBC>, L<MIME::Base64>

L<http://www.schneier.com/blog/archives/2005/08/new_cryptanalyt.html>

=head1 AUTHOR

Rob Johnson L<rob@giant-rock.com>

=head1 ACKNOWLEDGEMENTS

 * Karim A. Nassar for converting this into a self-contained Catalyst Plugin.

 * All the helpful people in #catalyst.

=head1 COPYRIGHT

Copyright (c) 2007 Karim A. Nassar <karim.nassar@acm.org>

You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.

=cut

1;