From b56b320b5e2515160073fa1b469514002688fe11 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Tue, 5 Apr 2016 22:27:26 +0000 Subject: tlperl 5.22.1 from siep git-svn-id: svn://tug.org/texlive/trunk@40252 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm | 24 +++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 Master/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm (limited to 'Master/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm') 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; -- cgit v1.2.3