Return to lonslotcheck.pm CVS log

Up to [LON-CAPA] / loncom / auth

- Bug 6754 LON-CAPA as LTI Consumer
  Support for access control using slots for both "gradable" and "non-gradable"
  external tools.

# Checks slot access settings - disable subsequent 
# PerlHandlers unless access availble
# $Id: lonslotcheck.pm,v 1.2 2023/07/07 03:52:40 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package Apache::lonslotcheck;

use strict;
use Apache::lonnet;
use Apache::lonlocal;
use Apache::loncommon();
use Apache::structuretags();
use Apache::lonhomework();
use Apache::bridgetask();
use Apache::Constants qw(:common :http :methods);

sub handler {
    my ($r) = @_;
    if (($r->uri !~ /ext\.tool$/) ||
        (&Apache::lonnet::EXT('resource.0.gradable',$env{'request.symb'}) =~ /^yes$/i)) {
        return DECLINED;
    }
    my ($symb,$courseid,$udom,$uname) = &Apache::lonnet::whichuser();
    my $useslots = &Apache::lonnet::EXT("resource.0.useslots",$symb);
    if ($useslots ne 'resource' && $useslots ne 'map'
        && $useslots ne 'map_map') {
        return DECLINED;
    }
    my ($status,$accessmsg,$slot_name,$slot,$ipused) = 
        &check_slot_access($symb,$courseid,$udom,$uname);

    my $output;
    if ($status eq 'CHECKED_IN') {
        if ($slot_name ne '') {
            my $checkin = 'resource.0.checkedin';
            if (($Apache::lonhomework::history{$checkin}) &&
                ($Apache::lonhomework::history{"$checkin.slot"} eq $slot_name)) {
                &do_cleanup();
                return DECLINED;
            } else {
                my $closedate = &Apache::lonnet::EXT("resource.0.contentclose",$symb,
                                                     $udom,$uname);
                &Apache::structuretags::selfcheckin_resource($closedate,$slot_name,$slot,$symb);
                if ($Apache::lonhomework::results{$checkin}) {
                    &Apache::structuretags::finalize_storage();
                    &do_cleanup();
                    return DECLINED;
                } else {
                    $output = '<p class="LC_error">'.&mt('Error during self-checkin to slot').
                              '</p>';
                }
            }
        } else {
            $output = '<p class="LC_error">'.&mt('Error no slot available for self-checkin').
                          '</p>';
        }
    } elsif ($status eq 'NEEDS_CHECKIN') {
        if (defined($env{'form.submitted'}) && defined($env{'form.validate'})) {
            if (&Apache::bridgetask::proctor_check_auth($slot_name,$slot)) {
                &Apache::structuretags::finalize_storage();
                &do_cleanup();
                return DECLINED;
            } else {
                $output =  '<p class="LC_error">'.&mt('Check-in failed').'</p>'.
                           &Apache::bridgetask::proctor_validation_screen($slot);
            }
        } else {
            $output = &Apache::bridgetask::proctor_validation_screen($slot);
        }
    } elsif (( $status eq 'NOT_IN_A_SLOT' ) ||
             ( $status eq 'NOTRESERVABLE') ||
             ( $status eq 'RESERVABLE') ||
             ( $status eq 'RESERVABLE_LATER') ||
             ( $status eq 'NEED_DIFFERENT_IP')) {
        $output = &Apache::structuretags::access_status_msg('tool',$status,$symb,
                                                            'web',$ipused,$accessmsg);
    }

    $r->set_handlers('PerlHandler'=>undef);
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    if ($r->header_only) {
        &do_cleanup();
        return OK;
    }

    my $target;
    my ($marker,$exttool) = (split(m{/},$r->uri))[4,5];
    $marker=~s/\D//g;
    if (($marker) && ($exttool) && ($env{'request.course.id'})) {
        my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
        my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
        my ($idx,$crstool,$is_tool,%toolhash,%toolsettings);
        if ($r->uri eq "/adm/$cdom/$cnum/$marker/$exttool") {
            my %toolsettings=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);
            $target = $toolsettings{'target'};
        }
    }
    my $args = {'bgcolor'        => '#FFFFFF',
                'force_register' => 1,};
    if ($target eq 'iframe') {
        $args->{'only_body'} = 1;
    }
    my $start_page =
        &Apache::loncommon::start_page('Not Open',undef,$args);
    my $end_page =
        &Apache::loncommon::end_page({'discussion' => 1});
        $r->print($start_page.$output.$end_page);
    &do_cleanup();
    return OK;
}

