# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA LTI interactions 
#
# $Id: ltiutils.pm,v 1.9 2018/05/15 04:33:17 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 LONCAPA::ltiutils;

use strict;
use Net::OAuth;
use Digest::SHA;
use UUID::Tiny ':std';
use Apache::lonnet;
use Apache::loncommon;
use LONCAPA qw(:DEFAULT :match);

#
# LON-CAPA as LTI Consumer or LTI Provider
#
# Determine if a nonce in POSTed data has expired.
# If unexpired, confirm it has not already been used.
#
# When LON-CAPA is operating as a Consumer, nonce checking
# occurs when a Tool Provider launched from an instance of
# an external tool in a LON-CAPA course makes a request to
# (a) /adm/service/roster or (b) /adm/service/passback to, 
# respectively, retrieve a roster or store the grade for 
# the original launch by a specific user.
#
# When LON-CAPA is operating as a Provider, nonce checking 
# occurs when a user in course context in another LMS (the 
# Consumer) launches an external tool to access a LON-CAPA URL: 
# /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended.
#

sub check_nonce {
    my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_;
    if (($ltidir eq '') || ($timestamp eq '') || ($timestamp =~ /^\D/) ||
        ($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
        return;
    }
    my $now = time;
    if (($timestamp) && ($timestamp < ($now - $lifetime))) {
        return;
    }
    if ($nonce eq '') {
        return;
    }
    if (-e "$ltidir/$domain/$nonce") {
        return;
    } else  {
        unless (-e "$ltidir/$domain") {
            unless (mkdir("$ltidir/$domain",0755)) {
                return;
            }
        }
        if (open(my $fh,'>',"$ltidir/$domain/$nonce")) {
            print $fh $now;
            close($fh);
            return 1;
        }
    }
    return;
}

#
# LON-CAPA as LTI Consumer
#
# Determine the domain and the courseID of the LON-CAPA course
# for which access is needed by a Tool Provider -- either to 
# retrieve a roster or store the grade for an instance of an 
# external tool in the course.
#

sub get_loncapa_course {
    my ($lonhost,$cid,$errors) = @_;
    return unless (ref($errors) eq 'HASH');
    my ($cdom,$cnum);
    if ($cid =~ /^($match_domain)_($match_courseid)$/) {
        my ($posscdom,$posscnum) = ($1,$2);
        my $cprimary_id = &Apache::lonnet::domain($posscdom,'primary');
        if ($cprimary_id eq '') {
            $errors->{5} = 1;
            return;
        } else {
            my @intdoms;
            my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
            if (ref($internet_names) eq 'ARRAY') {
                @intdoms = @{$internet_names};
            }
            my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
            if  (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
                $cdom = $posscdom;
            } else {
                $errors->{6} = 1;
                return;
            }
        }
        my $chome = &Apache::lonnet::homeserver($posscnum,$posscdom);
        if ($chome =~ /(con_lost|no_host|no_such_host)/) {
            $errors->{7} = 1;
            return;
        } else {
            $cnum = $posscnum;
        }
    } else {
        $errors->{8} = 1;
        return;
    }
    return ($cdom,$cnum);
}

#
# LON-CAPA as LTI Consumer
#
# Determine the symb and (optionally) LON-CAPA user for an 
# instance of an external tool in a course -- either to 
# to retrieve a roster or store a grade.
#
# Use the digested symb to lookup the real symb in exttools.db
# and the digested userID to lookup the real userID (if needed).
# and extract the exttool instance and symb.
#

sub get_tool_instance {
    my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_;
    return unless (ref($errors) eq 'HASH');
    my ($marker,$symb,$uname,$udom);
    my @keys = ($digsymb); 
    if ($diguser) {
        push(@keys,$diguser);
    }
    my %digesthash = &Apache::lonnet::get('exttools',\@keys,$cdom,$cnum);
    if ($digsymb) {
        $symb = $digesthash{$digsymb};
        if ($symb) {
            my ($map,$id,$url) = split(/___/,$symb);
            $marker = (split(m{/},$url))[3];
            $marker=~s/\D//g;
        } else {
            $errors->{9} = 1;
        }
    }
    if ($diguser) {
        if ($digesthash{$diguser} =~ /^($match_username):($match_domain)$/) {
            ($uname,$udom) = ($1,$2);
        } else {
            $errors->{10} = 1;
        }
        return ($marker,$symb,$uname,$udom);
    } else {
        return ($marker,$symb);
    }
}

#
# LON-CAPA as LTI Consumer
#
# Retrieve data needed to validate a request from a Tool Provider
# for a roster or to store a grade for an instance of an external 
# tool in a LON-CAPA course.
#
# Retrieve the Consumer key and Consumer secret from the domain 
# configuration or the Tool Provider ID stored in the
# exttool_$marker db file and compare the Consumer key with the
# one in the POSTed data.
#
# Side effect is to populate the $toolsettings hashref with the 
# contents of the .db file (instance of tool in course) and the
# $ltitools hashref with the configuration for the tool (at
# domain level).
#

sub get_tool_secret {
    my ($key,$marker,$symb,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_;
    return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') &&
                   (ref($errors) eq 'HASH'));
    my ($consumer_secret,$nonce_lifetime);
    if ($marker) {
        %{$toolsettings}=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);
        if ($toolsettings->{'id'}) {
            my $idx = $toolsettings->{'id'};
            my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer');
            if (ref($lti{$idx}) eq 'HASH') {
                %{$ltitools} = %{$lti{$idx}};
                if ($ltitools->{'key'} eq $key) {
                    $consumer_secret = $ltitools->{'secret'};
                    $nonce_lifetime = $ltitools->{'lifetime'};
                } else {
                    $errors->{11} = 1;
                    return;
                }
            } else {
                $errors->{12} = 1;
                return;
            }
        } else {
            $errors->{13} = 1;
            return;
        }
    } else {
        $errors->{14};
        return;
    }
    return ($consumer_secret,$nonce_lifetime);
}

