Return to ltiroster.pm CVS log

Up to [LON-CAPA] / loncom / lti

- Bug 6754
  Documentation says to use Encode::decode('UTF-8',$string) instead of
  Encode::decode_utf8($string) for data exchange.

# The LearningOnline Network with CAPA
# LTI Consumer Module to respond to a course roster request.
#
# $Id: ltiroster.pm,v 1.6 2022/03/29 20:12:46 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::ltiroster;

use strict;
use Apache::Constants qw(:common :http);
use Encode;
use Digest::SHA;
use URI::Escape;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonacc;
use Apache::loncoursedata;
use LONCAPA::ltiutils;

sub handler {
    my $r = shift;
    my %errors;
    my $params = {};
    my ($oauthtype,$authheader);
#
# Retrieve content type from headers
#
    my $content_type = $r->headers_in->get('Content-Type');
    if ($content_type eq 'application/xml') {
        $oauthtype = 'consumer';
#
# Retrieve OAuth data sent by LTI Provider from Authorization header
#
        $authheader = $r->headers_in->get('Authorization');
        my ($authtype,$valuestr) = ($authheader =~ /^(OAuth)\s+(.+)$/i);
        if (lc($authtype) eq 'oauth') {
            foreach my $pair (split(/\s*,\s*/,$valuestr)) {
                my ($key,$value) = split(/=/,$pair);
                $value =~ s /(^"|"$)//g;
                $params->{$key} = URI::Escape::uri_unescape($value);
            }
        }
    } else {
        $oauthtype = 'request token';
#
# Retrieve data POSTed by LTI Provider
#
        &Apache::lonacc::get_posted_cgi($r);
        foreach my $key (sort(keys(%env))) {
            if ($key =~ /^form\.(.+)$/) {
                $params->{$1} = $env{$key};
            }
        }
    }

    unless (keys(%{$params})) {
        $errors{1} = 1;
        &invalid_request($r,\%errors);
        return OK;
    }

#
# Retrieve the signature, digested symb, and LON-CAPA courseID
# from the ext_ims_lis_memberships_id in the POSTed data
#

    unless ($params->{'ext_ims_lis_memberships_id'}) {
        $errors{2} = 1;
        &invalid_request($r,\%errors);
        return OK;
    }

    my ($rostersig,$digsymb,$cid) = split(/\Q:::\E/,$params->{'ext_ims_lis_memberships_id'});
    unless ($rostersig && $digsymb && $cid) {
        $errors{3} = 1;
        &invalid_request($r,\%errors);
        return OK;
    }

    my ($cdom,$cnum,$marker,$symb);

#
# Determine the domain and the courseID of the LON-CAPA course to which the
# launch of LON-CAPA should provide access.
#
    ($cdom,$cnum) = &LONCAPA::ltiutils::get_loncapa_course($r->dir_config('lonHostID'),
                                                           $cid,\%errors);
    unless ($cdom && $cnum) {
        &invalid_request($r,\%errors);
        return OK;
    }

#
# Use the digested symb to lookup the real symb in exttools.db
#

    ($marker,$symb) = 
        &LONCAPA::ltiutils::get_tool_instance($cdom,$cnum,$digsymb,undef,\%errors);

    unless ($marker) {
        $errors{4} = 1;
        &invalid_request($r,\%errors);
        return OK;
    }

#
# Retrieve the Consumer key and Consumer secret from the domain configuration
# for the Tool Provider ID stored in the exttool_$marker.db
#

    my (%toolsettings,%ltitools);
    my ($consumer_secret,$nonce_lifetime) =
        &LONCAPA::ltiutils::get_tool_secret($params->{'oauth_consumer_key'},
                                            $marker,$symb,$cdom,$cnum,
                                            \%toolsettings,\%ltitools,\%errors);

#
# Verify the signed request using the consumer_key and
# secret for the specific LTI Provider.
#

    my $protocol = 'http';
    if ($ENV{'SERVER_PORT'} == 443) {
        $protocol = 'https';
    }
    unless (LONCAPA::ltiutils::verify_request($oauthtype,$protocol,$r->hostname,$r->uri,
                                              $env{'request.method'},$consumer_secret,
                                              $params,$authheader,\%errors)) {
        &invalid_request($r,\%errors);
        return OK;
    }

#
# Determine if nonce in POSTed data has expired.
# If unexpired, confirm it has not already been used.

    unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
                                            $nonce_lifetime,$cdom,$r->dir_config('lonLTIDir'))) {
        $errors{16} = 1;
        &invalid_request($r,\%errors);
        return OK;
    }

#
# Verify that the ext_ims_lis_memberships_id has not been tampered
# with, and the rostersecret used to create it is still valid.
#

    unless (&LONCAPA::ltiutils::verify_lis_item($rostersig,'roster',$digsymb,undef,$cdom,$cnum,
                                                \%toolsettings,\%ltitools,\%errors)) {
        &invalid_request($r,\%errors);
        return OK;
    }

