Annotation of loncom/auth/blockedaccess.pm, revision 1.7
1.1 raeburn 1: # The LearningOnline Network
2: # Information about blocking status for Portfolio files
3: #
1.7 ! raeburn 4: # $Id: blockedaccess.pm,v 1.6 2020/10/01 10:16:33 raeburn Exp $
1.3 bisitz 5: #
1.1 raeburn 6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28:
29: package Apache::blockedaccess;
30:
31: use strict;
1.5 raeburn 32: use Apache::Constants qw(:common);
1.1 raeburn 33: use Apache::lonnet;
34: use Apache::loncommon();
35: use Apache::lonlocal;
1.5 raeburn 36: use HTML::Entities();
1.1 raeburn 37:
38: sub handler {
39: my $r = shift;
40: &Apache::loncommon::content_type($r,'text/html');
41: $r->send_http_header;
42: return OK if $r->header_only;
43:
44: &Apache::lonlocal::get_language_handle($r);
1.6 raeburn 45: my $ver_origurl = $r->uri;
1.5 raeburn 46: my $origurl = &Apache::lonnet::deversion($r->uri);
1.7 ! raeburn 47: my ($blocked,$blocktext,$clientip);
! 48: $clientip = &Apache::lonnet::get_requestor_ip($r);
1.4 raeburn 49:
50: if (&Apache::lonnet::is_portfolio_url($origurl)) {
51: my ($type,$udom,$uname,$file_name,$group) =
52: &Apache::lonnet::parse_portfolio_url($origurl);
53: ($blocked,$blocktext) =
1.7 ! raeburn 54: &Apache::loncommon::blocking_status('port',$clientip,$uname,$udom);
1.4 raeburn 55: } else {
56: if ($env{'request.course.id'}) {
57: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
58: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.5 raeburn 59: my $symb = $env{'request.symb'};
1.6 raeburn 60: my $url = $origurl;
61: # If no symb, and url is on not map, check for referrer
62: unless (($symb) || &Apache::lonnet::is_on_map($url) || ($origurl eq '/adm/blockedaccess')) {
63: my $refuri = $env{'httpref.'.$origurl} || $env{'httpref.'.$ver_origurl};
64: if ($refuri) {
65: $url = $refuri;
66: }
67: }
1.4 raeburn 68: ($blocked,$blocktext) =
1.7 ! raeburn 69: &Apache::loncommon::blocking_status('docs',$clientip,$cnum,$cdom,$url,1,$symb,'blockedaccess');
1.4 raeburn 70: }
71: }
1.1 raeburn 72: if ($blocked) {
73: $r->print(&Apache::loncommon::start_page('Access Temporarily Blocked'));
74: $r->print($blocktext);
1.5 raeburn 75: } elsif ($origurl eq '/adm/blockedaccess') {
76: $r->print(&Apache::loncommon::start_page('Access Blocking Information'));
77: $r->print('<p class="LC_warning">'.&mt('Could not determine which page had access blocked.').'</p>');
1.1 raeburn 78: } else {
1.5 raeburn 79: $r->print(&Apache::loncommon::start_page('Access Blocking Information'));
80: my $link;
81: if ($origurl ne '') {
82: my $showurl = &Apache::lonenc::check_encrypt($origurl);
83: $link = &Apache::lonnet::absolute_url().$showurl;
84: if ($r->args ne '') {
85: $link .= '?'.$r->args;
86: }
87: }
88: $r->print('<p class="LC_info">'.
89: &mt('The page you are trying to reach was reported as having access blocked, but the reason is not available.').
90: '</p>');
91: if ($link) {
92: $r->print('<p><a href="'.&HTML::Entities::encode($link,'\'"<>&').'">'.&mt('Try again?').'</a></p>');
93: }
1.1 raeburn 94: }
95: $r->print(&Apache::loncommon::end_page());
96: return OK;
97: }
98:
99: sub setup_handler {
100: my ($r) = @_;
101: $r->set_handlers('PerlHandler'=>
102: [\&Apache::blockedaccess::handler]);
103: $r->handler('perl-script');
104: }
105:
106: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>