X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FAsyncMsg.pm;h=c2eeaadcaf453c587da1278d9165b46542f7296f;hb=78453d06cd4c41870906082cc40132b75e1a3eba;hp=0456efc98906d2184ff2063d2bcee276075e6d06;hpb=8bb293d5a1ca7a53f2ce50bd8e9e728865069b7f;p=spider.git

diff --git a/perl/AsyncMsg.pm b/perl/AsyncMsg.pm
index 0456efc9..c2eeaadc 100644
--- a/perl/AsyncMsg.pm
+++ b/perl/AsyncMsg.pm
@@ -35,9 +35,9 @@ sub handle_get
 	my $conn = shift;
 	my $msg = shift;
 
-	my $state = $conn->{state};
+	my $state = $conn->{_asstate};
 	
-	dbg("asyncmsg: $msg") if isdbg('async');
+	dbg("asyncmsg: $state $msg") if isdbg('async');
 
 	# no point in going on if there is no-one wanting the output anymore
 	my $dxchan = DXChannel::get($conn->{caller});
@@ -51,17 +51,44 @@ sub handle_get
 		my ($http, $code, $ascii) = $msg =~ m|(HTTP/\d\.\d)\s+(\d+)\s+(.*)|;
 		if ($code == 200) {
 			# success
-			$conn->{state} = 'waitblank';
+			$conn->{_asstate} = 'waitblank';
+		} elsif ($code == 302) {
+			# redirect
+			$conn->{_asstate} = 'waitlocation';
 		} else {
 			$dxchan->send("$code $ascii");
 			$conn->disconnect;
 		} 
+	} elsif ($state  eq 'waitlocation') {
+		my ($path) = $msg =~ m|Location:\s*(.*)|;
+		if ($path) {
+			my $newconn;
+			my @uri = split m|/+|, $path;
+			if ($uri[0] eq 'http:') {
+				shift @uri;
+				my $host = shift @uri;
+				my $newpath = '/' . join('/', @uri);
+				$newpath .= '/' if $path =~ m|/$|;
+				$newconn = _getpost(ref $conn, $conn->{_assort}, $conn->{caller}, $host, 80, $newpath, @{$conn->{_asargs}});
+			} elsif ($path =~ m|^/|) {
+				$newconn = _getpost(ref $conn, $conn->{_assort}, $conn->{caller}, $conn->{peerhost}, $conn->{peerport}, $path, @{$conn->{_asargs}});
+			}
+			if ($newconn) {
+				# copy over any elements in $conn that are not in $newconn
+				while (my ($k,$v) = each %$conn) {
+					dbg("async: $state copying over $k -> \$newconn") if isdbg('async');
+					$newconn{$k} = $v unless exists $newconn{$k};
+				}
+			}
+			delete $conn->{on_disconnect};
+			$conn->disconnect;
+		}
 	} elsif ($state eq 'waitblank') {
 		unless ($msg) {
-			$conn->{state} = 'indata';
+			$conn->{_asstate} = 'indata';
 		}
-	} else {
-		if (my $filter = $conn->{filter}) {
+	} elsif ($conn->{_asstate} eq 'indata') {
+		if (my $filter = $conn->{_asfilter}) {
 			no strict 'refs';
 			# this will crash if the command has been redefined and the filter is a
 			# function defined there whilst the request is in flight,
@@ -142,14 +169,15 @@ sub _getpost
 	my $path = shift;
 	my %args = @_;
 	
-	my $filter = shift;
-	
+
 	my $conn = $pkg->new($call, \&handle_get);
-	$conn->{state} = 'waitreply';
-	$conn->{filter} = delete $args{filter} if exists $args{filter};
+	$conn->{_asargs} = [@_];
+	$conn->{_asstate} = 'waitreply';
+	$conn->{_asfilter} = delete $args{filter} if exists $args{filter};
 	$conn->{prefix} = delete $args{prefix} if exists $args{prefix};
 	$conn->{on_disconnect} = delete $args{on_disc} || delete $args{on_disconnect};
 	$conn->{path} = $path;
+	$conn->{_assort} = $sort;
 	
 	$r = $conn->connect($host, $port);
 	if ($r) {
@@ -219,9 +247,9 @@ sub connect
 	# start a connection
 	my $r = $conn->SUPER::connect($host, $port);
 	if ($r) {
-		dbg("HTTPMsg: Connected $conn->{cnum} to $host $port") if isdbg('async');
+		dbg("AsyncMsg: Connected $conn->{cnum} to $host $port") if isdbg('async');
 	} else {
-		dbg("HTTPMsg: ***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('async');
+		dbg("AsyncMsg: ***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('async');
 	}
 	
 	return $r;