--- loncom/lti/ltiutils.pm	2018/08/12 02:24:42	1.13
+++ loncom/lti/ltiutils.pm	2024/02/27 03:55:55	1.20
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Utility functions for managing LON-CAPA LTI interactions 
 #
-# $Id: ltiutils.pm,v 1.13 2018/08/12 02:24:42 raeburn Exp $
+# $Id: ltiutils.pm,v 1.20 2024/02/27 03:55:55 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -31,6 +31,8 @@ package LONCAPA::ltiutils;
 use strict;
 use Net::OAuth;
 use Digest::SHA;
+use Digest::MD5 qw(md5_hex);
+use Encode;
 use UUID::Tiny ':std';
 use Apache::lonnet;
 use Apache::loncommon;
@@ -40,6 +42,7 @@ use Apache::lonenc();
 use Apache::longroup();
 use Apache::lonlocal;
 use Math::Round();
+use LONCAPA::Lond;
 use LONCAPA qw(:DEFAULT :match);
 
 #
@@ -208,11 +211,30 @@ sub get_tool_secret {
         %{$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'};
+            my ($crsdef,$ltinum);
+            if ($idx =~ /^c(\d+)$/) {
+                $ltinum = $1;
+                $crsdef = 1;
+                my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'consumer');
+                if (ref($crslti{$ltinum}) eq 'HASH') {
+                    %{$ltitools} = %{$crslti{$ltinum}};
+                } else {
+                    undef($ltinum);
+                }
+            } elsif ($idx =~ /^\d+$/) {
+                my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer');
+                if (ref($lti{$idx}) eq 'HASH') {
+                    %{$ltitools} = %{$lti{$idx}};
+                    $ltinum = $idx;
+                }
+            }
+            if ($ltinum ne '') {
+                my $loncaparev = &Apache::lonnet::get_server_loncaparev($cdom);
+                my $keynum = $ltitools->{'cipher'};
+                my ($poss_key,$poss_secret) =
+                    &LONCAPA::Lond::get_lti_credentials($cdom,$cnum,$crsdef,'tools',$ltinum,$keynum,$loncaparev);
+                if ($poss_key eq $key) {
+                    $consumer_secret = $poss_secret;
                     $nonce_lifetime = $ltitools->{'lifetime'};
                 } else {
                     $errors->{11} = 1;
@@ -240,13 +262,29 @@ sub get_tool_secret {
 # secret for the specific LTI Provider.
 #
 
+# FIXME Move to Lond.pm and perform on course's homeserver
+
 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,);
+    my ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params,
+        $authheaders,$errors) = @_;
+    unless (ref($errors) eq 'HASH') {
+        $errors->{15} = 1;
+        return;
+    }
+    my $request;
+    if ($oauthtype eq 'consumer') {
+        my $oauthreq = Net::OAuth->request('consumer');
+        $oauthreq->add_required_message_params('body_hash');
+        $request = $oauthreq->from_authorization_header($authheaders,
+                                  request_url => $protocol.'://'.$hostname.$requri,
+                                  request_method => $reqmethod,
+                                  consumer_secret => $consumer_secret,);
+    } else {
+        $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;
@@ -276,7 +314,7 @@ sub verify_lis_item {
     my ($has_action, $valid_for);
     if ($context eq 'grade') {
         $has_action = $ltitools->{'passback'};
-        $valid_for = $ltitools->{'passbackvalid'}
+        $valid_for = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds
     } elsif ($context eq 'roster') {
         $has_action = $ltitools->{'roster'};
         $valid_for = $ltitools->{'rostervalid'};
@@ -296,7 +334,7 @@ sub verify_lis_item {
                 if ($expected_sig eq $sigrec) {
                     return 1;
                 } else {
-                    $errors->{17} = 1;
+                    $errors->{18} = 1;
                 }
             } elsif ($context eq 'roster') {
                 my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
@@ -304,14 +342,14 @@ sub verify_lis_item {
                 if ($expected_sig eq $sigrec) {
                     return 1;
                 } else {
-                    $errors->{18} = 1;
+                    $errors->{19} = 1;
                 }
             }
         } else {
-            $errors->{19} = 1;
+            $errors->{20} = 1;
         }
     } else {
-        $errors->{20} = 1;
+        $errors->{21} = 1;
     }
     return;
 }
@@ -325,14 +363,20 @@ sub verify_lis_item {
 # 
 
 sub sign_params {
-    my ($url,$key,$secret,$sigmethod,$paramsref) = @_;
+    my ($url,$key,$secret,$paramsref,$sigmethod,$type,$callback,$post) = @_;
     return unless (ref($paramsref) eq 'HASH');
     if ($sigmethod eq '') {
         $sigmethod = 'HMAC-SHA1';
     }
+    if ($type eq '') {
+        $type = 'request token';
+    }
+    if ($callback eq '') {
+        $callback = 'about:blank',
+    }
     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(
+    my $request = Net::OAuth->request($type)->new(
             consumer_key => $key,
             consumer_secret => $secret,
             request_url => $url,
@@ -340,12 +384,16 @@ sub sign_params {
             signature_method => $sigmethod,
             timestamp => time,
             nonce => $nonce,
-            callback => 'about:blank',
+            callback => $callback,
             extra_params => $paramsref,
             version      => '1.0',
             );
-    $request->sign;
-    return $request->to_hash();
+    $request->sign();
+    if ($post) {
+        return $request->to_post_body();
+    } else {
+        return $request->to_hash();
+    }
 }
 
 #
@@ -382,13 +430,13 @@ sub set_service_secret {
     my $warning;
     my ($needsnew,$oldsecret,$lifetime);
     if ($name eq 'grade') {
-        $lifetime = $ltitools->{'passbackvalid'}
+        $lifetime = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds
     } elsif ($name eq 'roster') {
         $lifetime = $ltitools->{'rostervalid'};
     }
-    if ($toolsettings->{$name} eq '') {
+    if ($toolsettings->{$name.'secret'} eq '') {
         $needsnew = 1;
-    } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) {
+    } elsif (($toolsettings->{$name.'secretdate'} + $lifetime) < $now) {
         $oldsecret = $toolsettings->{$name.'secret'};
         $needsnew = 1;
     }
@@ -466,6 +514,47 @@ sub release_tool_lock {
 }
 
 #
+# LON-CAPA as LTI Consumer
+#
+# Parse XML containing grade data sent by an LTI Provider
+#
+
+sub parse_grade_xml {
+    my ($xml) = @_;
+    my %data = ();
+    my $count = 0;
+    my @state = ();
+    my $p = HTML::Parser->new(
+        xml_mode => 1,
+        start_h =>
+            [sub {
+                my ($tagname, $attr) = @_;
+                push(@state,$tagname);
+                if ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord") {
+                    $count ++;
+                }
+            }, "tagname, attr"],
+        text_h =>
+            [sub {
+                my ($text) = @_;
+                if ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord sourcedGUID sourcedId") {
+                    $data{$count}{sourcedid} = $text;
+                } elsif ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord result resultScore textString") {                               
+                    $data{$count}{score} = $text;
+                }
+            }, "dtext"],
+        end_h =>
+            [sub {
+                 my ($tagname) = @_;
+                 pop @state;
+                }, "tagname"],
+    );
+    $p->parse($xml);
+    $p->eof;
+    return %data;
+}
+
+#
 # LON-CAPA as LTI Provider
 #
 # Use the part of the launch URL after /adm/lti to determine
@@ -586,14 +675,16 @@ sub lti_provider_scope {
 #
 
 sub get_roster {
-    my ($id,$url,$ckey,$secret) = @_;
+    my ($cdom,$cnum,$ltinum,$keynum,$id,$url) = @_;
     my %ltiparams = (
         lti_version                => 'LTI-1p0',
         lti_message_type           => 'basic-lis-readmembershipsforcontext',
         ext_ims_lis_memberships_id => $id,
     );
-    my $hashref = &sign_params($url,$ckey,$secret,'',\%ltiparams);
-    if (ref($hashref) eq 'HASH') {
+    my %info = ();
+    my ($status,$hashref) =
+        &Apache::lonnet::sign_lti($cdom,$cnum,'','lti','roster',$url,$ltinum,$keynum,\%ltiparams,\%info);
+    if (($status eq 'ok') && (ref($hashref) eq 'HASH')) {
         my $request=new HTTP::Request('POST',$url);
         $request->content(join('&',map {
                           my $name = escape($_);
@@ -651,7 +742,7 @@ sub get_roster {
 #
 
 sub send_grade {
-    my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_;
+    my ($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,$url,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_;
     my $score;
     if ($possible > 0) {
         if ($scoretype eq 'ratio') {
@@ -661,35 +752,131 @@ sub send_grade {
             $score = Math::Round::round($score);
         } else {
             $score = $total/$possible;
-            $score = sprintf("%.2f",$score);
+            $score = sprintf("%.4f",$score);
         }
     }
-    my $date = &Apache::loncommon::utc_string(time);
-    my %ltiparams = (
-        lti_version                   => 'LTI-1p0',
-        lti_message_type              => 'basic-lis-updateresult',
-        sourcedid                     => $id,
-        result_resultscore_textstring => $score,
-        result_resultscore_language   => 'en-US',
-        result_resultvaluesourcedid   => $scoretype,
-        result_statusofresult         => 'final',
-        result_date                   => $date,
-    );
-    my $hashref = &sign_params($url,$ckey,$secret,'',\%ltiparams);
-    if (ref($hashref) eq 'HASH') {
-        my $request=new HTTP::Request('POST',$url);
-        $request->content(join('&',map {
-                          my $name = escape($_);
-                          "$name=" . ( ref($hashref->{$_}) eq 'ARRAY'
-                          ? join("&$name=", map {escape($_) } @{$hashref->{$_}})
-                          : &escape($hashref->{$_}) );
-        } keys(%{$hashref})));
-        my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
-        my $message=$response->status_line;
+    if ($sigmethod eq '') {
+        $sigmethod = 'HMAC-SHA1';
+    }
+    my $request;
+    if ($msgformat eq '1.0') {
+        my $date = &Apache::loncommon::utc_string(time);
+        my %ltiparams = (
+            lti_version                   => 'LTI-1p0',
+            lti_message_type              => 'basic-lis-updateresult',
+            sourcedid                     => $id,
+            result_resultscore_textstring => $score,
+            result_resultscore_language   => 'en-US',
+            result_resultvaluesourcedid   => $scoretype,
+            result_statusofresult         => 'final',
+            result_date                   => $date,
+        );
+        my %info = (
+                        method => $sigmethod,
+                   ); 
+        my ($status,$hashref) =
+            &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,
+                                      \%ltiparams,\%info);   
+        if (($status eq 'ok') && (ref($hashref) eq 'HASH')) {
+            $request=new HTTP::Request('POST',$url);
+            $request->content(join('&',map {
+                              my $name = escape($_);
+                              "$name=" . ( ref($hashref->{$_}) eq 'ARRAY'
+                              ? join("&$name=", map {escape($_) } @{$hashref->{$_}})
+                              : &escape($hashref->{$_}) );
+                              } keys(%{$hashref})));
+#FIXME Need to handle case where passback failed.
+        }
+    } else {
+        srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
+        my $uniqmsgid = int(rand(2**32));
+        my $gradexml = <<END;
+<?xml version = "1.0" encoding = "UTF-8"?>
+<imsx_POXEnvelopeRequest xmlns = "http://www.imsglobal.org/services/ltiv1p1/xsd/imsoms_v1p0">
+  <imsx_POXHeader>
+    <imsx_POXRequestHeaderInfo>
+      <imsx_version>V1.0</imsx_version>
+      <imsx_messageIdentifier>$uniqmsgid</imsx_messageIdentifier>
+    </imsx_POXRequestHeaderInfo>
+  </imsx_POXHeader>
+  <imsx_POXBody>
+    <replaceResultRequest>
+      <resultRecord>
+	<sourcedGUID>
+	  <sourcedId>$id</sourcedId>
+	</sourcedGUID>
+	<result>
+	  <resultScore>
+	    <language>en</language>
+	    <textString>$score</textString>
+	  </resultScore>
+	</result>
+      </resultRecord>
+    </replaceResultRequest>
+  </imsx_POXBody>
+</imsx_POXEnvelopeRequest>
+END
+        chomp($gradexml);
+        my $bodyhash = Digest::SHA::sha1_base64($gradexml);
+        while (length($bodyhash) % 4) {
+            $bodyhash .= '=';
+        }
+        my $reqmethod = 'POST';
+        my %info = (
+                      body_hash => $bodyhash,
+                      method => $sigmethod,
+                      reqtype => 'consumer',
+                      reqmethod => $reqmethod,
+                      respfmt => 'to_authorization_header',
+                   );
+        my %params;
+        my ($status,$authheader) =
+            &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,\%params,\%info);
+        if (($status eq 'ok') && ($authheader ne '')) {
+            $request = HTTP::Request->new(
+	                   $reqmethod,
+	                   $url,
+	                   [
+		              'Authorization' => $authheader,
+		              'Content-Type'  => 'application/xml',
+	                   ],
+	                   $gradexml,
+            );
+            my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
+            my $message=$response->status_line;
 #FIXME Handle case where pass back of score to LTI Consumer failed.
+        }
     }
 }
 
+sub setup_logout_callback {
+    my ($cdom,$cnum,$crstool,$idx,$keynum,$uname,$udom,$server,$service_url,$idsdir,$protocol,$hostname) = @_;
+    if ($service_url =~ m{^https?://[^/]+/}) {
+        my $digest_user = &Encode::decode('UTF-8',$uname.':'.$udom);
+        my $loginfile = &Digest::SHA::sha1_hex($digest_user).&md5_hex(&md5_hex(time.{}.rand().$$));
+        if ((-d $idsdir) && (open(my $fh,'>',"$idsdir/$loginfile"))) {
+            print $fh "$uname,$udom,$server\n";
+            close($fh);
+            my $callback = 'http://'.$hostname.'/adm/service/logout/'.$loginfile;
+            my %ltiparams = (
+                callback   => $callback,
+            );
+            my %info = (
+                respfmt => 'to_post_body',
+            );
+            my ($status,$post) = 
+                &Apache::lonnet::sign_lti($cdom,$cnum,$crstool,'lti','logout',$service_url,$idx,
+                                          $keynum,\%ltiparams,\%info);
+            if (($status eq 'ok') && ($post ne '')) {
+                my $request=new HTTP::Request('POST',$service_url);
+                $request->content($post);
+                my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
+            }
+        }
+    }
+    return;
+}
+
 #
 # LON-CAPA as LTI Provider
 #
@@ -915,20 +1102,21 @@ sub enrolluser {
 
 sub batchaddroster {
     my ($item) = @_;
-    return unless(ref($item) eq 'HASH');
-    return unless (ref($item->{'ltiref'}) eq 'HASH');
+    return unless((ref($item) eq 'HASH') &&
+                  (ref($item->{'ltiref'}) eq 'HASH'));
     my ($cdom,$cnum) = split(/_/,$item->{'cid'});
+    return if (($cdom eq '') || ($cnum eq ''));
     my $udom = $cdom;
     my $id = $item->{'id'};
     my $url = $item->{'url'};
+    my $ltinum = $item->{'lti'};
+    my $keynum = $item->{'ltiref'}->{'cipher'};
     my @intdoms;
     my $intdomsref = $item->{'intdoms'};
     if (ref($intdomsref) eq 'ARRAY') {
         @intdoms = @{$intdomsref};
     }
     my $uriscope = $item->{'uriscope'};
-    my $ckey = $item->{'ltiref'}->{'key'};
-    my $secret = $item->{'ltiref'}->{'secret'};
     my $section = $item->{'ltiref'}->{'section'};
     $section =~ s/\W//g;
     if ($section eq 'none') {
@@ -947,8 +1135,8 @@ sub batchaddroster {
     if (ref($item->{'possroles'}) eq 'ARRAY') {
         @possroles = @{$item->{'possroles'}};
     }
-    if (($ckey ne '') && ($secret ne '') && ($id ne '') && ($url ne '')) {
-        my %data = &get_roster($id,$url,$ckey,$secret);
+    if (($id ne '') && ($url ne '')) {
+        my %data = &get_roster($cdom,$cnum,$ltinum,$keynum,$id,$url);
         if (keys(%data) > 0) {
             my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info);
             my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);