view release on metacpan or  search on metacpan

SessionX.pm  view on Meta::CPAN

    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};
}

SessionX.pm  view on Meta::CPAN

    
    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__

=head1 NAME

Apache::SessionX  - An extented persistence framework for session data

=head1 SYNOPSIS

=head1 DESCRIPTION

Apache::SessionX extents Apache::Session. 
It was initialy written to use Apache::Session from inside of HTML::Embperl, 
but is seems to be usefull outside of Embperl as well, so here is it as standalone module.

Apache::Session is a persistence framework which is particularly useful
for tracking session data between httpd requests.  Apache::Session is
designed to work with Apache and mod_perl, but it should work under
CGI and other web servers, and it also works outside of a web server
altogether.

Apache::Session consists of five components: the interface, the object store,
the lock manager, the ID generator, and the serializer.  The interface is
defined in SessionX.pm, which is meant to be easily subclassed.  The object
store can be the filesystem, a Berkeley DB, a MySQL DB, an Oracle DB, or a
Postgres DB. Locking is done by lock files, semaphores, or the locking
capabilities of MySQL and Postgres.  Serialization is done via Storable, and
optionally  ASCII-fied via MIME or pack().  ID numbers are generated via MD5. 
The reader is encouraged to extend these capabilities to meet his own
requirements.

=head1 INTERFACE

The interface to Apache::SessionX is very simple: tie a hash to the
desired class and use the hash as normal.  The constructor takes two
optional arguments.  The first argument is the desired session ID
number, or undef for a new session.  The second argument is a hash
of options that will be passed to the object store and locker classes.


=head2 Addtional Attributes for TIE

=over 4