File Coverage

blib/lib/Apache/SessionX.pm

Criterion	Covered	Total	%
statement	51	228	22.3
branch	7	92	7.6
condition	2	41	4.8
subroutine	11	31	35.4
pod	5	14	35.7
total	76	406	18.7

###################################################################################
#
#   Apache::SessionX - Copyright (c) 1999-2001 Gerald Richter / ecos gmbh
#   Copyright(c) 1998, 1999 Jeffrey William Baker ([e-mail])
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
#   $Id: SessionX.pm,v 1.4 2001/12/04 13:33:39 richter Exp $
#
###################################################################################


package Apache::SessionX ;

use strict;
use vars qw(@ISA $VERSION);

$VERSION = '2.01';
@ISA = qw(Apache::Session);

use Apache::Session;
use Apache::SessionX::Config ;

use constant NEW      => Apache::Session::NEW () ;
use constant MODIFIED => Apache::Session::MODIFIED () ;
use constant DELETED  => Apache::Session::DELETED () ;
use constant SYNCED   => Apache::Session::SYNCED () ;


sub TIEHASH {
    my $class = shift;

    my $session_id = shift;
    my $args       = shift || {};

    if(ref $args ne "HASH")
        {
        die "Additional arguments should be in the form of a hash reference";
        }

    my $config = $args -> {config} || $Apache::SessionX::Config::default;
    foreach my $cfg (keys  (%{$Apache::SessionX::Config::param{$config}}))
        {
        $args -> {$cfg} = $Apache::SessionX::Config::param{$config} -> {$cfg} if (!exists $args -> {$cfg}) ;
        }

    my $self =
        {
        args         => $args,
        data         => { _session_id => $session_id },
        initial_session_id => $session_id,
        lock         => 0,
        lock_manager => undef,
        object_store => undef,
        status       => 0,
        serialized   => undef,
        idfrom       => $args -> {idfrom},
        newid        => $args -> {newid},
        };

    bless $self, $class;

    $self -> require_modules ($args) ;

    $self -> init if (!$args -> {'lazy'}) ;


    return $self ;
    }


sub require_modules
    {
    my $self = shift ;
    my $args = shift ;

    # check object_store and lock_manager classes (Apache::Session 1.00)

    foreach my $mod ('Store', 'Lock', 'Generate', 'Serialize')
        {
        if ($args -> {$mod})
            {
            if (!($args -> {$mod} =~ /::/))
                {
                my $modname = "Apache::SessionX::$mod\:\:$args->{$mod}" ;
                eval "require $modname" ;
                if ($@)
                    {
                    $@ = '' ;
                    $modname = "Apache::Session::$mod\:\:$args->{$mod}" ;
                    eval "require $modname" ;
                    }

                die "Cannot require $modname ($@)" if ($@) ;
                $args->{$mod} = $modname ;
                }
            else
                {
                my $modname = $args->{$mod} ;
                eval "require $modname" ;
                die "Cannot require $modname" if ($@) ;
                }
            }
        }
    }





sub init
    {
    my $self = shift ;

    #If a session ID was passed in, this is an old hash.
    #If not, it is a fresh one.

    $self->populate;

    my $session_id = $self->{data}->{_session_id} ;

    if (!$session_id && $self -> {idfrom})
        {
        $session_id = $self->{data}->{_session_id} = &{$self->{generate}}($self, $self -> {idfrom})  ;
        }

    $self->{initial_session_id} ||= $session_id ;


    if (defined $session_id  && $session_id)
        {
        #check the session ID for remote exploitation attempts
        #this will die() on suspicious session IDs.

        #eval { &{$self->{validate}}($self); } ;
        &{$self->{validate}}($self);
        #if (!$@)
            { # session id is ok

            $self->{status} &= ($self->{status} ^ NEW);

	    if ($self -> {'args'}{'create_unknown'})
	        {
                eval { $self -> restore } ;
	        #warn "Try to load session: $@" if ($@) ;
	        $@ = "" ;
	        $session_id = $self->{data}->{_session_id} ;
	        }
	    else
	        {
	        $self->restore;
	        }
            }
        }

    $@ = '' ;

    if (!($self->{status} & SYNCED))
        {
        $self->{status} |= NEW();
        if (!$self->{data}->{_session_id} || $self -> {'args'}{'recreate_id'})
            {
            if (exists ($self->{generate}))
                { # Apache::Session >= 1.50
	        $self->{data}->{_session_id} = &{$self->{generate}}($self)  ;
                }
            else
                {
	        $self->{data}->{_session_id} = $self -> generate_id() ;
                }
            }
        $self->save;
        }
    else
        {
        $self -> {newidpending} = $self -> {newid} ;
        }


    #warn "Session INIT $self->{initial_session_id};$self->{data}->{_session_id};" ;

    return $self;
    }





