Cook results from the CPAN

Cook

Apache-iNcom

view release on metacpan or search on metacpan

#
#    iNcom.pm - Main module of the iNcom package.
#
#    This file is part of Apache::iNcom
#
#    Author: Francis J. Lacoste <francis.lacoste@iNsu.COM>
#
#    Copyright (C) 1999 Francis J. Lacoste, iNsu Innovations
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
package Apache::iNcom;

use strict;

require 5.005;

use DBI;

use Apache;
use Apache::Log;
use Apache::Cookie;
use Apache::Request;
use Apache::File;
use Apache::Constants qw( :common :response HTTP_PRECONDITION_FAILED );

use HTML::Embperl;

use Apache::iNcom::Request;
use Apache::iNcom::Localizer;

use vars qw($VERSION);
BEGIN {
    ($VERSION) = '0.09';
}

my %VALID_PNOTES = map { $_ => 1 } qw (
    INCOM_SESSION INCOM_DBH INCOM_LOCALIZER INCOM_COOKIES
);

# Grabbed from CGI.pm by Lincoln Stein
sub offset_calc {
    my($time) = @_;
    my(%mult) = ('s'=>1,
                 'm'=>60,
                 'h'=>60*60,
                 'd'=>60*60*24,
                 'M'=>60*60*24*30,
                 'y'=>60*60*24*365);
    # format for time can be in any of the forms...
    # "now" -- expire immediately
    # "+180s" -- in 180 seconds
    # "+2m" -- in 2 minutes
    # "+12h" -- in 12 hours
    # "+1d"  -- in 1 day
    # "+3M"  -- in 3 months
    # "+2y"  -- in 2 years
    # "-3m"  -- 3 minutes ago(!)
    my($offset);
    if (!$time || (lc($time) eq 'now')) {
        $offset = 0;
    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
        $offset = ($mult{$2} || 1)*$1;
    } else {
	die "invalid expiration offset: $time\n";
    }
    return ($offset);
}

