--- trunk/Estraier.pm 2006/01/05 17:54:18 33 +++ trunk/Estraier.pm 2006/01/05 22:36:10 39 @@ -661,9 +661,9 @@ package Search::Estraier::Node; -use Carp qw/croak/; +use Carp qw/carp croak/; use URI; -use URI::Escape qw/uri_escape/; +use MIME::Base64; use IO::Socket::INET; =head1 Search::Estraier::Node @@ -689,6 +689,11 @@ }; bless($self, $class); + if (@_) { + $self->{debug} = 1; + warn "## Node debug on\n"; + } + $self ? return $self : return undef; } @@ -747,7 +752,7 @@ sub set_auth { my $self = shift; my ($login,$passwd) = @_; - $self->{auth} = uri_escape( "$login:$passwd" ); + $self->{auth} = encode_base64( "$login:$passwd" ); } =head2 status @@ -784,8 +789,16 @@ my $status = -1; + warn "## $url\n"; + $url = new URI($url); - return unless ($url->scheme ne 'http' || ! $url->host || $url->port < 1); + if ( + !$url || !$url->scheme || !$url->scheme eq 'http' || + !$url->host || !$url->port || $url->port < 1 + ) { + carp "can't parse $url\n"; + return -1; + } my ($host,$port,$query) = ($url->host, $url->port, $url->path); @@ -794,54 +807,78 @@ $query = "http://$host:$port/$query"; } - $query .= '?' + $url->query if ($url->query && ! $reqbody); + $query .= '?' . $url->query if ($url->query && ! $reqbody); - my $sock = IO::Socket::INET->new( - PeerAddr => $host, - PeerPort => $port, - Proto => 'tcp', - Timeout => $self->{timeout} || 90, - ) || return -1; + my $headers; if ($reqbody) { - print $sock "POST $query HTTP/1.0\r\n"; + $headers .= "POST $query HTTP/1.0\r\n"; } else { - print $sock "GET $query HTTP/1.0\r\n"; + $headers .= "GET $query HTTP/1.0\r\n"; } - print $sock "Host: $url->host:$url->port\r\n"; - print $sock "Connection: close\r\n"; - print $sock "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n"; - print $sock "Content-Type $content_type\r\n"; - print $sock "Authorization: Basic $self->{auth}\r\n"; + $headers .= "Host: $url->host:$url->port\r\n"; + $headers .= "Connection: close\r\n"; + $headers .= "User-Agent: Search-Estraier/$Search::Estraier::VERSION\r\n"; + $headers .= "Content-Type $content_type\r\n"; + $headers .= "Authorization: Basic $self->{auth}\r\n"; + my $len = 0; { use bytes; - print $sock "Content-Length: ", length($reqbody), "\r\n"; + $len = length($reqbody) if ($reqbody); + } + $headers .= "Content-Length: $len\r\n"; + $headers .= "\r\n"; + + my $sock = IO::Socket::INET->new( + PeerAddr => $host, + PeerPort => $port, + Proto => 'tcp', + Timeout => $self->{timeout} || 90, + ); + + if (! $sock) { + carp "can't open socket to $host:$port"; + return -1; } - print $sock "\r\n"; - print $sock $$reqbody if ($reqbody); + warn "## headers:\n$headers\n" if ($self->{debug}); + + print $sock $headers or + carp "can't send headers to network:\n$headers\n" and return -1; + + if ($reqbody) { + warn "## request body:\n$headers\n" if ($self->{debug}); + print $sock $$reqbody or + carp "can't send request body to network:\n$$reqbody\n" and return -1; + } my $line = <$sock>; chomp($line); my ($schema, $res_status, undef) = split(/ */, $line, 3); return if ($schema !~ /^HTTP/ || ! $res_status); - $self->{status} = $res_status; + $status = $res_status; + warn "## response status: $res_status\n" if ($self->{debug}); # skip rest of headers - do { + $line = <$sock>; + while ($line) { $line = <$sock>; - chomp($line); - } until ($line eq ''); + $line =~ s/[\r\n]+$//; + warn "## ", $line || 'NULL', " ##\n"; + }; # read body - my $len = 0; + $len = 0; do { $len = read($sock, my $buf, 8192); $$resbody .= $buf if ($resbody); } while ($len); + + warn "## response body:\n$$resbody\n" if ($self->{debug}); + return $status; }