#
# LON-CAPA as LTI Consumer
#
# Verify a signed request using the consumer_key and
# secret for the specific LTI Provider.
#

sub verify_request {
    my ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_;
    return unless (ref($errors) eq 'HASH');
    my $request = Net::OAuth->request('request token')->from_hash($params,
                                       request_url => $protocol.'://'.$hostname.$requri,
                                       request_method => $reqmethod,
                                       consumer_secret => $consumer_secret,);
    unless ($request->verify()) {
        $errors->{15} = 1;
        return;
    }
}

#
# LON-CAPA as LTI Consumer
#
# Verify that an item identifier (either roster request:
# ext_ims_lis_memberships_id, or grade store:
# lis_result_sourcedid) has not been tampered with, and
# the secret used to create the unique identifier has not
# expired.
#
# Prepending the current secret (if still valid),
# or the previous secret (if current one is no longer valid),
# to a string composed of the :::-separated components
# must generate the result signature in the lis item ID
# sent by the Tool Provider.
#

sub verify_lis_item {
    my ($sigrec,$context,$digsymb,$diguser,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_;
    return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') && 
                   (ref($errors) eq 'HASH'));
    my ($has_action, $valid_for);
    if ($context eq 'grade') {
        $has_action = $ltitools->{'passback'};
        $valid_for = $ltitools->{'passbackvalid'}
    } elsif ($context eq 'roster') {
        $has_action = $ltitools->{'roster'};
        $valid_for = $ltitools->{'rostervalid'};
    }
    if ($has_action) {
        my $secret;
        if (($toolsettings->{$context.'secretdate'} + $valid_for) > time) {
            $secret = $toolsettings->{$context.'secret'};
        } else {
            $secret = $toolsettings->{'old'.$context.'secret'};
        }
        if ($secret) {
            my $expected_sig;
            if ($context eq 'grade') {
                my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum;
                $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; 
                if ($expected_sig eq $sigrec) {
                    return 1;
                } else {
                    $errors->{17} = 1;
                }
            } elsif ($context eq 'roster') {
                my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
                $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; 
                if ($expected_sig eq $sigrec) {
                    return 1;
                } else {
                    $errors->{18} = 1;
                }
            }
        } else {
            $errors->{19} = 1;
        }
    } else {
        $errors->{20} = 1;
    }
    return;
}

