# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA LTI interactions 
#
# $Id: ltiutils.pm,v 1.9.2.1 2020/04/09 23:17:19 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 Apache::lonnet;
use Apache::loncommon;
use LONCAPA qw(:DEFAULT :match);

#
# LON-CAPA as LTI Consumer
#
# 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.
#

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
#
# 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
#
# 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();
}

1;