#
#  Retrieve users with active roles in course for all roles for which roles have been mapped
#  in domain configuration for the Tool Provider requesting the roster. 
#
    my %maproles;

    if (ref($ltitools{'roles'}) eq 'HASH') {
        %maproles = %{$ltitools{'roles'}}; 
    }

    unless (keys(%maproles)) {
        $errors{21} = 1; 
        &invalid_request($r,\%errors);
        return OK;
    }

    my $crstype;
    my @allroles = &Apache::lonuserutils::roles_by_context('course',0,$crstype);

    my (%availableroles,$coursepersonnel,$includestudents,%userdata,
        @needpersenv,@needstuenv,$needemail,$needfullname,$needuser,
        $needroles,$needsresult,$gradesecret);

    if ($ltitools{'passback'}) {
        my $now = time;
        if (&LONCAPA::ltiutils::set_service_secret($cdom,$cnum,$marker,'grade',$now,
                                                    \%toolsettings,\%ltitools) eq 'ok') {
            if ($toolsettings{'gradesecret'} ne '') {
                $needsresult = 1;
                $gradesecret = $toolsettings{'gradesecret'};
            }
        }
    }

    foreach my $role (@allroles) {
        if (exists($maproles{$role})) {
            $availableroles{$role} = 1;
            if ($role eq 'st') {
                $includestudents = 1;
            } else {
                $coursepersonnel = 1;
            }
        }
    }
    if (keys(%availableroles)) {
        $needroles = 1;
    }
    if (ref($ltitools{'fields'}) eq 'HASH') {
        foreach my $field (keys(%{$ltitools{'fields'}})) {
            if (($field eq 'lastname') || ($field eq 'firstname')) {
                push(@needstuenv,$field); 
                push(@needpersenv,$field);
            } elsif ($field eq 'email') {
                $needemail = 1;
                push(@needpersenv,'permanentemail');
            } elsif ($field eq 'fullname') {
                $needfullname = 1;
            } elsif ($field eq 'user') {
                $needuser = 1;
            }
        }
    }

    my $statusidx = &Apache::loncoursedata::CL_STATUS();
    my $emailidx = &Apache::loncoursedata::CL_PERMANENTEMAIL();

    my %students;
    if ($includestudents) {
        my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
        if (ref($classlist) eq 'HASH') {
            %students = %{$classlist};
        }
    }

    &Apache::loncommon::content_type($r,'text/xml');
    $r->send_http_header;
    if ($r->header_only) {
        return;
    }
    $r->print(<<"END");
<message_response>
  <lti_message_type>basic-lis-readmembershipsforcontext</lti_message_type>
  <statusinfo>
    <codemajor>Success</codemajor>
    <severity>Status</severity>
    <codeminor>fullsuccess</codeminor>
    <description>Roster retrieved</description>
  </statusinfo>
  <memberships>
