|
Last change
on this file since 27183 was 27183, checked in by davidb, 11 years ago |
|
Changing to using installed version of LWP that comes from libwww-perl, which is more self-contained than v6.x
|
|
File size:
630 bytes
|
| Line | |
|---|
| 1 | package LWP::Protocol::nogo;
|
|---|
| 2 | # If you want to disable access to a particular scheme, use this
|
|---|
| 3 | # class and then call
|
|---|
| 4 | # LWP::Protocol::implementor(that_scheme, 'LWP::Protocol::nogo');
|
|---|
| 5 | # For then on, attempts to access URLs with that scheme will generate
|
|---|
| 6 | # a 500 error.
|
|---|
| 7 |
|
|---|
| 8 | use strict;
|
|---|
| 9 | use vars qw(@ISA);
|
|---|
| 10 | require HTTP::Response;
|
|---|
| 11 | require HTTP::Status;
|
|---|
| 12 | require LWP::Protocol;
|
|---|
| 13 | @ISA = qw(LWP::Protocol);
|
|---|
| 14 |
|
|---|
| 15 | sub request {
|
|---|
| 16 | my($self, $request) = @_;
|
|---|
| 17 | my $scheme = $request->uri->scheme;
|
|---|
| 18 |
|
|---|
| 19 | return HTTP::Response->new(
|
|---|
| 20 | &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
|
|---|
| 21 | "Access to \'$scheme\' URIs has been disabled"
|
|---|
| 22 | );
|
|---|
| 23 | }
|
|---|
| 24 | 1;
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
