Annotation of loncom/auth/lonslotcheck.pm, revision 1.1
1.1 ! raeburn 1: # Checks slot access settings - disable subsequent
! 2: # PerlHandlers unless access availble
! 3: # $Id: lonslotcheck.pm,v 1.1 2018/01/06 13:00:53 raeburn Exp $
! 4: #
! 5: # Copyright Michigan State University Board of Trustees
! 6: #
! 7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 8: #
! 9: # LON-CAPA is free software; you can redistribute it and/or modify
! 10: # it under the terms of the GNU General Public License as published by
! 11: # the Free Software Foundation; either version 2 of the License, or
! 12: # (at your option) any later version.
! 13: #
! 14: # LON-CAPA is distributed in the hope that it will be useful,
! 15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 17: # GNU General Public License for more details.
! 18: #
! 19: # You should have received a copy of the GNU General Public License
! 20: # along with LON-CAPA; if not, write to the Free Software
! 21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 22: #
! 23: # /home/httpd/html/adm/gpl.txt
! 24: #
! 25: # http://www.lon-capa.org/
! 26: #
! 27:
! 28: package Apache::lonslotcheck;
! 29:
! 30: use strict;
! 31: use Apache::lonnet;
! 32: use Apache::lonlocal;
! 33: use Apache::loncommon();
! 34: use Apache::structuretags();
! 35: use Apache::lonhomework();
! 36: use Apache::bridgetask();
! 37: use Apache::Constants qw(:common :http :methods);
! 38:
! 39: sub handler {
! 40: my ($r) = @_;
! 41: if (($r->uri !~ /ext\.tool$/) ||
! 42: (&Apache::lonnet::EXT('resource.0.gradable',$env{'request.symb'}) =~ /^yes$/i)) {
! 43: return DECLINED;
! 44: }
! 45: my ($symb,$courseid,$udom,$uname) = &Apache::lonnet::whichuser();
! 46: my $useslots = &Apache::lonnet::EXT("resource.0.useslots",$symb);
! 47: if ($useslots ne 'resource' && $useslots ne 'map'
! 48: && $useslots ne 'map_map') {
! 49: return DECLINED;
! 50: }
! 51: my ($status,$accessmsg,$slot_name,$slot,$ipused) =
! 52: &check_slot_access($symb,$courseid,$udom,$uname);
! 53:
! 54: my $output;
! 55: if ($status eq 'CHECKED_IN') {
! 56: if ($slot_name ne '') {
! 57: my $checkin = 'resource.0.checkedin';
! 58: if (($Apache::lonhomework::history{$checkin}) &&
! 59: ($Apache::lonhomework::history{"$checkin.slot"} eq $slot_name)) {
! 60: &do_cleanup();
! 61: return DECLINED;
! 62: } else {
! 63: my $closedate = &Apache::lonnet::EXT("resource.0.contentclose",$symb,
! 64: $udom,$uname);
! 65: &Apache::structuretags::selfcheckin_resource($closedate,$slot_name,$slot,$symb);
! 66: if ($Apache::lonhomework::results{$checkin}) {
! 67: &Apache::structuretags::finalize_storage();
! 68: &do_cleanup();
! 69: return DECLINED;
! 70: } else {
! 71: $output = '<p class="LC_error">'.&mt('Error during self-checkin to slot').
! 72: '</p>';
! 73: }
! 74: }
! 75: } else {
! 76: $output = '<p class="LC_error">'.&mt('Error no slot available for self-checkin').
! 77: '</p>';
! 78: }
! 79: } elsif ($status eq 'NEEDS_CHECKIN') {
! 80: if (defined($env{'form.submitted'}) && defined($env{'form.validate'})) {
! 81: if (&Apache::bridgetask::proctor_check_auth($slot_name,$slot)) {
! 82: &Apache::structuretags::finalize_storage();
! 83: &do_cleanup();
! 84: return DECLINED;
! 85: } else {
! 86: $output = '<p class="LC_error">'.&mt('Check-in failed').'</p>'.
! 87: &Apache::bridgetask::proctor_validation_screen($slot);
! 88: }
! 89: } else {
! 90: $output = &Apache::bridgetask::proctor_validation_screen($slot);
! 91: }
! 92: } elsif (( $status eq 'NOT_IN_A_SLOT' ) ||
! 93: ( $status eq 'NOTRESERVABLE') ||
! 94: ( $status eq 'RESERVABLE') ||
! 95: ( $status eq 'RESERVABLE_LATER') ||
! 96: ( $status eq 'NEED_DIFFERENT_IP')) {
! 97: $output = &Apache::structuretags::access_status_msg('tool',$status,$symb,
! 98: 'web',$ipused,$accessmsg);
! 99: }
! 100:
! 101: $r->set_handlers('PerlHandler'=>undef);
! 102: &Apache::loncommon::content_type($r,'text/html');
! 103: $r->send_http_header;
! 104: if ($r->header_only) {
! 105: &do_cleanup();
! 106: return OK;
! 107: }
! 108:
! 109: my $start_page =
! 110: &Apache::loncommon::start_page('Not Open',undef,
! 111: {'bgcolor' => '#FFFFFF',
! 112: 'force_register' => 1,});
! 113: my $end_page =
! 114: &Apache::loncommon::end_page({'discussion' => 1});
! 115: $r->print($start_page.$output.$end_page);
! 116: &do_cleanup();
! 117: return OK;
! 118: }
! 119:
! 120: sub check_slot_access {
! 121: my ($symb,$courseid,$udom,$uname) = @_;
! 122: &Apache::structuretags::initialize_storage($symb);
! 123: my $checkin = 'resource.0.checkedin';
! 124: my $checkedin = $Apache::lonhomework::history{$checkin};
! 125: my ($returned_slot,$slot_name,$checkinslot,$ipused,$blockip,$now,$ip,
! 126: $consumed_uniq);
! 127: $now = time;
! 128: $ip=$ENV{'REMOTE_ADDR'} || $env{'request.host'};
! 129: if ($checkedin) {
! 130: $checkinslot = $Apache::lonhomework::history{"$checkin.slot"};
! 131: my %slot=&Apache::lonnet::get_slot($checkinslot);
! 132: $consumed_uniq = $slot{'uniqueperiod'};
! 133: if ($slot{'iptied'}) {
! 134: $ipused = $Apache::lonhomework::history{"$checkin.ip"};
! 135: unless (($ip ne '') && ($ipused eq $ip)) {
! 136: $blockip = $slot{'iptied'};
! 137: $slot_name = $checkinslot;
! 138: $returned_slot = \%slot;
! 139: return ('NEED_DIFFERENT_IP','',$slot_name,$returned_slot,$ipused);
! 140: }
! 141: }
! 142: }
! 143:
! 144: my $availablestudent = &Apache::lonnet::EXT("resource.0.availablestudent",$symb);
! 145: my $available = &Apache::lonnet::EXT("resource.0.available",$symb);
! 146: my @slots= (split(':',$availablestudent),split(':',$available));
! 147:
! 148: my $slotstatus='NOT_IN_A_SLOT';
! 149: my $num_usable_slots = 0;
! 150: my $datemsg;
! 151:
! 152: foreach my $slot (@slots) {
! 153: $slot =~ s/(^\s*|\s*$)//g;
! 154: my %slot=&Apache::lonnet::get_slot($slot);
! 155: next if ($slot{'endtime'} < $now);
! 156: $num_usable_slots ++;
! 157: if ($slot{'starttime'} < $now &&
! 158: $slot{'endtime'} > $now &&
! 159: &Apache::loncommon::check_ip_acc($slot{'ip'})) {
! 160: if ($slot{'iptied'}) {
! 161: if ($env{'request.course.id'}) {
! 162: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
! 163: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
! 164: if ($slot eq $checkinslot) {
! 165: if ($ip eq $ipused) {
! 166: $slotstatus ='NEEDS_CHECKIN';
! 167: } else {
! 168: $slotstatus = 'NEED_DIFFERENT_IP';
! 169: $slot_name = $slot;
! 170: $returned_slot = \%slot;
! 171: last;
! 172: }
! 173: } elsif ($ip) {
! 174: my $uniqkey = "$slot\0$symb\0$ip";
! 175: my %used_ip = &Apache::lonnet::get('slot_uniqueips',[$uniqkey],$cdom,$cnum);
! 176: if ($used_ip{$uniqkey}) {
! 177: $slotstatus = 'NEED_DIFFERENT_IP';
! 178: } else {
! 179: $slotstatus ='NEEDS_CHECKIN';
! 180: }
! 181: }
! 182: }
! 183: } else {
! 184: $slotstatus='NEEDS_CHECKIN';
! 185: }
! 186: if ($slotstatus eq 'NEEDS_CHECKIN') {
! 187: $returned_slot=\%slot;
! 188: $slot_name=$slot;
! 189: last;
! 190: }
! 191: }
! 192: }
! 193:
! 194: if (($slotstatus eq 'NEEDS_CHECKIN') && (ref($returned_slot) eq 'HASH')) {
! 195: if (&Apache::lonhomework::proctor_checked_in($slot_name,$returned_slot,'tool')) {
! 196: $slotstatus = 'CHECKED_IN';
! 197: return ($slotstatus,$datemsg,$slot_name,$returned_slot,$ipused);
! 198: }
! 199: }
! 200:
! 201: # Previously used slot is no longer open, and has been checked in.
! 202: # However, the resource is not closed, and potentially, another slot might be
! 203: # used to gain access to it, until the content close date is reached.
! 204: # Therefore return the slotstatus -
! 205: # (which will be one of: NOT_IN_A_SLOT, RESERVABLE, RESERVABLE_LATER, or NOTRESERVABLE).
! 206:
! 207: if (!defined($slot_name)) {
! 208: if ($slotstatus eq 'NOT_IN_A_SLOT') {
! 209: if (!$num_usable_slots) {
! 210: ($slotstatus,$datemsg) = &Apache::lonhomework::check_reservable_slot($slotstatus,$symb,$now,
! 211: $checkedin,$consumed_uniq);
! 212: }
! 213: }
! 214: }
! 215: return ($slotstatus,$datemsg,$slot_name,$returned_slot,$ipused);
! 216: }
! 217:
! 218: sub do_cleanup {
! 219: undef(%Apache::lonhomework::results);
! 220: undef(%Apache::lonhomework::history);
! 221: }
! 222:
! 223: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>