diff options
Diffstat (limited to 'qooxdoo/source/perl/CGI/Session/Driver')
-rw-r--r-- | qooxdoo/source/perl/CGI/Session/Driver/DBI.pm | 236 | ||||
-rw-r--r-- | qooxdoo/source/perl/CGI/Session/Driver/db_file.pm | 201 | ||||
-rw-r--r-- | qooxdoo/source/perl/CGI/Session/Driver/file.pm | 217 | ||||
-rw-r--r-- | qooxdoo/source/perl/CGI/Session/Driver/mysql.pm | 113 | ||||
-rw-r--r-- | qooxdoo/source/perl/CGI/Session/Driver/postgresql.pm | 134 | ||||
-rw-r--r-- | qooxdoo/source/perl/CGI/Session/Driver/sqlite.pm | 99 |
6 files changed, 1000 insertions, 0 deletions
diff --git a/qooxdoo/source/perl/CGI/Session/Driver/DBI.pm b/qooxdoo/source/perl/CGI/Session/Driver/DBI.pm new file mode 100644 index 0000000..413be99 --- /dev/null +++ b/qooxdoo/source/perl/CGI/Session/Driver/DBI.pm @@ -0,0 +1,236 @@ +package CGI::Session::Driver::DBI; + +# $Id: DBI.pm 351 2006-11-24 14:16:50Z markstos $ + +use strict; + +use DBI; +use Carp; +use CGI::Session::Driver; + +@CGI::Session::Driver::DBI::ISA = ( "CGI::Session::Driver" ); +$CGI::Session::Driver::DBI::VERSION = "4.20"; + + +sub init { + my $self = shift; + if ( defined $self->{Handle} ) { + if (ref $self->{Handle} eq 'CODE') { + $self->{Handle} = $self->{Handle}->(); + } + else { + # We assume the handle is working, and there is nothing to do. + } + } + else { + $self->{Handle} = DBI->connect( + $self->{DataSource}, $self->{User}, $self->{Password}, + { RaiseError=>1, PrintError=>1, AutoCommit=>1 } + ); + unless ( $self->{Handle} ) { + return $self->set_error( "init(): couldn't connect to database: " . DBI->errstr ); + } + $self->{_disconnect} = 1; + } + return 1; +} + +# A setter/accessor method for the table name, defaulting to 'sessions' + +sub table_name { + my $self = shift; + my $class = ref( $self ) || $self; + + if ( (@_ == 0) && ref($self) && ($self->{TableName}) ) { + return $self->{TableName}; + } + + no strict 'refs'; + if ( @_ ) { + my $new_name = shift; + $self->{TableName} = $new_name; + ${ $class . "::TABLE_NAME" } = $new_name; + } + + unless (defined $self->{TableName}) { + $self->{TableName} = "sessions"; + } + + return $self->{TableName}; +} + + +sub retrieve { + my $self = shift; + my ($sid) = @_; + croak "retrieve(): usage error" unless $sid; + + + my $dbh = $self->{Handle}; + my $sth = $dbh->prepare_cached("SELECT a_session FROM " . $self->table_name . " WHERE id=?", undef, 3); + unless ( $sth ) { + return $self->set_error( "retrieve(): DBI->prepare failed with error message " . $dbh->errstr ); + } + $sth->execute( $sid ) or return $self->set_error( "retrieve(): \$sth->execute failed with error message " . $sth->errstr); + + my ($row) = $sth->fetchrow_array(); + return 0 unless $row; + return $row; +} + + +sub store { +# die; + my $self = shift; + my ($sid, $datastr) = @_; + croak "store(): usage error" unless $sid && $datastr; + + + my $dbh = $self->{Handle}; + my $sth = $dbh->prepare_cached("SELECT id FROM " . $self->table_name . " WHERE id=?", undef, 3); + unless ( defined $sth ) { + return $self->set_error( "store(): \$dbh->prepare failed with message " . $sth->errstr ); + } + + $sth->execute( $sid ) or return $self->set_error( "store(): \$sth->execute failed with message " . $sth->errstr ); + my $action_sth; + if ( $sth->fetchrow_array ) { + $action_sth = $dbh->prepare_cached("UPDATE " . $self->table_name . " SET a_session=? WHERE id=?", undef, 3); + } else { + $action_sth = $dbh->prepare_cached("INSERT INTO " . $self->table_name . " (a_session, id) VALUES(?, ?)", undef, 3); + } + + unless ( defined $action_sth ) { + return $self->set_error( "store(): \$dbh->prepare failed with message " . $dbh->errstr ); + } + $action_sth->execute($datastr, $sid) + or return $self->set_error( "store(): \$action_sth->execute failed " . $action_sth->errstr ); + return 1; +} + + +sub remove { + my $self = shift; + my ($sid) = @_; + croak "remove(): usage error" unless $sid; + + my $rc = $self->{Handle}->do( 'DELETE FROM '. $self->table_name .' WHERE id= ?',{},$sid ); + unless ( $rc ) { + croak "remove(): \$dbh->do failed!"; + } + + return 1; +} + + +sub DESTROY { + my $self = shift; + + unless ( $self->{Handle}->{AutoCommit} ) { + $self->{Handle}->commit; + } + if ( $self->{_disconnect} ) { + $self->{Handle}->disconnect; + } +} + + +sub traverse { + my $self = shift; + my ($coderef) = @_; + + unless ( $coderef && ref( $coderef ) && (ref $coderef eq 'CODE') ) { + croak "traverse(): usage error"; + } + + my $tablename = $self->table_name(); + my $sth = $self->{Handle}->prepare_cached("SELECT id FROM $tablename", undef, 3) + or return $self->set_error("traverse(): couldn't prepare SQL statement. " . $self->{Handle}->errstr); + $sth->execute() or return $self->set_error("traverse(): couldn't execute statement $sth->{Statement}. " . $sth->errstr); + + while ( my ($sid) = $sth->fetchrow_array ) { + $coderef->($sid); + } + return 1; +} + + +1; + +=pod + +=head1 NAME + +CGI::Session::Driver::DBI - Base class for native DBI-related CGI::Session drivers + +=head1 SYNOPSIS + + require CGI::Session::Driver::DBI; + @ISA = qw( CGI::Session::Driver::DBI ); + +=head1 DESCRIPTION + +In most cases you can create a new DBI-driven CGI::Session driver by simply creating an empty driver file that inherits from CGI::Session::Driver::DBI. That's exactly what L<sqlite|CGI::Session::Driver::sqlite> does. The only reason why this class doesn't suit for a valid driver is its name isn't in lowercase. I'm serious! + +=head2 NOTES + +CGI::Session::Driver::DBI defines init() method, which makes DBI handle available for drivers in I<Handle> - object attribute regardless of what C<\%dsn_args> were used in creating session object. Should your driver require non-standard initialization you have to re-define init() method in your F<.pm> file, but make sure to set 'Handle' - object attribute to database handle (returned by DBI->connect(...)) if you wish to inherit any of the methods from CGI::Session::Driver::DBI. + +=head1 STORAGE + +Before you can use any DBI-based session drivers you need to make sure compatible database table is created for CGI::Session to work with. Following command will produce minimal requirements in most SQL databases: + + CREATE TABLE sessions ( + id CHAR(32) NOT NULL PRIMARY KEY, + a_session TEXT NOT NULL + ); + +Your session table can define additional columns, but the above two are required. Name of the session table is expected to be I<sessions> by default. You may use a different name if you wish. To do this you have to pass I<TableName> as part of your C< \%dsn_args >: + + $s = new CGI::Session("driver:sqlite", undef, {TableName=>'my_sessions'}); + $s = new CGI::Session("driver:mysql", undef, { + TableName=>'my_sessions', + DataSource=>'dbi:mysql:shopping_cart'}); + +=head1 DRIVER ARGUMENTS + +Following driver arguments are supported: + +=over 4 + +=item DataSource + +First argument to be passed to L<DBI|DBI>->L<connect()|DBI/connect()>. If the driver makes +the database connection itself, it will also explicitly disconnect from the database when +the driver object is DESTROYed. + +=item User + +User privileged to connect to the database defined in C<DataSource>. + +=item Password + +Password of the I<User> privileged to connect to the database defined in C<DataSource> + +=item Handle + +An existing L<DBI> database handle object. The handle can be created on demand +by providing a code reference as a argument, such as C<<sub{DBI->connect}>>. +This way, the database connection is only created if it actually needed. This can be useful +when combined with a framework plugin like L<CGI::Application::Plugin::Session>, which creates +a CGI::Session object on demand as well. + +C<Handle> will override all the above arguments, if any present. + +=item TableName + +Name of the table session data will be stored in. + +=back + +=head1 LICENSING + +For support and licensing information see L<CGI::Session|CGI::Session> + +=cut + diff --git a/qooxdoo/source/perl/CGI/Session/Driver/db_file.pm b/qooxdoo/source/perl/CGI/Session/Driver/db_file.pm new file mode 100644 index 0000000..edfe8d6 --- /dev/null +++ b/qooxdoo/source/perl/CGI/Session/Driver/db_file.pm @@ -0,0 +1,201 @@ +package CGI::Session::Driver::db_file; + +# $Id: db_file.pm 351 2006-11-24 14:16:50Z markstos $ + +use strict; + +use Carp; +use DB_File; +use File::Spec; +use File::Basename; +use CGI::Session::Driver; +use Fcntl qw( :DEFAULT :flock ); +use vars qw( @ISA $VERSION $FILE_NAME $UMask $NO_FOLLOW ); + +@ISA = ( "CGI::Session::Driver" ); +$VERSION = "4.20"; +$FILE_NAME = "cgisess.db"; +$UMask = 0660; +$NO_FOLLOW = eval { O_NOFOLLOW } || 0; + +sub init { + my $self = shift; + + $self->{FileName} ||= $CGI::Session::Driver::db_file::FILE_NAME; + unless ( $self->{Directory} ) { + $self->{Directory} = dirname( $self->{FileName} ); + $self->{Directory} = File::Spec->tmpdir() if $self->{Directory} eq '.' && substr($self->{FileName},0,1) ne '.'; + $self->{FileName} = basename( $self->{FileName} ); + } + unless ( -d $self->{Directory} ) { + require File::Path; + File::Path::mkpath($self->{Directory}) or return $self->set_error("init(): couldn't mkpath: $!"); + } + + $self->{UMask} = $CGI::Session::Driver::db_file::UMask unless exists $self->{UMask}; + + return 1; +} + + +sub retrieve { + my $self = shift; + my ($sid) = @_; + croak "retrieve(): usage error" unless $sid; + + return 0 unless -f $self->_db_file; + my ($dbhash, $unlock) = $self->_tie_db_file(O_RDONLY) or return; + my $datastr = $dbhash->{$sid}; + untie(%$dbhash); + $unlock->(); + return $datastr || 0; +} + + +sub store { + my $self = shift; + my ($sid, $datastr) = @_; + croak "store(): usage error" unless $sid && $datastr; + + my ($dbhash, $unlock) = $self->_tie_db_file(O_RDWR, LOCK_EX) or return; + $dbhash->{$sid} = $datastr; + untie(%$dbhash); + $unlock->(); + return 1; +} + + + +sub remove { + my $self = shift; + my ($sid) = @_; + croak "remove(): usage error" unless $sid; + + + my ($dbhash, $unlock) = $self->_tie_db_file(O_RDWR, LOCK_EX) or return; + delete $dbhash->{$sid}; + untie(%$dbhash); + $unlock->(); + return 1; +} + + +sub DESTROY {} + + +sub _lock { + my $self = shift; + my ($db_file, $lock_type) = @_; + + croak "_lock(): usage error" unless $db_file; + $lock_type ||= LOCK_SH; + + my $lock_file = $db_file . '.lck'; + if ( -l $lock_file ) { + unlink($lock_file) or + die $self->set_error("_lock(): '$lock_file' appears to be a symlink and I can't remove it: $!"); + } + sysopen(LOCKFH, $lock_file, O_RDWR|O_CREAT|$NO_FOLLOW) or die "couldn't create lock file '$lock_file': $!"; + + + flock(LOCKFH, $lock_type) or die "couldn't lock '$lock_file': $!"; + return sub { + close(LOCKFH); # && unlink($lock_file); # keep the lock file around + 1; + }; +} + + + +sub _tie_db_file { + my $self = shift; + my ($o_mode, $lock_type) = @_; + $o_mode ||= O_RDWR|O_CREAT; + + # DB_File will not touch a file unless it recognizes the format + # we can't detect the version of the underlying database without some very heavy checks so the easiest thing is + # to disable this for opening of the database + + # # protect against symlinks + # $o_mode |= $NO_FOLLOW; + + my $db_file = $self->_db_file; + my $unlock = $self->_lock($db_file, $lock_type); + my %db; + + my $create = ! -e $db_file; + + if ( -l $db_file ) { + $create = 1; + unlink($db_file) or + return $self->set_error("_tie_db_file(): '$db_file' appears to be a symlink and I can't remove it: $!"); + } + + $o_mode = O_RDWR|O_CREAT|O_EXCL if $create; + + unless( tie %db, "DB_File", $db_file, $o_mode, $self->{UMask} ){ + $unlock->(); + return $self->set_error("_tie_db_file(): couldn't tie '$db_file': $!"); + } + + return (\%db, $unlock); +} + +sub _db_file { + my $self = shift; + return File::Spec->catfile( $self->{Directory}, $self->{FileName} ); +} + +sub traverse { + my $self = shift; + my ($coderef) = @_; + + unless ( $coderef && ref($coderef) && (ref $coderef eq 'CODE') ) { + croak "traverse(): usage error"; + } + + my ($dbhash, $unlock) = $self->_tie_db_file(O_RDWR, LOCK_SH); + unless ( $dbhash ) { + return $self->set_error( "traverse(): couldn't get db handle, " . $self->errstr ); + } + while ( my ($sid, undef) = each %$dbhash ) { + $coderef->( $sid ); + } + untie(%$dbhash); + $unlock->(); + return 1; +} + + +1; + +__END__; + +=pod + +=head1 NAME + +CGI::Session::Driver::db_file - CGI::Session driver for BerkeleyDB using DB_File + +=head1 SYNOPSIS + + $s = new CGI::Session("driver:db_file", $sid); + $s = new CGI::Session("driver:db_file", $sid, {FileName=>'/tmp/cgisessions.db'}); + +=head1 DESCRIPTION + +B<db_file> stores session data in BerkelyDB file using L<DB_File|DB_File> - Perl module. All sessions will be stored +in a single file, specified in I<FileName> driver argument as in the above example. If I<FileName> isn't given, +defaults to F</tmp/cgisess.db>, or its equivalent on a non-UNIX system. + +If the directory hierarchy leading to the file does not exist, will be created for you. + +This module takes a B<UMask> option which will be used if DB_File has to create the database file for you. By default +the umask is 0660. + +=head1 LICENSING + +For support and licensing information see L<CGI::Session|CGI::Session> + +=cut + diff --git a/qooxdoo/source/perl/CGI/Session/Driver/file.pm b/qooxdoo/source/perl/CGI/Session/Driver/file.pm new file mode 100644 index 0000000..f25dfea --- /dev/null +++ b/qooxdoo/source/perl/CGI/Session/Driver/file.pm @@ -0,0 +1,217 @@ +package CGI::Session::Driver::file; + +# $Id: file.pm 351 2006-11-24 14:16:50Z markstos $ + +use strict; + +use Carp; +use File::Spec; +use Fcntl qw( :DEFAULT :flock :mode ); +use CGI::Session::Driver; +use vars qw( $FileName $NoFlock $UMask $NO_FOLLOW ); + +BEGIN { + # keep historical behavior + + no strict 'refs'; + + *FileName = \$CGI::Session::File::FileName; +} + +@CGI::Session::Driver::file::ISA = ( "CGI::Session::Driver" ); +$CGI::Session::Driver::file::VERSION = "4.20"; +$FileName = "cgisess_%s"; +$NoFlock = 0; +$UMask = 0660; +$NO_FOLLOW = eval { O_NOFOLLOW } || 0; + +sub init { + my $self = shift; + $self->{Directory} ||= File::Spec->tmpdir(); + + unless ( -d $self->{Directory} ) { + require File::Path; + unless ( File::Path::mkpath($self->{Directory}) ) { + return $self->set_error( "init(): couldn't create directory path: $!" ); + } + } + + $self->{NoFlock} = $NoFlock unless exists $self->{NoFlock}; + $self->{UMask} = $UMask unless exists $self->{UMask}; + + return 1; +} + +sub _file { + my ($self,$sid) = @_; + return File::Spec->catfile($self->{Directory}, sprintf( $FileName, $sid )); +} + +sub retrieve { + my $self = shift; + my ($sid) = @_; + + my $path = $self->_file($sid); + + return 0 unless -e $path; + + # make certain our filehandle goes away when we fall out of scope + local *FH; + + if (-l $path) { + unlink($path) or + return $self->set_error("retrieve(): '$path' appears to be a symlink and I couldn't remove it: $!"); + return 0; # we deleted this so we have no hope of getting back anything + } + sysopen(FH, $path, O_RDONLY | $NO_FOLLOW ) || return $self->set_error( "retrieve(): couldn't open '$path': $!" ); + + $self->{NoFlock} || flock(FH, LOCK_SH) or return $self->set_error( "retrieve(): couldn't lock '$path': $!" ); + + my $rv = ""; + while ( <FH> ) { + $rv .= $_; + } + close(FH); + return $rv; +} + + + +sub store { + my $self = shift; + my ($sid, $datastr) = @_; + + my $path = $self->_file($sid); + + # make certain our filehandle goes away when we fall out of scope + local *FH; + + my $mode = O_WRONLY|$NO_FOLLOW; + + # kill symlinks when we spot them + if (-l $path) { + unlink($path) or + return $self->set_error("store(): '$path' appears to be a symlink and I couldn't remove it: $!"); + } + + $mode = O_RDWR|O_CREAT|O_EXCL unless -e $path; + + sysopen(FH, $path, $mode, $self->{UMask}) or return $self->set_error( "store(): couldn't open '$path': $!" ); + + # sanity check to make certain we're still ok + if (-l $path) { + return $self->set_error("store(): '$path' is a symlink, check for malicious processes"); + } + + # prevent race condition (RT#17949) + $self->{NoFlock} || flock(FH, LOCK_EX) or return $self->set_error( "store(): couldn't lock '$path': $!" ); + truncate(FH, 0) or return $self->set_error( "store(): couldn't truncate '$path': $!" ); + + print FH $datastr; + close(FH) or return $self->set_error( "store(): couldn't close '$path': $!" ); + return 1; +} + + +sub remove { + my $self = shift; + my ($sid) = @_; + + my $directory = $self->{Directory}; + my $file = sprintf( $FileName, $sid ); + my $path = File::Spec->catfile($directory, $file); + unlink($path) or return $self->set_error( "remove(): couldn't unlink '$path': $!" ); + return 1; +} + + +sub traverse { + my $self = shift; + my ($coderef) = @_; + + unless ( $coderef && ref($coderef) && (ref $coderef eq 'CODE') ) { + croak "traverse(): usage error"; + } + + opendir( DIRHANDLE, $self->{Directory} ) + or return $self->set_error( "traverse(): couldn't open $self->{Directory}, " . $! ); + + my $filename_pattern = $FileName; + $filename_pattern =~ s/\./\\./g; + $filename_pattern =~ s/\%s/(\.\+)/g; + while ( my $filename = readdir(DIRHANDLE) ) { + next if $filename =~ m/^\.\.?$/; + my $full_path = File::Spec->catfile($self->{Directory}, $filename); + my $mode = (stat($full_path))[2] + or return $self->set_error( "traverse(): stat failed for $full_path: " . $! ); + next if S_ISDIR($mode); + if ( $filename =~ /^$filename_pattern$/ ) { + $coderef->($1); + } + } + closedir( DIRHANDLE ); + return 1; +} + + +sub DESTROY { + my $self = shift; +} + +1; + +__END__; + +=pod + +=head1 NAME + +CGI::Session::Driver::file - Default CGI::Session driver + +=head1 SYNOPSIS + + $s = new CGI::Session(); + $s = new CGI::Session("driver:file", $sid); + $s = new CGI::Session("driver:file", $sid, {Directory=>'/tmp'}); + + +=head1 DESCRIPTION + +When CGI::Session object is created without explicitly setting I<driver>, I<file> will be assumed. +I<file> - driver will store session data in plain files, where each session will be stored in a separate +file. + +Naming conventions of session files are defined by C<$CGI::Session::Driver::file::FileName> global variable. +Default value of this variable is I<cgisess_%s>, where %s will be replaced with respective session ID. Should +you wish to set your own FileName template, do so before requesting for session object: + + $CGI::Session::Driver::file::FileName = "%s.dat"; + $s = new CGI::Session(); + +For backwards compatibility with 3.x, you can also use the variable name +C<$CGI::Session::File::FileName>, which will override the one above. + +=head2 DRIVER ARGUMENTS + +If you wish to specify a session directory, use the B<Directory> option, which denotes location of the directory +where session ids are to be kept. If B<Directory> is not set, defaults to whatever File::Spec->tmpdir() returns. +So all the three lines in the SYNOPSIS section of this manual produce the same result on a UNIX machine. + +If specified B<Directory> does not exist, all necessary directory hierarchy will be created. + +By default, sessions are created with a umask of 0660. If you wish to change the umask for a session, pass +a B<UMask> option with an octal representation of the umask you would like for said session. + +=head1 NOTES + +If your OS doesn't support flock, you should understand the risks of going without locking the session files. Since +sessions tend to be used in environments where race conditions may occur due to concurrent access of files by +different processes, locking tends to be seen as a good and very necessary thing. If you still want to use this +driver but don't want flock, set C<$CGI::Session::Driver::file::NoFlock> to 1 or pass C<< NoFlock => 1 >> and this +driver will operate without locks. + +=head1 LICENSING + +For support and licensing see L<CGI::Session|CGI::Session> + +=cut diff --git a/qooxdoo/source/perl/CGI/Session/Driver/mysql.pm b/qooxdoo/source/perl/CGI/Session/Driver/mysql.pm new file mode 100644 index 0000000..4d7aaf6 --- /dev/null +++ b/qooxdoo/source/perl/CGI/Session/Driver/mysql.pm @@ -0,0 +1,113 @@ +package CGI::Session::Driver::mysql; + +# $Id: mysql.pm 351 2006-11-24 14:16:50Z markstos $ + +use strict; +use Carp; +use CGI::Session::Driver::DBI; + +@CGI::Session::Driver::mysql::ISA = qw( CGI::Session::Driver::DBI ); +$CGI::Session::Driver::mysql::VERSION = "4.20"; + +sub _mk_dsnstr { + my ($class, $dsn) = @_; + unless ( $class && $dsn && ref($dsn) && (ref($dsn) eq 'HASH')) { + croak "_mk_dsnstr(): usage error"; + } + + my $dsnstr = $dsn->{DataSource}; + if ( $dsn->{Socket} ) { + $dsnstr .= sprintf(";mysql_socket=%s", $dsn->{Socket}); + } + if ( $dsn->{Host} ) { + $dsnstr .= sprintf(";host=%s", $dsn->{Host}); + } + if ( $dsn->{Port} ) { + $dsnstr .= sprintf(";port=%s", $dsn->{Port}); + } + return $dsnstr; +} + + +sub init { + my $self = shift; + if ( $self->{DataSource} && ($self->{DataSource} !~ /^dbi:mysql/i) ) { + $self->{DataSource} = "dbi:mysql:database=" . $self->{DataSource}; + } + + if ( $self->{Socket} && $self->{DataSource} ) { + $self->{DataSource} .= ';mysql_socket=' . $self->{Socket}; + } + return $self->SUPER::init(); +} + +sub store { + my $self = shift; + my ($sid, $datastr) = @_; + croak "store(): usage error" unless $sid && $datastr; + + my $dbh = $self->{Handle}; + $dbh->do("REPLACE INTO " . $self->table_name . " (id, a_session) VALUES(?, ?)", undef, $sid, $datastr) + or return $self->set_error( "store(): \$dbh->do failed " . $dbh->errstr ); + return 1; +} + + +# If the table name hasn't been defined yet, check this location for 3.x compatibility +sub table_name { + my $self = shift; + unless (defined $self->{TableName}) { + $self->{TableName} = $CGI::Session::MySQL::TABLE_NAME; + } + return $self->SUPER::table_name(@_); +} + +1; + +__END__; + +=pod + +=head1 NAME + +CGI::Session::Driver::mysql - CGI::Session driver for MySQL database + +=head1 SYNOPSIS + + $s = new CGI::Session( "driver:mysql", $sid); + $s = new CGI::Session( "driver:mysql", $sid, { DataSource => 'dbi:mysql:test', + User => 'sherzodr', + Password => 'hello' }); + $s = new CGI::Session( "driver:mysql", $sid, { Handle => $dbh } ); + +=head1 DESCRIPTION + +B<mysql> stores session records in a MySQL table. For details see L<CGI::Session::Driver::DBI|CGI::Session::Driver::DBI>, its parent class. + +It's especially important for the MySQL driver that the session ID column be +defined as a primary key, or at least "unique", like this: + + CREATE TABLE sessions ( + id CHAR(32) NOT NULL PRIMARY KEY, + a_session TEXT NOT NULL + ); + +=head2 DRIVER ARGUMENTS + +B<mysql> driver supports all the arguments documented in L<CGI::Session::Driver::DBI|CGI::Session::Driver::DBI>. In addition, I<DataSource> argument can optionally leave leading "dbi:mysql:" string out: + + $s = new CGI::Session( "driver:mysql", $sid, {DataSource=>'shopping_cart'}); + # is the same as: + $s = new CGI::Session( "driver:mysql", $sid, {DataSource=>'dbi:mysql:shopping_cart'}); + +=head2 BACKWARDS COMPATIBILITY + +For backwards compatibility, you can also set the table like this before calling C<new()>. However, it is not recommended because it can cause conflicts in a persistent environment. + + $CGI::Session::MySQL::TABLE_NAME = 'my_sessions'; + +=head1 LICENSING + +For support and licensing see L<CGI::Session|CGI::Session>. + +=cut diff --git a/qooxdoo/source/perl/CGI/Session/Driver/postgresql.pm b/qooxdoo/source/perl/CGI/Session/Driver/postgresql.pm new file mode 100644 index 0000000..ccfdce5 --- /dev/null +++ b/qooxdoo/source/perl/CGI/Session/Driver/postgresql.pm @@ -0,0 +1,134 @@ +package CGI::Session::Driver::postgresql; + +# $Id: postgresql.pm 351 2006-11-24 14:16:50Z markstos $ + +# CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session +# +# Copyright (C) 2002 Cosimo Streppone, cosimo@cpan.org +# This module is based on CGI::Session::Driver::mysql module +# by Sherzod Ruzmetov, original author of CGI::Session modules +# and CGI::Session::Driver::mysql driver. + +use strict; +use Carp "croak"; + +use CGI::Session::Driver::DBI; +use DBD::Pg qw(PG_BYTEA PG_TEXT); + +$CGI::Session::Driver::postgresql::VERSION = '4.20'; +@CGI::Session::Driver::postgresql::ISA = qw( CGI::Session::Driver::DBI ); + + +sub init { + my $self = shift; + my $ret = $self->SUPER::init(@_); + + # Translate external ColumnType into internal value. See POD for details. + $self->{PgColumnType} ||= (defined $self->{ColumnType} and (lc $self->{ColumnType} eq 'binary')) + ? PG_BYTEA + : PG_TEXT + ; + + return $ret; +} + +sub store { + my $self = shift; + my ($sid, $datastr) = @_; + croak "store(): usage error" unless $sid && $datastr; + + my $dbh = $self->{Handle}; + my $type = $self->{PgColumnType}; + + if ($type == PG_TEXT && $datastr =~ tr/\x00//) { + croak "Unallowed characters used in session data. Please see CGI::Session::Driver::postgresql ". + "for more information about null characters in text columns."; + } + + local $dbh->{RaiseError} = 1; + eval { + # There is a race condition were two clients could run this code concurrently, + # and both end up trying to insert. That's why we check for "duplicate" below + my $sth = $dbh->prepare( + "INSERT INTO " . $self->table_name . " (a_session,id) SELECT ?, ? + WHERE NOT EXISTS (SELECT 1 FROM " . $self->table_name . " WHERE id=? LIMIT 1)"); + + $sth->bind_param(1,$datastr,{ pg_type => $type }); + $sth->bind_param(2, $sid); + $sth->bind_param(3, $sid); # in the SELECT statement + my $rv = ''; + eval { $rv = $sth->execute(); }; + if ( $rv eq '0E0' or (defined $@ and $@ =~ m/duplicate/i) ) { + my $sth = $dbh->prepare("UPDATE " . $self->table_name . " SET a_session=? WHERE id=?"); + $sth->bind_param(1,$datastr,{ pg_type => $type }); + $sth->bind_param(2,$sid); + $sth->execute; + } + else { + # Nothing. Our insert has already happened + } + }; + if ($@) { + return $self->set_error( "store(): failed with message: $@ " . $dbh->errstr ); + + } + else { + return 1; + + } + + +} + +1; + +=pod + +=head1 NAME + +CGI::Session::Driver::postgresql - PostgreSQL driver for CGI::Session + +=head1 SYNOPSIS + + use CGI::Session; + $session = new CGI::Session("driver:PostgreSQL", undef, {Handle=>$dbh}); + +=head1 DESCRIPTION + +CGI::Session::PostgreSQL is a L<CGI::Session|CGI::Session> driver to store session data in a PostgreSQL table. + +=head1 STORAGE + +Before you can use any DBI-based session drivers you need to make sure compatible database table is created for CGI::Session to work with. Following command will produce minimal requirements in most SQL databases: + + CREATE TABLE sessions ( + id CHAR(32) NOT NULL PRIMARY KEY, + a_session BYTEA NOT NULL + ); + +and within your code use: + + use CGI::Session; + $session = new CGI::Session("driver:PostgreSQL", undef, {Handle=>$dbh, ColumnType=>"binary"}); + +Please note the I<ColumnType> argument. PostgreSQL's text type has problems when trying to hold a null character. (Known as C<"\0"> in Perl, not to be confused with SQL I<NULL>). If you know there is no chance of ever having a null character in the serialized data, you can leave off the I<ColumnType> attribute. Using a I<BYTEA> column type and C<< ColumnType => 'binary' >> is recommended when using L<Storable|CGI::Session::Serialize::storable> as the serializer or if there's any possibility that a null value will appear in any of the serialized data. + +For more details see L<CGI::Session::Driver::DBI|CGI::Session::Driver::DBI>, parent class. + +Also see L<sqlite driver|CGI::Session::Driver::sqlite>, which exercises different method for dealing with binary data. + +=head1 COPYRIGHT + +Copyright (C) 2002 Cosimo Streppone. All rights reserved. This library is free software and can be modified and distributed under the same terms as Perl itself. + +=head1 AUTHORS + +Cosimo Streppone <cosimo@cpan.org>, heavily based on the CGI::Session::MySQL driver by Sherzod Ruzmetov, original author of CGI::Session. + +Matt LeBlanc contributed significant updates for the 4.0 release. + +=head1 LICENSING + +For additional support and licensing see L<CGI::Session|CGI::Session> + +=cut diff --git a/qooxdoo/source/perl/CGI/Session/Driver/sqlite.pm b/qooxdoo/source/perl/CGI/Session/Driver/sqlite.pm new file mode 100644 index 0000000..561e9a7 --- /dev/null +++ b/qooxdoo/source/perl/CGI/Session/Driver/sqlite.pm @@ -0,0 +1,99 @@ +package CGI::Session::Driver::sqlite; + +# $Id: sqlite.pm 351 2006-11-24 14:16:50Z markstos $ + +use strict; + +use File::Spec; +use base 'CGI::Session::Driver::DBI'; +use DBI qw(SQL_BLOB); +use Fcntl; + +$CGI::Session::Driver::sqlite::VERSION = "4.20"; + +sub init { + my $self = shift; + + unless ( $self->{Handle}) { + $self->{DataSource} = "dbi:SQLite:dbname=" . $self->{DataSource} unless ( $self->{DataSource} =~ /^dbi:sqlite/i ); + } + + $self->SUPER::init() or return; + + $self->{Handle}->{sqlite_handle_binary_nulls} = 1; + return 1; +} + +sub store { + my $self = shift; + my ($sid, $datastr) = @_; + return $self->set_error("store(): usage error") unless $sid && $datastr; + + my $dbh = $self->{Handle}; + + my $sth = $dbh->prepare("SELECT id FROM " . $self->table_name . " WHERE id=?"); + unless ( defined $sth ) { + return $self->set_error( "store(): \$sth->prepare failed with message " . $dbh->errstr ); + } + + $sth->execute( $sid ) or return $self->set_error( "store(): \$sth->execute failed with message " . $dbh->errstr ); + if ( $sth->fetchrow_array ) { + __ex_and_ret($dbh,"UPDATE " . $self->table_name . " SET a_session=? WHERE id=?",$datastr,$sid) + or return $self->set_error( "store(): serialize to db failed " . $dbh->errstr ); + } else { + __ex_and_ret($dbh,"INSERT INTO " . $self->table_name . " (a_session,id) VALUES(?, ?)",$datastr, $sid) + or return $self->set_error( "store(): serialize to db failed " . $dbh->errstr ); + } + return 1; +} + +sub __ex_and_ret { + my ($dbh,$sql,$datastr,$sid) = @_; + # fix rt #18183 + local $@; + eval { + my $sth = $dbh->prepare($sql) or return 0; + $sth->bind_param(1,$datastr,SQL_BLOB) or return 0; + $sth->bind_param(2,$sid) or return 0; + $sth->execute() or return 0; + }; + return ! $@; +} + +1; + +__END__; + +=pod + +=head1 NAME + +CGI::Session::Driver::sqlite - CGI::Session driver for SQLite + +=head1 SYNOPSIS + + $s = new CGI::Session("driver:sqlite", $sid, {DataSource=>'/my/folder/sessions.sqlt'}); + $s = new CGI::Session("driver:sqlite", $sid, {Handle=>$dbh}); + +=head1 DESCRIPTION + +B<sqlite> driver stores session data in SQLite files using L<DBD::SQLite|DBD::SQLite> DBI driver. More details see L<CGI::Session::Driver::DBI|CGI::Session::Driver::DBI>, its parent class. + +=head1 DRIVER ARGUMENTS + +Supported driver arguments are I<DataSource> and I<Handle>. B<At most> only one of these arguments can be set while creating session object. + +I<DataSource> should be in the form of C<dbi:SQLite:dbname=/path/to/db.sqlt>. If C<dbi:SQLite:> is missing it will be prepended for you. If I<Handle> is present it should be database handle (C<$dbh>) returned by L<DBI::connect()|DBI/connect()>. + +As of version 1.7 of this driver, the third argument is B<NOT> optional. Using a default database in the temporary directory is a security risk since anyone on the machine can create and/or read your session data. If you understand these risks and still want the old behavior, you can set the C<DataSource> option to I<'/tmp/sessions.sqlt'>. + +=head1 BUGS AND LIMITATIONS + +None known. + +=head1 LICENSING + +For support and licensing see L<CGI::Session|CGI::Session> + +=cut + |