|
Last change
on this file since 27174 was 27174, checked in by davidb, 11 years ago |
|
Perl modules from CPAN that are used in supporting activate.pl, but not part of the Perl core. Only PMs included.
|
|
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.