END

    my %skipstu;
    if ($coursepersonnel) {
        my %personnel = &Apache::lonnet::get_my_roles($cnum,$cdom);
        foreach my $key (sort(keys(%personnel))) {
            my ($uname,$udom,$role) = split(/:/,$key);
            if ($availableroles{$role}) {
                $userdata{$uname.':'.$udom}{'ltiroles'}{$maproles{$role}} = 1;
            }
        }
        foreach my $user (sort(keys(%userdata))) {
            if (exists($students{$user})) {
                $skipstu{$user} = 1;
            }
            $r->print("    <member>\n");
            my ($uname,$udom) = split(/:/,$user);
            my $digest_user = &Encode::decode('UTF-8',$uname.':'.$udom);
            $digest_user = &Digest::SHA::sha1_hex($digest_user);
            $r->print('      <user_id>'.$digest_user.'</user_id>'."\n");
            if (exists($students{$user})) {
                if (ref($students{$user}) eq 'ARRAY') {
                    if ($students{$user}[$statusidx] eq 'Active') {
                        $userdata{$uname.':'.$udom}{'ltiroles'}{$maproles{'st'}} = 1;
                    }
                }
            }
            if ($needroles) {
                if (ref($userdata{$uname.':'.$udom}{'ltiroles'}) eq 'HASH') {
                    $r->print('      <roles>'.join(',',sort(keys(%{$userdata{$uname.':'.$udom}{'ltiroles'}}))).'</roles>'."\n");
                } else {
                    $r->print("      <roles></roles>\n");
                }
            } else {
                $r->print("      <roles></roles>\n");
            }
            if ($needuser) {
                $r->print('      <person_sourcedid>'.$user.'</person_sourcedid>'."\n");
            } else {
                $r->print("      <person_sourcedid></person_sourcedid>\n");
            }
            my %userinfo;
            if (@needpersenv) {
                %userinfo = &Apache::lonnet::userenvironment($udom,$uname,@needpersenv);
            }
            foreach my $item ('firstname','lastname','permanentemail') {
                my $info;
                if ((@needpersenv) && (grep(/^\Q$item\E$/,@needpersenv))) {
                    $info = $userinfo{$item};
                }
                if ($item eq 'firstname') {
                    $r->print('      <person_name_given>'.$info.'</person_name_given>'."\n");
                } elsif ($item eq 'lastname') {
                    $r->print('      <person_name_family>'.$info.'</person_name_family>'."\n");
                } elsif ($item eq 'permanentemail') {
                    $r->print('      <person_contact_email_primary>'.$info.'</person_contact_email_primary>'."\n");
                }
            }
            if ($needfullname) {
                my $info = &Apache::loncommon::plainname($uname,$udom);
                if ($info eq $uname.':'.$udom) {
                    $info = '';    
                }
                $r->print('      <person_name_full>'.$info.'</person_name_full>'."\n");
            } else {
                $r->print('      <person_name_full></person_name_full>'."\n");
            }
            if ($needsresult) {
                my $uniqid = $digsymb.':::'.$digest_user.':::'.$cid;
                my $sourcedid = &LONCAPA::ltiutils::get_service_id($gradesecret,$uniqid);
                $r->print('      <lis_result_sourcedid>'.$sourcedid.'</lis_result_sourcedid>'."\n");
            } else {
                $r->print("      <lis_result_sourcedid></lis_result_sourcedid>\n");
            }
            $r->print("    </member>\n");
        }
    }

    if (($includestudents) && (keys(%students))) {
        foreach my $user (keys(%students)) {
            next if ($skipstu{$user});
            if (ref($students{$user}) eq 'ARRAY') {
                next unless ($students{$user}[$statusidx] eq 'Active');
                $r->print("    <member>\n");
                my ($uname,$udom) = split(/:/,$user);
                my $digest_user = &Encode::decode('UTF-8',$uname.':'.$udom);
                $digest_user = &Digest::SHA::sha1_hex($digest_user);
                $r->print('      <user_id>'.$digest_user.'</user_id>'."\n");
                if ($needroles) {
                    $r->print('      <roles>'.$maproles{'st'}.'</roles>'."\n");
                } else {
                    $r->print("      <roles></roles>\n");
                }
                if ($needuser) {
                    $r->print('      <person_sourcedid>'.$user.'</person_sourcedid>'."\n");
                } else {
                    $r->print("      <person_sourcedid></person_sourcedid>\n");
                }
                my %userinfo;
                if (@needstuenv) {
                    %userinfo = &Apache::lonnet::userenvironment($udom,$uname,@needstuenv);
                }
                foreach my $item ('firstname','lastname') {
                    my $info;
                    if ((@needstuenv) && (grep(/^\Q$item\E$/,@needstuenv))) {
                        $info = $userinfo{$item};
                    }
                    if ($item eq 'firstname') {
                        $r->print('      <person_name_given>'.$info.'</person_name_given>'."\n");
                    } elsif ($item eq 'lastname') {
                        $r->print('      <person_name_family>'.$info.'</person_name_family>'."\n");
                    }
                }
                if ($needemail) {
                    $r->print('      <person_contact_email_primary>'.$students{$user}[$emailidx].'</person_contact_email_primary>'."\n");
                } else {
                    $r->print('      <person_contact_email_primary></person_contact_email_primary>'."\n"); 
                }
                if ($needfullname) {
                    my $info = &Apache::loncommon::plainname($uname,$udom);
                    if ($info eq $uname.':'.$udom) {
                        $info = '';
                    }
                    $r->print('      <person_name_full>'.$info.'</person_name_full>'."\n");
                } else {
                    $r->print('      <person_name_full></person_name_full>'."\n");
                }
                if ($needsresult) {
                    my $uniqid = $digsymb.':::'.$digest_user.':::'.$cid;
                    my $sourcedid = &LONCAPA::ltiutils::get_service_id($gradesecret,$uniqid);
                    $r->print('      <lis_result_sourcedid>'.$sourcedid.'</lis_result_sourcedid>'."\n");
                } else {
                    $r->print("      <lis_result_sourcedid></lis_result_sourcedid>\n");
                }
                $r->print("    </member>\n");
            }
        }
    }
    $r->print(<<"END");
  </memberships>
</message_response>
END
    return OK;
}

sub invalid_request {
    my ($r,$errors) = @_;
    my $errormsg;
    if (ref($errors) eq 'HASH') {
        $errormsg = join(',',keys(%{$errors}));
    }
    &Apache::loncommon::content_type($r,'text/xml');
    $r->send_http_header;
    if ($r->header_only) {
        return;
    }
    $r->print(<<"END");
<message_response>
  <lti_message_type>basic-lis-updateresult</lti_message_type>
  <statusinfo>
     <codemajor>Failure</codemajor>
     <severity>Error</severity>
     <codeminor>$errormsg</codeminor>
  </statusinfo>
</message_response>
END
    return;
}

1;