view release on metacpan or  search on metacpan

Session.pm  view on Meta::CPAN

sub Authenticate{

	my %Param = (agent => 'AISclient', @_);
	my %Result;
	my $AISXML;


	print STDERR "$$ Session coox: $ENV{HTTP_COOKIE}\n";
	my (@Cookies) = ($ENV{HTTP_COOKIE} =~  /AIS_Session=(\w+)/g);
	tie my %Session, $Param{tieargs}->[0],
	$Param{tieargs}->[1],$Param{tieargs}->[2],$Param{tieargs}->[3],
	$Param{tieargs}->[4],$Param{tieargs}->[5],$Param{tieargs}->[6],
	$Param{tieargs}->[7],$Param{tieargs}->[8],$Param{tieargs}->[9]
		or croak "failed to tie @{$Param{tieargs}}";

	print STDERR "Session database has ",scalar(keys %Session)," keys\n";

	my $Cookie;

	# make Cookie imply its validity
	push @Cookies, undef;
	while ($Cookie = shift @Cookies){
		#$Session{$Cookie} and last;
		if($Session{$Cookie}){
			print STDERR "Session $Cookie exists\n";
			last;
		}else{
			print STDERR "Session <$Cookie> false\n";

		};
	};	

	my $OTUkey;
	my $SessionKey;
	my ($PostKey) = ($ENV{QUERY_STRING} =~ /AIS_POST_key=(\w+)/);

	# if (!$Cookie and $ENV{REQUEST_METHOD} eq 'POST' ){
	# in general, whenever we've got the wrong name for the
	# server, it won't work.  So we need to redirect ourselves
	# back to here with the right name for the server, and
	# then we'll get our cookie, if we have one.
	if (!$Cookie and !defined($PostKey) ){
		# print STDERR "$$ Cookieless POST caught early\n";
		print STDERR "$$ possible wrong SERVER_NAME\n";
		if ($ENV{REQUEST_METHOD} eq 'POST' ){
			$PostKey = join('',time,(map {("A".."Z")[rand 26]}(0..9)));
			$Session{$PostKey} = join('',(<>));
		}else{
			$PostKey = '';
		};

		print "Location: http://$ENV{SERVER_NAME}$ENV{REQUEST_URI}?AIS_POST_key=$PostKey&$ENV{QUERY_STRING}$CRLF$CRLF";
		exit;

Session.pm  view on Meta::CPAN

			open STDIN, "<&POSTREAD";
			$ENV{REQUEST_METHOD} = 'POST';

		}else{
			# in child -- write POSTdata to pipe and exit
			close STDOUT;
			close STDIN;
			close POSTREAD;
			print POSTWRITE '&',$Session{$PostKey};
			close POSTWRITE or die "$$: Error closing POSTWRITE\n";
			$Cookie and delete $Session{$PostKey};
			# exit;
			#POSIX:_exit(0); # perldoc -f exit
			exec '/usr/bin/true';
		};
	};

	if ($ENV{QUERY_STRING} =~ /AIS_OTUkey=(\w+)/){
	   $OTUkey = $1;
	   my ($method, $host, $port, $path) =
	     ($Param{aissri} =~ m#^(\w+)://([^:/]+):?(\d*)(.+)$#)
	      or die "Could not get meth,hos,por,pat from <$Param{aissri}>";
	   unless ($method eq 'http'){
		croak "aissri parameter must begin 'http://' at this time";
	   };

	   # my $Response = `lynx -source $Param{aissri}query?$OTUkey$CRLF$CRLF`
	   my $Response = miniget $host, $port,
	   "$Param{aissri}query?$OTUkey", $Param{agent};

	   $SessionKey = join('',time,(map {("A".."Z")[rand 26]}(0..19)));
	   # print "Set-Cookie: AIS_Session=$SessionKey; path=$ENV{SCRIPT_NAME};$CRLF";
	   print "Set-Cookie: AIS_Session=$SessionKey; path=/; expires=$CRLF";
	   ($AISXML) =
		$Response =~ m#<aisresponse>(.+)</aisresponse>#si
	   	   or die "no <aisresponse> element from $Param{aissri}query?$OTUkey\n";
	   $Session{$SessionKey} = $AISXML;

	}elsif (!$Cookie){
		my $PostString = '';
		# if ($ENV{REQUEST_METHOD} eq 'POST' and !eof){
		if ($ENV{REQUEST_METHOD} eq 'POST' ){
			print STDERR "$$ Cookieless POST\n";
			my $PostKey = join('',time,(map {("A".."Z")[rand 26]}(0..9)));
			$Session{$PostKey} = join('',(<>));
			$PostString = "AIS_POST_key=$PostKey&";

		};
		print "Location: $Param{aissri}present?http://$ENV{SERVER_NAME}$ENV{REQUEST_URI}?${PostString}AIS_OTUkey=\n\n";
		exit;
	}else{ # We have a cookie
		$AISXML = $Session{$Cookie};
		delete  $Session{$Cookie} if $ENV{QUERY_STRING} eq 'AIS_LOGOUT';
	};

	foreach (qw{
			identity
			error
			aissri
			user_remote_addr
		       },
		    @{$Param{XML}}
	){

Session.pm  view on Meta::CPAN

	};

	if ( defined($Param{timeout})){
		my $TO = $Param{timeout};
		delete @Session{ grep { time - $_ > $TO } keys %Session };

	};

	#Suppress caching NULL and ERROR
	if( $Result{identity} eq 'NULL' or $Result{identity} eq 'ERROR'){
		print "Set-Cookie: AIS_Session=$CRLF";
	        $SessionKey and delete $Session{$SessionKey} ;

		$Param{nodie} or die "AIS: $Result{identity} identity $Result{error} error";

	};
	return \%Result;
};


# Preloaded methods go here.