296 lines
8.6 KiB
Perl
296 lines
8.6 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Session::File
|
|
# Author : Alex Krohn
|
|
# CVS Info :
|
|
# $Id: File.pm,v 1.14 2004/01/13 01:35:20 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description:
|
|
# A module for implementing session management.
|
|
#
|
|
# Todo:
|
|
# - SQL Support.
|
|
#
|
|
|
|
package GT::Session::File;
|
|
# ===============================================================
|
|
# Pragmas
|
|
use strict;
|
|
use vars qw(@ISA $VERSION $DEBUG $ATTRIBS $ERRORS $error $DIRECTORY $SESSION);
|
|
|
|
# Internal nodules
|
|
use GT::Base ();
|
|
use GT::MD5 qw/md5_hex/;
|
|
use GT::Dumper;
|
|
|
|
# Global variable init
|
|
@ISA = qw/GT::Base/;
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/;
|
|
$DEBUG = 0;
|
|
$ATTRIBS = {
|
|
id => undef,
|
|
data => undef,
|
|
directory => undef,
|
|
save => 0,
|
|
subdir => 0,
|
|
|
|
_debug => $DEBUG
|
|
};
|
|
$ERRORS = {
|
|
'BADDATA' => "Invalid data in session: '%s'. Reason: '%s'",
|
|
'NOROOT' => "No root directory was defined!",
|
|
'CANTOPEN' => "Can't open file: '%s'. Reason: '%s'",
|
|
'CANTDEL' => "Unable to delete file: '%s'. Reason: '%s'",
|
|
'CLASSFUNC' => "This is a class function only.",
|
|
'INVALIDSESSION' => "Invalid session id: '%s'."
|
|
};
|
|
$DIRECTORY = "./auth";
|
|
$SESSION = '';
|
|
|
|
sub new {
|
|
# ---------------------------------------------------------------
|
|
# Initilizes a session. Expects to find a session id to lookup, some
|
|
# data to save, or nothing. If no session is defined, then one will
|
|
# be generated. If an invalid session is specified, nothing is returned.
|
|
#
|
|
my $this = shift;
|
|
my $class = ref $this || $this;
|
|
my $self = bless {}, $class;
|
|
|
|
# Set defaults.
|
|
foreach (keys %$ATTRIBS) {
|
|
$self->{$_} = $ATTRIBS->{$_};
|
|
}
|
|
|
|
# Don't save by default.
|
|
$self->{save} = 0;
|
|
|
|
# We got passed in a single session id.
|
|
if (@_ == 1) {
|
|
$self->load ($_[0]) or return $self->error ('INVALIDSESSION', 'WARN', $_[0]);
|
|
return $self;
|
|
}
|
|
|
|
# We got passed some options, possibly a session id.
|
|
if (@_ > 1) {
|
|
my $opts = $self->common_param(@_);
|
|
foreach (keys %$opts) {
|
|
exists $self->{$_} and ($self->{$_} = $opts->{$_});
|
|
}
|
|
if ($self->{directory}) {
|
|
$DIRECTORY = $self->{directory};
|
|
}
|
|
}
|
|
|
|
# If we have an id, load it or return.
|
|
if ($self->{id}) {
|
|
$self->load ($self->{id}) or return $self->error ('INVALIDSESSION', 'WARN', $self->{id});
|
|
}
|
|
else {
|
|
$self->{id} = generate_session_id();
|
|
$self->{save} = 1;
|
|
}
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub DESTROY {
|
|
# ---------------------------------------------------------------
|
|
# Makes sure we save the session.
|
|
#
|
|
$_[0]->save() if ($_[0]->{save});
|
|
$_[0]->debug ("Object destroyed.") if ($_[0]->{_debug} > 1);
|
|
}
|
|
|
|
sub data {
|
|
# ---------------------------------------------------------------
|
|
# Set/retrieve the data, make sure to set save to 1.
|
|
#
|
|
if (@_ > 1) { $_[0]->{data} = $_[1]; $_[0]->{save} = 1; }
|
|
return $_[0]->{data};
|
|
}
|
|
|
|
sub load {
|
|
# ---------------------------------------------------------------
|
|
# Loads a session id and data.
|
|
#
|
|
my ($self, $sid) = @_;
|
|
if (($sid =~ /^[\w\d]+$/) and (length $sid < 40)) {
|
|
my $root = $DIRECTORY or return $self->error ('NOROOT', 'FATAL');
|
|
my $file = $root;
|
|
if ($self->{subdir}) {
|
|
$file .= '/' . substr ($sid, 0, 1);
|
|
}
|
|
$file .= '/' . $sid;
|
|
if (-e $file) {
|
|
local ($@, $!, $SESSION);
|
|
$file =~ /(.*)/;
|
|
$file = $1;
|
|
|
|
do "$file";
|
|
($@ || $!) and return $self->error ('BADDATA', 'FATAL', $file, "$@" || "$!");
|
|
$self->{data} = $SESSION;
|
|
$self->{id} = $sid;
|
|
$self->debug ("Session '$sid' loaded ok.") if ($self->{_debug});
|
|
return 1;
|
|
}
|
|
else {
|
|
$self->debug ("Attempted to load invalid session: '$sid'.") if ($self->{_debug});
|
|
}
|
|
}
|
|
else {
|
|
$self->debug ("Attempted to load invalid, or blank session '$sid'.") if ($self->{_debug});
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub save {
|
|
# ---------------------------------------------------------------
|
|
# Save a session id and data.
|
|
#
|
|
my $self = shift;
|
|
my $sid = $self->{id};
|
|
|
|
if (($sid =~ /^[\w\d]+$/) and (length $sid < 40)) {
|
|
my $root = $DIRECTORY or return $self->error ('NOROOT', 'FATAL');
|
|
my $file = $root;
|
|
if ($self->{subdir}) {
|
|
$file .= '/' . substr ($sid, 0, 1);
|
|
-d $file or mkdir ($file, 0755) or return $self->error ('CANTOPEN', 'FATAL', $file, "$!");
|
|
}
|
|
$file .= '/' . $sid;
|
|
my $fh = \do {local *FH; *FH};
|
|
open ($fh, "> $file") or return $self->error ('CANTOPEN', 'FATAL', $file, "$!");
|
|
my $dump = GT::Dumper->dump(
|
|
var => '$SESSION',
|
|
data => $self->{data}
|
|
);
|
|
print $fh $dump;
|
|
close $fh;
|
|
$self->{save} = 0;
|
|
$self->debug ("Session '$sid' saved.") if ($self->{_debug});
|
|
}
|
|
else {
|
|
$self->debug ("Attempted to save invalid session '$sid'") if ($self->{_debug});
|
|
}
|
|
}
|
|
|
|
sub delete {
|
|
# ---------------------------------------------------------------
|
|
# Delete a session.
|
|
#
|
|
my $self = shift;
|
|
my $sid;
|
|
if (! ref $self) {
|
|
$self = bless { _debug => $DEBUG }, $self;
|
|
$sid = shift;
|
|
}
|
|
else {
|
|
$sid = $self->{id}
|
|
}
|
|
|
|
if (($sid =~ /^([\w\d]+)$/) and (length $sid < 40)) {
|
|
$sid = $1;
|
|
my $root = $DIRECTORY or return $self->error ('NOROOT', 'FATAL');
|
|
my $file = $root;
|
|
if ($self->{subdir}) {
|
|
$file .= '/' . substr ($sid, 0, 1);
|
|
}
|
|
$file .= '/' . $sid;
|
|
unlink $file or return $self->error ('CANTDEL', 'WARN', $file, "$!");
|
|
$self->{id} = undef;
|
|
$self->{data} = undef;
|
|
$self->{save} = 0;
|
|
$self->debug ("Session '$sid' deleted.") if ($self->{_debug});
|
|
}
|
|
}
|
|
|
|
sub cleanup {
|
|
# ---------------------------------------------------------------
|
|
# CLASS function to cleanup session directory.
|
|
#
|
|
my ($self, $seconds, $directory) = @_;
|
|
(ref $self) or $self = bless { _debug => $DEBUG }, $self;
|
|
|
|
if ($seconds == 0) {
|
|
$self->debug ("Cleanup not erasing anything, seconds set to 0.") if ($self->{_debug});
|
|
return;
|
|
}
|
|
|
|
defined $seconds or ($seconds = 3600);
|
|
defined $directory or ($directory = $DIRECTORY);
|
|
$directory or return $self->error ('NOROOT', 'FATAL');
|
|
|
|
my $dir = \do {local *FH; *FH};
|
|
opendir ($dir, $directory) or return $self->error ('CANTOPEN', 'FATAL', $directory, "$!");
|
|
my @files = grep { $_ and (!/^\.\.?$/) and (/^[\w\d]+$/) and (length ($_) < 40) } readdir ($dir);
|
|
closedir ($dir);
|
|
|
|
foreach my $file (@files) {
|
|
my $full_file = "$directory/$file";
|
|
my $is_dir = -d $full_file;
|
|
|
|
if ($self->{subdir} and $is_dir) {
|
|
my $dir = \do {local *FH; *FH};
|
|
opendir $dir, $full_file or return $self->error ('CANTOPEN', 'FATAL', $full_file, "$!");
|
|
push @files, map { $file . '/' . $_ } grep { (!/^\.\.?$/) and (/^[\w\d]+$/) and (length ($_) < 40) } readdir ($dir);
|
|
closedir $dir;
|
|
next;
|
|
}
|
|
elsif ($is_dir) {
|
|
next;
|
|
}
|
|
|
|
if (((stat($full_file))[9] + $seconds) <= time()) {
|
|
$self->debug ("Cleanup is removing '$full_file' older then $seconds s. old.") if ($self->{_debug});
|
|
$full_file =~ /(.*)/;
|
|
$full_file = $1;
|
|
unlink $full_file or return $self->error ('CANTDEL', 'FATAL', $full_file, "$!");
|
|
}
|
|
}
|
|
}
|
|
|
|
sub generate_session_id {
|
|
# ---------------------------------------------------------------
|
|
# Generates a session id.
|
|
#
|
|
return md5_hex ( time . $$ . rand (16000) );
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::Session::File - A session management module, with simple data storage/retrieval.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
Create a session:
|
|
my $session = new GT::Session::File;
|
|
my $id = $session->id();
|
|
|
|
Save data with the session:
|
|
$session->data ("Save this information!");
|
|
|
|
Load a session.
|
|
my $session = new GT::Session::File ( $id ) or die "Can't load session: '$id'."
|
|
|
|
Set session directory.
|
|
my $session = new GT::Session::File ( directory => '/path/to/sessions', id => $id );
|
|
|
|
Delete a session
|
|
$session->delete();
|
|
|
|
Cleanup old sessions, takes argument of number of seconds old.
|
|
$session->cleanup ( 5000 );
|
|
|
|
=head1 TODO
|
|
|
|
* Integrate SQL interface into flatfile interface.
|