view release on metacpan or  search on metacpan

client.pm  view on Meta::CPAN

			# most of the time, this is what we are expecting
			goto HAVE_ID ; # unless $Sessions{$Coo}->{identity} eq 'ERROR';
		}else{
			# eval <<'NOIDENTITYEVAL';
			# get an identity from the AIS server
			# (process might be underway already)
			if ($ENV{QUERY_STRING} =~ /^OTU_KEY=(\w+)/){
				# eval <<'HAVEOTUKEYEVAL';
				my $OTUkey = $1;
				# carp "have aissri [$aissri]";
				my ($method, $host, $port, $path) =
				   ($aissri =~ m#^(\w+)://([^:/]+):?(\d*)(.+)$#)
				      or die "Could not get meth,hos,por,pat from aissri <$aissri>";
				# carp "have \$method, \$host, \$port, \$path $method, $host, $port, $path";
				unless ($method eq 'http'){
					croak "aissri parameter must begin 'http://' at this time";
				};

				# issue the AIS QUERY request
				# carp "doing miniget $host, $port,${aissri}query?$OTUkey, $agent";

				my $Response = miniget $host, $port,
				  "${aissri}query?$OTUkey", $agent;

				# carp "got $Response";
				(my $AISXML) = 
				$Response =~ m#<aisresponse>(.+)</aisresponse>#si
				   or die "no <aisresponse> element from ${aissri}query?$OTUkey\n in BEGINRESPONSE\n$Response\nENDRESPONSE";
				$Sessions{$Coo}->{AISXML} = $AISXML;
				# parse AISXML...
				my %aisvar;
				foreach (qw{
					identity
					error
					aissri
					user_remote_addr
			       		}
					# ,@{$Param{XML}}
				){
					$AISXML =~ m#<$_>(.+)</$_>#si or next;
					$aisvar{$_} = $1;
					# print STDERR "ais var $_ is $1\n";
				};

				if ($aisvar{identity} eq 'NULL'){
redirect(
"$aisvar{aissri}add?RU=http$ssl_ext://$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}$ENV{PATH_INFO}");
					exit;
				};

				# hooray! we have an identity.
				foreach (keys %aisvar){
					$Sessions{$Coo}->{$_} = $aisvar{$_};
				};

				#reconstruct initial form data if any
				$ENV{QUERY_STRING} = delete $Sessions{$Coo}->{QueryString};
				if(exists $Sessions{$Coo}->{PostData}){
					pipe(POSTREAD,POSTWRITE) or die "Cannot create pipe: $!";
					if (fork){
						# we are in parent
						close POSTWRITE;
						open STDIN, "<&POSTREAD";
						$ENV{REQUEST_METHOD} = 'POST';

					}else{
						# in child -- write POSTdata to pipe and exit
						close STDOUT;
						close STDIN;
						close POSTREAD;
						print POSTWRITE delete $Sessions{$Coo}->{PostData};
						close POSTWRITE or die "$$: Error closing POSTWRITE\n";
						# exit;
						#POSIX:_exit(0); # perldoc -f exit
						exec '/usr/bin/true';
					};
# HAVEOTUKEYEVAL
				};
				goto HAVE_ID;
			}else{
				# redirect us to AIS server PRESENT function

				redirect "${aissri}present?http$ssl_ext://$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?OTU_KEY=";
				exit;


			};

# NOIDENTITYEVAL
		};
	}else{
		# no cookie.
		my $suffix = '';
		if($ENV{QUERY_STRING}eq'AIS_INITIAL'){
			# for when the first time we were called with the wrong host name.
			$suffix = 2;
		};
		$ENV{QUERY_STRING}eq'AIS_INITIAL2'and goto NOCOO;
		($Coo = localtime) =~ s/\W//g;
		my @chars = 'A'..'Z' ;
		substr($Coo, rand(length $Coo), 1) = $chars[rand @chars]
		foreach 1..8;
		print "X-Ais-Received-Request-Method: $ENV{REQUEST_METHOD}\n";
		print "X-Ais-Received-Query-String: $ENV{QUERY_STRING}\n";
		$Sessions{$Coo}->{QueryString} = $ENV{QUERY_STRING};
		$ENV{REQUEST_METHOD} =~ /POST/i and
		$Sessions{$Coo}->{PostData} = <>;

		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;