#
# LON-CAPA as LTI Consumer
#
# Sign a request used to launch an instance of an external
# tool in a LON-CAPA course, using the key and secret supplied 
# by the Tool Provider.
# 

sub sign_params {
    my ($url,$key,$secret,$sigmethod,$paramsref) = @_;
    return unless (ref($paramsref) eq 'HASH');
    if ($sigmethod eq '') {
        $sigmethod = 'HMAC-SHA1';
    }
    srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
    my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
    my $request = Net::OAuth->request("request token")->new(
            consumer_key => $key,
            consumer_secret => $secret,
            request_url => $url,
            request_method => 'POST',
            signature_method => $sigmethod,
            timestamp => time,
            nonce => $nonce,
            callback => 'about:blank',
            extra_params => $paramsref,
            version      => '1.0',
            );
    $request->sign;
    return $request->to_hash();
}

#
# LON-CAPA as LTI Consumer
#
# Generate a signature for a unique identifier (roster request:
# ext_ims_lis_memberships_id, or grade store: lis_result_sourcedid)
#

sub get_service_id {
    my ($secret,$id) = @_;
    my $sig = Digest::SHA::sha1_hex($secret.':::'.$id);
    return $sig.':::'.$id;
}

#
# LON-CAPA as LTI Consumer
#
# Generate and store the time-limited secret used to create the
# signature in a service request identifier (roster request or
# grade store). An existing secret past its expiration date
# will be stored as old<service name>secret, and a new secret
# <service name>secret will be stored.
# 
# Secrets are specific to service name and to the tool instance 
# (and are stored in the exttool_$marker db file).
# The time period a secret remains valid is determined by the 
# domain configuration for the specific tool and the service.
# 

sub set_service_secret {
    my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$ltitools) = @_;
    return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH'));
    my $warning;
    my ($needsnew,$oldsecret,$lifetime);
    if ($name eq 'grade') {
        $lifetime = $ltitools->{'passbackvalid'}
    } elsif ($name eq 'roster') {
        $lifetime = $ltitools->{'rostervalid'};
    }
    if ($toolsettings->{$name} eq '') {
        $needsnew = 1;
    } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) {
        $oldsecret = $toolsettings->{$name.'secret'};
        $needsnew = 1;
    }
    if ($needsnew) {
        if (&get_tool_lock($cdom,$cnum,$marker,$name,$now) eq 'ok') {
            my $secret = UUID::Tiny::create_uuid_as_string(UUID_V4);
            $toolsettings->{$name.'secret'} = $secret;
            my %secrethash = (
                           $name.'secret' => $secret,
                           $name.'secretdate' => $now,
                          );
            if ($oldsecret ne '') {
                $secrethash{'old'.$name.'secret'} = $oldsecret;
            }
            my $putres = &Apache::lonnet::put('exttool_'.$marker,
                                              \%secrethash,$cdom,$cnum);
            my $delresult = &release_tool_lock($cdom,$cnum,$marker,$name);
            if ($delresult ne 'ok') {
                $warning = $delresult ;
            }
            if ($putres eq 'ok') {
                return 'ok';
            }
        } else {
            $warning = 'Could not obtain exclusive lock';
        }
    } else {
        return 'ok';
    }
    return;
}

#
# LON-CAPA as LTI Consumer
#
# Add a lock key to exttools.db for the instance of an external tool 
# when generating and storing a service secret.
#