sub db_init {
    my $r = shift;
    my $dsn	= $r->dir_config( "INCOM_DBI_DSN" );
    my $user	= $r->dir_config( "INCOM_DBI_USER" );
    my $passwd	= $r->dir_config( "INCOM_DBI_PASSWD" );

    unless ( $dsn ) {
	$r->log_error( "iNcom configuration error: INCOM_DBI_DSN is not defined" );
	return SERVER_ERROR;
    }

    my $dbh;
    eval {

lib/Apache/iNcom.pm view on Meta::CPAN


sub i18n_init {
    my $r = shift;

    my $langs = $r->header_in( "Accept-Language" );
    my @languages;
    if ( $langs ) {
	my $q = 100;
	@languages = map {
	    $_->[0];
	} sort { $b->[1] <=> $a->[1] } map {
	    my $l;
	    if ( /([-\w]+)\s*;\s*q=([\d.]+)/ ) {
		$l = [$1, $2 ];
	    } else {
		$l = [$_, $q--];
	    }
	} split /\s*,\s*/, $langs;
    }

    # Add the language set in cookies
    my $cookies = $r->pnotes( "INCOM_COOKIES" );
    unshift @languages, $cookies->{INCOM_LANGUAGE}->value
      if $cookies->{INCOM_LANGUAGE};

    # Check each languages tags for validity
    my $localizer =
      new Apache::iNcom::Localizer( $r->dir_config( "INCOM_DEFAULT_LANGUAGE" ) || "en",
				    @languages
				  );

    # Set environment variables so that other parts of the system
    # does hopefully the Right Things(tm)
    $ENV{LANG} = $localizer->preferred_lang;

    # Long live GNU !
    $ENV{LANGUAGE} = join ":", $localizer->preferred_langs,
      $localizer->default_lang;

    # Cache it for further use.
    $r->pnotes( "INCOM_LOCALIZER", $localizer );

    return OK;
}

*Apache::iNcom::handler = \&request_init;

sub request_init {
    my $r = shift;

    # If we are in a subrequest, just copy
    # what was initialized to the new request
    if ( $r->is_main ) {
	my $prefix	    = $r->dir_config( "INCOM_URL_PREFIX" ) || "/";
	unless ( $prefix =~ m|/$| ) {
	    $r->log_error( "iNcom configuration error: INCOM_URL_PREFIX must ends with /" );
	    return SERVER_ERROR;
	}

	# Parse cookies
	my $c = $r->header_in( "Cookie" );
	my $cookies = Apache::Cookie->new( $r )->parse( $c );
	$r->pnotes( "INCOM_COOKIES", $cookies );

	# Parse languages
	my $rv = i18n_init( $r );
	return $rv if $rv != OK;

    } else {
	my $prev = $r->prev;
	foreach my $name ( keys %VALID_PNOTES ) {
	    $r->pnotes( $name, $prev->pnotes( $name ) );
	}
	return OK;
    }

    # Next handler is dispatch_handler
    $r->push_handlers( PerlTransHandler => \&dispatch_handler );

    return OK;
}

sub bake_session_cookie {
    my ($r, $session_id) = @_;

    my $prefix		= $r->dir_config( "INCOM_URL_PREFIX" ) || "/";
    my $session_secure  = $r->dir_config( "INCOM_SESSION_SECURE" );
    my $session_domain  = $r->dir_config( "INCOM_SESSION_DOMAIN" );
    my $session_expires = $r->dir_config( "INCOM_SESSION_EXPIRES" );
    my $session_path    = $r->dir_config( "INCOM_SESSION_PATH" )
      || $prefix;

    my $cookie = new Apache::Cookie( $r,
				     -name   => "INCOM_SESSION",
				     -value  => $session_id,
				     -path   => $session_path
				   );
    $cookie->domain( $session_domain )	    if $session_domain;
    $cookie->expires( $session_expires )    if $session_expires;
    $cookie->secure( 1 )		    if $session_secure;

    # Add cookie to outgoing headers
    $cookie->bake;
}

sub session_init {
    my $r = shift;

    my %session;

    # Check if there is a session id in the cookies
    my $cookies = $r->pnotes( "INCOM_COOKIES" );
    if ( $cookies->{INCOM_SESSION} ) {
	my $session_id = $cookies->{INCOM_SESSION}->value;

	# Load the user's session
	eval {
	    # Make sure it looks like a session id
	    die "Invalid session id: $session_id\n"
	      unless length $session_id == 32 &&
		$session_id =~ tr/a-fA-F0-9/a-fA-F0-9/ == 32;

	    tie %session, 'Apache::iNcom::Session', $session_id,
	      { dbh => $r->pnotes( "INCOM_DBH"),
		Serialize => $r->dir_config( "INCOM_SESSION_SERIALIZE_ACCESS" ),
	      };

	    # Save the session for future handlers
	    $r->pnotes( INCOM_SESSION => \%session );

	    if ( $r->dir_config( "INCOM_SESSION_EXPIRES" ) ) {
		# If session doesn't expire with the browser session
		# we must renew the cookie.
		bake_session_cookie( $r, $session_id );
	    }

	};
	if ( $@ ) {
	    # The session ID is probably invalid
	    chomp $@;
	    $r->warn( "error loading session: $@" );
	} else {
	    # Return ref to session to indicate success
	    return \%session;
	}
    }

    # No valid session could be loaded
    return undef;
}


# Return the requested error code but sets a custom response

lib/Apache/iNcom.pm view on Meta::CPAN

    my $response = eval {
	my $profile = do $map;
	unless ( ref $profile eq "HASH" ) {
	    $r->warn( "INCOM_ERROR_PROFILE didn't return an hash ref" );
	    return $status;
	}

	my $error_cond = $r->pnotes( "INCOM_ERROR" );

	$profile->{$error_cond} || $profile->{$status};
    };
    if ( $@) {
	$r->warn( "error while evaluating error profile: $@" );
	return $status;
    }

    $r->custom_response( $status, $prefix . "/incom_error/" . $response ) if $response;

    return $status;
}

# This is a handler used to transform the request
# to an action. It is invoked during the URI
# translation phase of the request
#
# It is responsible for loading the user session. If
# there is no session it sets the content handler to
# the new_session_handler
sub dispatch_handler {
    my $r = shift;

    # Get configuration
    my $prefix	    = $r->dir_config( "INCOM_URL_PREFIX" ) || "/";
    my $index_file  = $r->dir_config( "INCOM_INDEX" )  || "index.html";
    my $incom_root  = $r->dir_config( "INCOM_ROOT" )
      || $r->document_root;
    $incom_root = $r->server_root_relative( $incom_root );

    my $uri = $r->uri;

    # Decline to handle this unless the request URI match our prefix
    return DECLINED unless $uri =~ s!^$prefix/*!!;

    # Only support GET or POST
    return NOT_IMPLEMENTED unless $r->method =~ /^(GET|POST)$/;

    if ( $r->is_main ) {
	# On the first request, we open the connection to the database
	# and loads the user session
	my $rc      = db_init( $r );
	session_init( $r );

	# To clean DB connection and Session
	$r->push_handlers( PerlCleanupHandler => \&request_cleanup );
    }

    # Determine the handler
    if ( $uri =~ s!^incom_cookie_check/!! ) {
	# Check if the session was loaded properly
	if ( ref $r->pnotes( "INCOM_SESSION") ) {
	    # Cookie test suceeded. Tell browser to refetch
	    # original file
	    $r->pnotes( "INCOM_REDIRECT_TO", $prefix . $uri );
	    $r->push_handlers( PerlHandler => \&redirect_handler );
	    $r->handler( "perl-script" );
	} else {
	    # Cookie test failed
	    $r->pnotes( "INCOM_ERROR", "no_cookies" );
	    return return_error( $r, HTTP_PRECONDITION_FAILED );
	}
    } elsif ( $uri =~ s!^incom_set_lang/([-\w]+)/!! ) {
	$r->pnotes( "INCOM_NEW_LANG", "$1" );
	$r->pnotes( "INCOM_REDIRECT_TO", $prefix . $uri );

	$r->push_handlers( PerlHandler => \&set_lang_handler );
	$r->handler( "perl-script" );

    # incom_error magic URL should only be called as a subrequest.
    } elsif ( (!$r->main) && $uri =~ s!^incom_error/!! ) {

	$incom_root = $r->dir_config( "INCOM_ERROR_ROOT" ) || $incom_root;
	$incom_root = $r->server_root_relative( $incom_root );

	$r->push_handlers( PerlHandler => \&error_handler );
	$r->handler( "perl-script" );

    } elsif ( not ref $r->pnotes( "INCOM_SESSION" ) ) {

	# The user doesn't belong to an existing session
	$r->push_handlers( PerlHandler => \&new_session_handler );
	$r->handler( "perl-script" );
    } else {

	# Default handler
	$r->push_handlers( PerlHandler => \&default_handler );
	$r->handler( "perl-script" );
    }

    # Set the filename
    $uri ||= $index_file;

    # Handle directory index
    $uri =~ s!/$!/$index_file!;

    # Find the properly localized file
    my $localizer = $r->pnotes( "INCOM_LOCALIZER" );
    my $file = $localizer->find_localized_file( $incom_root . "/" . $uri );

    # Set filename of the request
    $r->filename(  $file  );

    # Request should never be cached
    $r->header_out( 'Pragma',	     'no-cache' );
    $r->header_out( 'Cache-control', 'no-cache' );
    $r->no_cache(1);

    # Default content-type
    $r->content_type( "text/html" );

    return OK;
}

# Content handler invoked when the request is not
# part of a session.
#
# It creates a new session.  Sets a cookie to it
# and redirect the user to resubmit the request
# to a rewritten URL.
sub new_session_handler {
    my $r = shift;

    my %session;
    eval {
	tie %session, 'Apache::iNcom::Session', undef,
	  { dbh => $r->pnotes( "INCOM_DBH"),
	    Serialize => $r->dir_config( "INCOM_SESSION_SERIALIZE_ACCESS" ),
	  };

	bake_session_cookie( $r, $session{_session_id} );
    };
    if ($@) {
	$r->log_error( "error creating session: $@" );
	return return_error( $r, SERVER_ERROR );
    }

    # Tell the browser to repost its request. We will then be
    # able to check if he has cookie turn on
    my $prefix	= $r->dir_config( "INCOM_URL_PREFIX" ) || "/";
    my $uri	= $r->uri;
    $uri =~ s!^$prefix/*!${prefix}incom_cookie_check/!;

    $r->content_type( "text/html" );
    $r->header_out( Location => $uri );

    return REDIRECT;
}

sub redirect_handler {
    my $r = shift;

    $r->content_type( "text/html" );
    $r->header_out( Location => $r->pnotes( "INCOM_REDIRECT_TO" ) );

    return REDIRECT;
}

sub set_lang_handler {
    my $r = shift;

    my $prefix	    = $r->dir_config( "INCOM_URL_PREFIX" ) || "/";
    my $session_domain  = $r->dir_config( "INCOM_SESSION_DOMAIN" );
    my $session_path    = $r->dir_config( "INCOM_SESSION_PATH" )
      || $prefix;
    my $session_expires = $r->dir_config( "INCOM_SESSION_EXPIRES" );

    # Create a cookie which has the same lifespan than
    # the session cookie.
    my $cookie = new Apache::Cookie( $r,
				     -name  => "INCOM_LANGUAGE",
				     -value => $r->pnotes( "INCOM_NEW_LANG" ),
				     -path  => $session_path,
				   );
    $cookie->domain( $session_domain )	    if $session_domain;
    $cookie->expires( $session_expires )    if $session_expires;

    # Add cookie to outgoing headers
    $cookie->bake;

    # Tell the browser to repost its request. The next
    # request will favorise the new language.
    $r->content_type( "text/html" );
    $r->header_out( Location => $r->pnotes( "INCOM_REDIRECT_TO" ) );

    return REDIRECT;
}

sub package_name {
    my $r    = shift;
    my $file = shift;

    my $host = $r->server->server_hostname;
    my $root = $r->dir_config( "INCOM_ROOT" ) || $r->document_root;
    $root = $r->server_root_relative( $root );

    # Remove document root
    $file =~ s!^$root/!!;

    # Remove trailing suffixes of the last component 
    # of the path name
    $file =~ s!\.[^/]*$!!;

    # Munge invalid character
    $file =~ tr/a-zA-Z0-9/_/cs;

    # Munge invalid character in hostname
    $host =~ tr/a-zA-Z0-9/_/cs;

    return  "Apache::iNcom::" . $host . "::" . $file;
}

sub error_handler {
    my $r = shift;

    my $filename    = $r->filename;

    unless ( -e $r->finfo ) {
	$r->log_reason( "nonexistent file", $filename );
	return NOT_FOUND;
    }

    unless ( -f _ ) {
	$r->log_reason( "not a regular file", $filename );
	return FORBIDDEN;
    }

    unless ( -r _ ) {
	$r->log_reason( "No permissions to read", $filename );
	return FORBIDDEN;

lib/Apache/iNcom.pm view on Meta::CPAN

=over

=item INCOM_SESSION_SERIALIZE_ACCESS

Set this to 1 to serialize access through session. This will make sure
that only one session's request is processed at a time. You should set
this to 1 if your site uses frameset.

=item INCOM_SESSION_SECURE

Sets this to true if you want the cookie that contains the session id
to be only transmitted over SSL connections. Be aware that setting
this variable to true will require that all Apache::iNcom transactions
be conducted over SSL.

=item INCOM_SESSION_DOMAIN

The domain to which the Apache::iNcom session's cookie will be
transmitted. You can use this, if you are using a server farm for
example.

=item INCOM_SESSION_PATH

The path under which the session id is valid. Defaults to
I<INCOM_URL_PREFIX>.

=item INCOM_SESSION_EXPIRES

The time for which the use session is valid. Defaults is for a browser
session. (Once the user exists its browser session will become
invalid).

=back

=head2 ERROR HANDLING DIRECTIVES

=over

=item INCOM_ERROR_PROFILE

The error profile that will be used for displaying server error.

=item INCOM_ERROR_ROOT

The directory which contains error pages. If a non absolute path
is specified, it is relative to the server's root.

=back

=head1 SESSION HANDLING

On the user's first request, a new session is created. Each and every
other request will be part of a session which will used to track the
user's cart and other such things.

The session id is returned to the user in a cookie. COOKIES MUST BE
ENABLED for Apache::iNcom to function. Fortunately, Apache::iNcom
detects if the user has cookies turned off and will send the user an
error.

Cookies are used for security and confidentiality. The session id is a
truly random 128bits number, which is make it very much unguessable.
That means that you can't try to stomp into another user's session.
That is a good thing since having access to the session id means
having access to a whole bunch of informations. (What information is
application specific.) IP address aren't used to restrict the session
access because of the various problems with proxies and other Internet
niceties.

Now, what has this to do with cookies ? Well, using URL rewriting was
originally considered, but then two big issues cralwed in : proxies
and the Referer header. Having the session id embedded in the URL
means that our precious session id will be stored in various log files
across multiple server (web server, proxy server, etc) This is a bad
thing. Also, must request contains a Referer header which means that
the session id is likely to leak to third party sites which are linked
from your site (or not, Netscape used to send the header even if the
user only typed in the new URL while viewing your page). This is
another bad thing, and this is why we are using cookies.


=head1 APACHE::INCOM PAGES

Apache::iNcom pages are HTML::Embperl pages with some extra variables
and functions available. See Apache::iNcom::Request(3) for details.
You may also which to consult the HTML::Embperl documentation for
syntax. Additionnaly, the normal $req_rec object in the page is an
instance of Apache::Request(3) so that you can handle multipart
upload.

=head1 DATABASE CONNECTIVITY

The database connection is opened once per request and shared by
all modules that must use it. Database access is mediated through
the use of the DBIx::SearchProfiles(3) module. 

Connections are opened in commit on request mode. The database
connection is commit after the page is executed. If an error occurs,
the transaction will be rolled back. The application may elect to
commit part of the transaction earlier.

=head1 CART MANAGEMENT

See Apache::iNcom::CartManager(3) for details.

=head1 ORDER MANAGEMENT

See Apache::iNcom::OrderManager(3) for details.

=head1 USER MANAGEMENT

User management is handled through the DBIx::UserDB(3) module.

=head1 LOCALIZATION

Apache::iNcom is designed to make it easy to adapt your e-commerce
application to multiple locale.

The framework uses Locale::Maketext(3) for message formatting.

All pages may have a localized version available. The localized should

( run in 2.108 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )