package LWP::Protocol::gopher;
# Implementation of the gopher protocol (RFC 1436)
#
# This code is based on 'wwwgopher.pl,v 0.10 1994/10/17 18:12:34 shelden'
# which in turn is a vastly modified version of Oscar's http'get()
# dated 28/3/94 in <ftp://cui.unige.ch/PUBLIC/oscar/scripts/http.pl>
# including contributions from Marc van Heyningen and Martijn Koster.
use strict;
use vars qw(@ISA);
require HTTP::Response;
require HTTP::Status;
require IO::Socket;
require IO::Select;
require LWP::Protocol;
@ISA = qw(LWP::Protocol);
my %gopher2mimetype = (
'0' => 'text/plain', # 0 file
'1' => 'text/html', # 1 menu
# 2 CSO phone-book server
# 3 Error
'4' => 'application/mac-binhex40', # 4 BinHexed Macintosh file
'5' => 'application/zip', # 5 DOS binary archive of some sort
'6' => 'application/octet-stream', # 6 UNIX uuencoded file.
'7' => 'text/html', # 7 Index-Search server
# 8 telnet session
'9' => 'application/octet-stream', # 9 binary file
'h' => 'text/html', # html
'g' => 'image/gif', # gif
'I' => 'image/*', # some kind of image
);
my %gopher2encoding = (
'6' => 'x_uuencode', # 6 UNIX uuencoded file.
);
sub request
{
my($self, $request, $proxy, $arg, $size, $timeout) = @_;
LWP::Debug::trace('()');
$size = 4096 unless $size;
# check proxy
if (defined $proxy) {
return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
'You can not proxy through the gopher');
}
my $url = $request->url;
die "bad scheme" if $url->scheme ne 'gopher';
my $method = $request->method;
unless ($method eq 'GET' || $method eq 'HEAD') {
return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
'Library does not allow method ' .
"$method for 'gopher:' URLs");
}
my $gophertype = $url->gopher_type;
unless (exists $gopher2mimetype{$gophertype}) {
return HTTP::Response->new(&HTTP::Status::RC_NOT_IMPLEMENTED,
'Library does not support gophertype ' .
$gophertype);
}
my $response = HTTP::Response->new(&HTTP::Status::RC_OK, "OK");
$response->header('Content-type' => $gopher2mimetype{$gophertype}
|| 'text/plain');
$response->header('Content-Encoding' => $gopher2encoding{$gophertype})
if exists $gopher2encoding{$gophertype};
if ($method eq 'HEAD') {
# XXX: don't even try it so we set this header
$response->header('Client-Warning' => 'Client answer only');
return $response;
}
if ($gophertype eq '7' && ! $url->search) {
# the url is the prompt for a gopher search; supply boiler-plate
return $self->collect_once($arg, $response, <<"EOT");
<HEAD>
<TITLE>Gopher Index</TITLE>
<ISINDEX>
</HEAD>
<BODY>
<H1>$url<BR>Gopher Search</H1>
This is a searchable Gopher index.
Use the search function of your browser to enter search terms.
</BODY>
EOT
}
=1= |