sub get_tool_lock {
    my ($cdom,$cnum,$marker,$name,$now) = @_;
    # get lock for tool for which secret is being set
    my $lockhash = {
                     $name."\0".$marker."\0".'lock' => $now.':'.$env{'user.name'}.
                                                       ':'.$env{'user.domain'},
                   };
    my $tries = 0;
    my $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum);

    while (($gotlock ne 'ok') && $tries <3) {
        $tries ++;
        sleep(1);
        $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum);
    }
    return $gotlock;
}

#
# LON-CAPA as LTI Consumer
#
# Remove a lock key from exttools.db for the instance of an external
# tool created when generating and storing a service secret.
#

sub release_tool_lock {
    my ($cdom,$cnum,$marker,$name) = @_;
    #  remove lock
    my @del_lock = ($name."\0".$marker."\0".'lock');
    my $dellockoutcome=&Apache::lonnet::del('exttools',\@del_lock,$cdom,$cnum);
    if ($dellockoutcome ne 'ok') {
        return 'Warning: failed to release lock for exttool';
    } else {
        return 'ok';
    }
}

#
# LON-CAPA as LTI Provider
#
# Use the part of the launch URL after /adm/lti to determine
# the scope for the current session (i.e., restricted to a
# single resource, to a single folder/map, or to an entire
# course).
#
# Returns an array containing scope: resource, map, or course
# and the LON-CAPA URL that is displayed post-launch, including
# accommodation of URL encryption, and translation of a tiny URL
# to the actual URL
#

sub lti_provider_scope {
    my ($tail,$cdom,$cnum) = @_;
    my ($scope,$realuri);
    if ($tail =~ m{^/uploaded/$cdom/$cnum/(?:default|supplemental)(?:|_\d+)\.(?:sequence|page)(|___\d+___.+)$}) {
        my $rest = $1;
        if ($rest eq '') {
            $scope = 'map';
            $realuri = $tail;
        } else {
            my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail);
            $realuri = &Apache::lonnet::clutter($url);
            if ($url =~ /\.sequence$/) {
                $scope = 'map';
            } else {
                $scope = 'resource';
                $realuri .= '?symb='.$tail;
            }
        }
    } elsif ($tail =~ m{^/res/$match_domain/$match_username/.+\.(?:sequence|page)(|___\d+___.+)$}) {
        my $rest = $1;
        if ($rest eq '') {
            $scope = 'map';
            $realuri = $tail;
        } else {
            my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail);
            $realuri = &Apache::lonnet::clutter($url);
            if ($url =~ /\.sequence$/) {
                $scope = 'map';
            } else {
                $scope = 'resource';
                $realuri .= '?symb='.$tail;
            }
        }
    } elsif ($tail =~ m{^/tiny/$cdom/(\w+)$}) {
        my $key = $1;
        my $tinyurl;
        my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
        if (defined($cached)) {
            $tinyurl = $result;
        } else {
            my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
            my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
            if ($currtiny{$key} ne '') {
                $tinyurl = $currtiny{$key};
                &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
            }
        }
        if ($tinyurl ne '') {
            my ($cnum,$symb) = split(/\&/,$tinyurl,2);
            my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
            if ($url =~ /\.(page|sequence)$/) {
                $scope = 'map';
            } else {
                $scope = 'resource';
            }
            if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
                (!$env{'request.role.adv'})) {
                $realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url));
                if ($scope eq 'resource') {
                    $realuri .= '?symb='.&Apache::lonenc::encrypted($symb);
                }
            } else {
                $realuri = &Apache::lonnet::clutter($url);
                if ($scope eq 'resource') {
                    $realuri .= '?symb='.$symb;
                }
            }
        }
    } elsif ($tail =~ m{^/$cdom/$cnum$}) {
        $scope = 'course';
        $realuri = '/adm/navmaps';
    }
    return ($scope,$realuri);
}

1;