sub FETCH {
    my $self = shift;
    my $key  = shift;

    $self -> init if (!$self -> {'status'}) ;

    return $self->{data}->{$key};
}

sub STORE {
    my $self  = shift;
    my $key   = shift;
    my $value = shift;

    $self -> init if (!$self -> {'status'}) ;

    $self->{data}->{$key} = $value;

    $self->{status} |= MODIFIED;

    return $self->{data}->{$key};
}

sub DELETE {
    my $self = shift;
    my $key  = shift;

    $self -> init if (!$self -> {'status'}) ;

    $self->{status} |= MODIFIED;

    delete $self->{data}->{$key};
}

sub CLEAR {
    my $self = shift;

    $self -> init if (!$self -> {'status'}) ;

    $self->{status} |= MODIFIED;

    $self->{data} = {};
}

sub EXISTS {
    my $self = shift;
    my $key  = shift;

    $self -> init if (!$self -> {'status'}) ;

    return exists $self->{data}->{$key};
}

sub FIRSTKEY {
    my $self = shift;

    $self -> init if (!$self -> {'status'}) ;

    my $reset = keys %{$self->{data}};
    return each %{$self->{data}};
}

sub NEXTKEY {
    my $self = shift;

    $self -> init if (!$self -> {'status'}) ;

    return each %{$self->{data}};
}

sub DESTROY {
    my $self = shift;

    $self->save if ($self -> {'status'}) ;
    # destroy store object to make sure all data is written and everything
    # is closed before we release the locks
    $self->{object_store} = undef ;
    $self->release_all_locks;
}

sub cleanup
    {
    my $self = shift;

    $self->{initial_session_id} = undef ;
    if ($self -> {'status'})
	{
        $self->save;
        }
#    {
#    local $SIG{__WARN__} = 'IGNORE' ;
#    local $SIG{__DIE__}  = 'IGNORE' ;
#    eval { $self -> {object_store} -> close } ; # Try to close file storage
#    $@ = "" ;
#    }

    # destroy store object to make sure all data is written and everything
    # is closed before we release the locks
    $self->{object_store} = undef ;
    $self->release_all_locks;

    $self->{'status'} = 0 ;
    $self->{data} = {} ;
    $self->{serialized} = undef ;
    # destroy lock object to make sure all locks are really released
    $self->{lock_manager} = undef ;
    }


sub setid {
    my $self = shift;

    $self->{'status'} = 0 ;
    $self->{data}->{_session_id} = $self->{initial_session_id} = shift ;
}

sub setidfrom {
    my $self = shift;

    $self->{'status'} = 0 ;
    $self->{data}->{_session_id} = $self->{initial_session_id} = undef ;
    $self->{idfrom} = shift ;

}
sub getid {
    my $self = shift;

    return $self->{data}->{_session_id}  ;
}

sub getids {
    my $self = shift;
    my $init = shift;

    $self -> init if ($init && !$self -> {'status'}) ;

    if ($self -> {newidpending} && $self->{status})
        {
        $self->{data}->{_session_id} = &{$self->{generate}}($self) ;
        $self -> {newidpending} = 0 ;
        $self->{status} |= NEW ;
        }

    return ($self->{initial_session_id}, $self->{data}->{_session_id},  $self->{status} & MODIFIED) ;
}

