diff options
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm')
-rw-r--r-- | Master/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm | 24 |
1 files changed, 24 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm b/Master/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm new file mode 100644 index 00000000000..68150a722d5 --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm @@ -0,0 +1,24 @@ +package LWP::Protocol::nogo; +# If you want to disable access to a particular scheme, use this +# class and then call +# LWP::Protocol::implementor(that_scheme, 'LWP::Protocol::nogo'); +# For then on, attempts to access URLs with that scheme will generate +# a 500 error. + +use strict; +use vars qw(@ISA); +require HTTP::Response; +require HTTP::Status; +require LWP::Protocol; +@ISA = qw(LWP::Protocol); + +sub request { + my($self, $request) = @_; + my $scheme = $request->uri->scheme; + + return HTTP::Response->new( + &HTTP::Status::RC_INTERNAL_SERVER_ERROR, + "Access to \'$scheme\' URIs has been disabled" + ); +} +1; |