sub check_slot_access {
    my ($symb,$courseid,$udom,$uname) = @_;
    &Apache::structuretags::initialize_storage($symb);
    my $checkin = 'resource.0.checkedin';
    my $checkedin = $Apache::lonhomework::history{$checkin};
    my ($returned_slot,$slot_name,$checkinslot,$ipused,$blockip,$now,$ip,
        $consumed_uniq);
    $now = time;
    $ip=$ENV{'REMOTE_ADDR'} || $env{'request.host'};
    if ($checkedin) {
        $checkinslot = $Apache::lonhomework::history{"$checkin.slot"};
        my %slot=&Apache::lonnet::get_slot($checkinslot);
        $consumed_uniq = $slot{'uniqueperiod'};
        if ($slot{'iptied'}) {
            $ipused = $Apache::lonhomework::history{"$checkin.ip"};
            unless (($ip ne '') && ($ipused eq $ip)) {
                $blockip = $slot{'iptied'};
                $slot_name = $checkinslot;
                $returned_slot = \%slot;
                return ('NEED_DIFFERENT_IP','',$slot_name,$returned_slot,$ipused);
            }
        }
    }

    my $availablestudent = &Apache::lonnet::EXT("resource.0.availablestudent",$symb);
    my $available = &Apache::lonnet::EXT("resource.0.available",$symb);
    my @slots= (split(':',$availablestudent),split(':',$available));

    my $slotstatus='NOT_IN_A_SLOT';
    my $num_usable_slots = 0;
    my $datemsg;

    foreach my $slot (@slots) {
        $slot =~ s/(^\s*|\s*$)//g;
        my %slot=&Apache::lonnet::get_slot($slot);
        next if ($slot{'endtime'} < $now);
        $num_usable_slots ++;
        if ($slot{'starttime'} < $now &&
            $slot{'endtime'} > $now &&
            &Apache::loncommon::check_ip_acc($slot{'ip'})) {
            if ($slot{'iptied'}) {
                if ($env{'request.course.id'}) {
                    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    if ($slot eq $checkinslot) {
                        if ($ip eq $ipused) {
                            $slotstatus ='NEEDS_CHECKIN';
                        } else {
                            $slotstatus = 'NEED_DIFFERENT_IP';
                            $slot_name = $slot;
                            $returned_slot = \%slot;
                            last;
                        }
                    } elsif ($ip) {
                        my $uniqkey = "$slot\0$symb\0$ip";
                        my %used_ip = &Apache::lonnet::get('slot_uniqueips',[$uniqkey],$cdom,$cnum);
                        if ($used_ip{$uniqkey}) {
                            $slotstatus = 'NEED_DIFFERENT_IP';
                        } else {
                            $slotstatus ='NEEDS_CHECKIN';
                        }
                    }
                }
            } else {
                $slotstatus='NEEDS_CHECKIN';
            }
            if ($slotstatus eq 'NEEDS_CHECKIN') {
                $returned_slot=\%slot;
                $slot_name=$slot;
                last;
            }
        }
    }

    if (($slotstatus eq 'NEEDS_CHECKIN') && (ref($returned_slot) eq 'HASH')) {
        if (&Apache::lonhomework::proctor_checked_in($slot_name,$returned_slot,'tool')) {
            $slotstatus = 'CHECKED_IN';
            return ($slotstatus,$datemsg,$slot_name,$returned_slot,$ipused);
        }
    }

    # Previously used slot is no longer open, and has been checked in.
    # However, the resource is not closed, and potentially, another slot might be
    # used to gain access to it, until the content close date is reached.
    # Therefore return the slotstatus -
    # (which will be one of: NOT_IN_A_SLOT, RESERVABLE, RESERVABLE_LATER, or NOTRESERVABLE).

    if (!defined($slot_name)) {
        if ($slotstatus eq 'NOT_IN_A_SLOT') {
            if (!$num_usable_slots) {
                ($slotstatus,$datemsg) = &Apache::lonhomework::check_reservable_slot($slotstatus,$symb,$now,
                                                                                     $checkedin,$consumed_uniq);
            }
        }
    }
    return ($slotstatus,$datemsg,$slot_name,$returned_slot,$ipused);
}

sub do_cleanup {
    undef(%Apache::lonhomework::results);
    undef(%Apache::lonhomework::history);
}

1;