sub delete {
    my $self = shift;

    return if ($self->{status} & NEW);

    $self->{initial_session_id} = "!DELETE" ;

    $self -> init if (!$self -> {'status'}) ;

    $self->{status} |= DELETED;
    $self->save;
    $self->{data} = {} ; # Throw away the data
}



sub restore {
    my $self = shift;

    return if ($self->{status} & SYNCED);
    return if ($self->{status} & NEW);

    if (exists $self -> {'args'}->{Transaction} && $self -> {'args'}->{Transaction})
        {
        $self->acquire_write_lock;
        }
    else
        {
        $self->acquire_read_lock;
        }

    $self->{object_store}->materialize($self);
    &{$self->{unserialize}}($self);

    $self->{status} &= ($self->{status} ^ MODIFIED);
    $self->{status} |= SYNCED
}


sub save {
    my $self = shift;

    return unless (
        $self->{status} & MODIFIED ||
        $self->{status} & NEW      ||
        $self->{status} & DELETED
    );

    if ($self -> {newidpending})
        {
        $self->{data}->{_session_id} = &{$self->{generate}}($self) ;
        $self -> {newidpending} = 0 ;
        $self->{status} |= NEW ;
        }

    $self->acquire_write_lock;

    if ($self->{status} & DELETED) {
        $self->{object_store}->remove($self);
        $self->{status} |= SYNCED;
        $self->{status} &= ($self->{status} ^ MODIFIED);
        $self->{status} &= ($self->{status} ^ DELETED);
        return;
    }
    if ($self->{status} & NEW) {
        &{$self->{serialize}}($self);
        $self->{object_store}->insert($self);
        $self->{status} &= ($self->{status} ^ NEW);
        $self->{status} |= SYNCED;
        $self->{status} &= ($self->{status} ^ MODIFIED);
        return;
    }

    if ($self->{status} & MODIFIED) {
        &{$self->{serialize}}($self);
        $self->{object_store}->update($self);
        $self->{status} &= ($self->{status} ^ MODIFIED);
        $self->{status} |= SYNCED;
        return;
    }
}


#

# For Apache::Session 1.00
#

sub get_object_store {
    my $self = shift;

    return new {$self -> {'args'}{'object_store'}} $self;
}

sub get_lock_manager {
    my $self = shift;

    return new {$self -> {'args'}{'lock_manager'}} $self;
}

#
# Default validate for Apache::Session < 1.53
#

sub validate {
    #This routine checks to ensure that the session ID is in the form
    #we expect.  This must be called before we start diddling around
    #in the database or the disk.

    my $session = shift;

    if ($session->{data}->{_session_id} !~ /^[a-fA-F0-9]+$/) {
        die 'Invalid session id' ;
    }
}

#
# For Apache::Session >= 1.50
#

sub populate
    {
    my $self = shift;

    my $store = $self->{args}->{Store};
    my $lock  = $self->{args}->{Lock};
    if (!$self->{populated})
        {
        my $gen   = $self->{args}->{Generate};
        my $ser   = $self->{args}->{Serialize};


        $self->{object_store} = new $store $self if ($store) ;
        $self->{lock_manager} = new $lock $self if ($lock);
        $self->{generate}     = \&{$gen . '::generate'} if ($gen);
        $self->{'validate'}     = \&{$gen . '::validate'} if ($gen && defined (&{$gen . '::validate'}));
        $self->{serialize}    = \&{$ser . '::serialize'} if ($ser);
        $self->{unserialize}  = \&{$ser . '::unserialize'} if ($ser) ;

        if (!defined ($self->{'validate'}))
            {
            $self->{'validate'} = \&validate ;
            }
        $self->{populated} = 1 ;
        }
    else
        { # recreate only store & lock classes as far as necessary
        $self->{object_store} ||= new $store $self if ($store) ;
        $self->{lock_manager} ||= new $lock $self if ($lock);
        }

    return $self;
    }



1 ;


__END__