$VERSION
=
'1.01'
;
sub
new {
my
$class
=
shift
;
return
bless
{},
$class
;
}
sub
insert {
my
$self
=
shift
;
my
$session
=
shift
;
$self
->{args} =
$session
->{args};
my
$msg
=
$self
->ldap->add(
"cn=$session->{data}->{_session_id},"
.
$self
->{args}->{ldapConfBase},
attrs
=> [
objectClass
=> [
'top'
,
'applicationProcess'
],
cn
=>
$session
->{data}->{_session_id},
description
=>
$session
->{serialized},
],
);
$self
->logError(
$msg
)
if
(
$msg
->code );
}
sub
update {
my
$self
=
shift
;
my
$session
=
shift
;
$self
->{args} =
$session
->{args};
my
$msg
=
$self
->ldap->modify(
"cn=$session->{data}->{_session_id},"
.
$self
->{args}->{ldapConfBase},
replace
=> {
description
=>
$session
->{serialized},
},
);
$self
->logError(
$msg
)
if
(
$msg
->code);
}
sub
materialize {
my
$self
=
shift
;
my
$session
=
shift
;
$self
->{args} =
$session
->{args};
my
$msg
=
$self
->ldap->search(
base
=>
"cn=$session->{data}->{_session_id},"
.
$self
->{args}->{ldapConfBase},
filter
=>
'(objectClass=applicationProcess)'
,
scope
=>
'base'
,
attrs
=> [
'description'
],
);
$self
->logError(
$msg
)
if
(
$msg
->code );
eval
{
$session
->{serialized} =
$msg
->shift_entry()->get_value(
'description'
);};
if
(!
defined
$session
->{serialized}) {
die
"Object does not exist in data store"
;
}
}
sub
remove {
my
$self
=
shift
;
my
$session
=
shift
;
$self
->{args} =
$session
->{args};
$self
->ldap->
delete
(
"cn=$session->{data}->{_session_id},"
.
$self
->{args}->{ldapConfBase});
}
sub
ldap {
my
$self
=
shift
;
return
$self
->{ldap}
if
(
$self
->{ldap});
my
$useTls
= 0;
my
$tlsParam
;
my
@servers
= ();
foreach
my
$server
(
split
/[\s,]+/,
$self
->{args}->{ldapServer} ) {
if
(
$server
=~ m{^ldap\+tls://([^/]+)/?\??(.*)$} ) {
$useTls
= 1;
$server
= $1;
$tlsParam
= $2 ||
""
;
}
else
{
$useTls
= 0;
}
push
@servers
,
$server
;
}
my
$ldap
= Net::LDAP->new(
\
@servers
,
onerror
=>
undef
,
(
$self
->{args}->{ldapPort} ? (
port
=>
$self
->{args}->{ldapPort} ) : () ),
) or
die
(
'Unable to connect to '
.
join
(
' '
,
@servers
));
if
(
$useTls
) {
my
%h
=
split
( /[&=]/,
$tlsParam
);
$h
{cafile} =
$self
->{args}->{caFile}
if
(
$self
->{args}->{caFile} );
$h
{capath} =
$self
->{args}->{caPath}
if
(
$self
->{args}->{caPath} );
my
$start_tls
=
$ldap
->start_tls(
%h
);
if
(
$start_tls
->code ) {
$self
->logError(
$start_tls
);
return
;
}
}
my
$bind
=
$ldap
->
bind
(
$self
->{args}->{ldapBindDN},
password
=>
$self
->{args}->{ldapBindPassword} );
if
(
$bind
->code ) {
$self
->logError(
$bind
);
return
;
}
$self
->{ldap} =
$ldap
;
return
$ldap
;
}
sub
logError {
my
$self
=
shift
;
my
$ldap_operation
=
shift
;
die
"LDAP error "
.
$ldap_operation
->code .
": "
.
$ldap_operation
->error;
}
1;
=pod
=head1 NAME
Apache::Session::Store::DB_File - Use DB_File to store persistent objects
=head1 SYNOPSIS
my
$store
= new Apache::Session::Store::DB_File;
$store
->insert(
$ref
);
$store
->update(
$ref
);
$store
->materialize(
$ref
);
$store
->remove(
$ref
);
=head1 DESCRIPTION
This module fulfills the storage interface of Apache::Session. The serialized
objects are stored in a Berkeley DB file using the DB_File Perl module. If
DB_File works on your platform, this module should also work.
=head1 OPTIONS
This module requires one argument in the usual Apache::Session style. The
name of the option is FileName, and the value is the full path of the database
file to be used as the backing store. If the database file does not exist,
it will be created. Example:
tie
%s
,
'Apache::Session::DB_File'
,
undef
,
{
FileName
=>
'/tmp/sessions'
};
=head1 AUTHOR
This module was written by Jeffrey William Baker <jwbaker
@acm
.org>.
=head1 SEE ALSO
L<Apache::Session>, L<DB_File>