AIS-client
view release on metacpan or search on metacpan
package AIS::client;
use 5.006;
$VERSION = 0.07;
use Carp;
use DirDB 0.09; # or any other concurrent-access-safe
# persistence abstraction
# that can store and retreive hash references
# and has a working DELETE method
#
# but if you change it, you'll also need to change
# the lines that refer to DirDB subsequently,
# including the tieing of %{"caller().'::AIS_STASH'}
sub miniget($$$$){
my($HostName, $PortNumber, $Desired, $agent) = @_;
eval <<'ENDMINIGET';
use Socket qw(:DEFAULT :crlf);
$PortNumber ||= 80;
$agent ||= "$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}";
my $iaddr = inet_aton($HostName) || die "Cannot find host named $HostName";
my $paddr = sockaddr_in($PortNumber,$iaddr);
my $proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(SOCK, $paddr) || die "connect: $!";
# SOCK->autoflush(1);
my $ofh = select SOCK;
$| = 1;
select $ofh;
my $Query = join("\r\n", # "CRLF"
"GET $Desired HTTP/1.1",
# Do we need a Host: header with an "AbsoluteURI?"
# not needed: http://www.w3.org/Protocols/rfc2616/rfc2616-sec5.html#sec5.2
# but this is trumped by an Apache error message invoking RFC2068 sections 9 and 14.23
"Host: $HostName",
"User-Agent: $agent",
"Connection: close",
'','') ;
print SOCK $Query or croak "could not print to miniget socket";
join('',<SOCK>);
ENDMINIGET
}
sub housekeeping(){
my @deletia;
my $t = time;
while(($k,$v) = each %Sessions){
if ($v->{last_access} < ($t - $maxage)){
push @deletia, $k
};
};
@Sessions{@deletia} = ();
};
sub redirect($){
print <<EOF;
Location: $_[0]
Content-Type: text/html
<HTML><HEAD><TITLE>Relocate </TITLE>
<META HTTP-EQUIV="REFRESH" CONTENT="1;URL=$_[0]">
</HEAD>
<BODY>
<A HREF="$_[0]">
print "Set-Cookie:/${SessionPrefix}_session=$Coo\n";
redirect "http$ssl_ext://$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?AIS_INITIAL$suffix";
exit;
};
print <<EOF;
Content-Type: text/plain
internal AIS module logic error
EOF
exit;
NOCOO:
print <<EOF;
Content-Type: text/plain
Cookies appear to be disabled in your web browser.
Cookie string: $ENV{HTTP_COOKIE}
This program uses a session and authentication system
(AIS, the Authenticated Identity Service)
that relies on cookies.
Please enable cookies and try again. (you may have to log in)
*******************************************************************
You appear to be using a $ENV{HTTP_USER_AGENT}
from $ENV{REMOTE_ADDR}
to access http$ssl_ext://$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}
(this web server is adminned by $ENV{SERVER_ADMIN})
EOF
exit;
HAVE_ID:
$Sessions{$Coo}->{last_access} = time;
$Identity = $Sessions{$Coo}->{identity};
if($Identity eq 'ERROR'){
print <<EOF;
Content-type: text/plain
There was an error with the authentication layer
of this web service: $Sessions{$Coo}->{error}
please contact $ENV{SERVER_ADMIN} to report this.
EOF
exit;
};
# print STDERR "setting ",caller().'::AIS_IDENTITY', " to $Sessions{$Coo}->{identity}\n";
# $ENV{AIS_IDENTITY} = $Sessions{$Coo}->{identity};
$ENV{AIS_IDENTITY} =
${caller().'::AIS_IDENTITY'} = $Sessions{$Coo}->{identity};
tie %{caller().'::AIS_STASH'}, DirDB => ${tied(%{$Sessions{$Coo}})};
}; # import
1;
__END__
1;
__END__
=head1 NAME
AIS::client - get an authenticated e-mail address for users of your web service
=head1 SYNOPSIS
BEGIN{umask(0077 & umask())}; # if your web server gives you a 0177 umask
use AIS::client;
print "Content-type: text/plain\n\nWelcome $AIS_IDENTITY\n";
print "this is page view number ", ++$AIS_STASH{accesses};
__END__
=head1 DESCRIPTION
The goal of AIS::client is to provide a very easy way to require an
authenticated identity for a perl web application. The user's e-mail
address appears in a global variable C<$AIS_IDENTITY> and a persistent
session stash is available in C<%AIS_STASH>.
=head1 USE-LINE CONFIGURATION OPTIONS
=item aissri
By default, AIS::client will refer to the AIS service defined
at http://www.pay2send.com/cgi/ais/ but an alternate AIS service
can be specified with the C<aissri> parameter:
use AIS::client aissri => 'http://www.cpan.org/service/ais/';
=item agent
By default, AIS::client will give the URL of the webpage being
requested as the agent string, but an alternate agent string
can be specified with the C<agent> parameter:
use AIS::client aissri => "Bob's web services: account MZNXBCV";
It is expected that a subscription-based or otherwise access-controlled
AIS service might issue expiring capability keys which would have to be
listed as part of the agent string.
=item prefix
By default, C<AIS>, which means that AIS::client will store session
data (incliding identity, which is also available as
C<$AIS_STASH{identity}>) in subdirectories under a directory
called C<AIS_sessions> under the current directory
your script runs in. This can be changed with the C<prefix> parameter:
( run in 1.098 second using v1.01-cache-2.11-cpan-524268b4103 )