--- loncom/lti/ltiutils.pm 2018/08/14 21:42:36 1.15 +++ loncom/lti/ltiutils.pm 2024/02/27 04:13:34 1.17.2.5 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Utility functions for managing LON-CAPA LTI interactions # -# $Id: ltiutils.pm,v 1.15 2018/08/14 21:42:36 raeburn Exp $ +# $Id: ltiutils.pm,v 1.17.2.5 2024/02/27 04:13:34 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,7 +31,10 @@ package LONCAPA::ltiutils; use strict; use Net::OAuth; use Digest::SHA; +use Digest::MD5 qw(md5_hex); +use Encode; use UUID::Tiny ':std'; +use LWP::UserAgent(); use Apache::lonnet; use Apache::loncommon; use Apache::loncoursedata; @@ -40,6 +43,7 @@ use Apache::lonenc(); use Apache::longroup(); use Apache::lonlocal; use Math::Round(); +use LONCAPA::Lond; use LONCAPA qw(:DEFAULT :match); # @@ -95,8 +99,8 @@ sub check_nonce { # 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 +# 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. # @@ -141,8 +145,8 @@ sub get_loncapa_course { # # 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 +# 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 @@ -154,7 +158,7 @@ sub get_tool_instance { my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_; return unless (ref($errors) eq 'HASH'); my ($marker,$symb,$uname,$udom); - my @keys = ($digsymb); + my @keys = ($digsymb); if ($diguser) { push(@keys,$diguser); } @@ -185,15 +189,15 @@ sub get_tool_instance { # 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 +# 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 +# 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 +# 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). @@ -208,11 +212,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,6 +263,8 @@ 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 ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params, $authheaders,$errors) = @_; @@ -285,7 +310,7 @@ sub verify_request { sub verify_lis_item { my ($sigrec,$context,$digsymb,$diguser,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_; - return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') && + return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') && (ref($errors) eq 'HASH')); my ($has_action, $valid_for); if ($context eq 'grade') { @@ -306,7 +331,7 @@ sub verify_lis_item { my $expected_sig; if ($context eq 'grade') { my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum; - $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; + $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; if ($expected_sig eq $sigrec) { return 1; } else { @@ -314,7 +339,7 @@ sub verify_lis_item { } } elsif ($context eq 'roster') { my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum; - $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; + $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; if ($expected_sig eq $sigrec) { return 1; } else { @@ -339,14 +364,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, @@ -354,12 +385,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(); + if ($post) { + return $request->to_post_body(); + } else { + return $request->to_hash(); + } } # @@ -383,12 +418,12 @@ sub get_service_id { # grade store). An existing secret past its expiration date # will be stored as oldsecret, and a new secret # secret will be stored. -# -# Secrets are specific to service name and to the tool instance +# +# 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 +# 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) = @_; @@ -438,7 +473,7 @@ sub set_service_secret { # # LON-CAPA as LTI Consumer # -# Add a lock key to exttools.db for the instance of an external tool +# Add a lock key to exttools.db for the instance of an external tool # when generating and storing a service secret. # @@ -505,7 +540,7 @@ sub parse_grade_xml { 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") { + } elsif ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord result resultScore textString") { $data{$count}{score} = $text; } }, "dtext"], @@ -641,14 +676,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($_); @@ -656,7 +693,9 @@ sub get_roster { ? join("&$name=", map {escape($_) } @{$hashref->{$_}}) : &escape($hashref->{$_}) ); } keys(%{$hashref}))); - my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10); + my $ua=new LWP::UserAgent; + $ua->timeout(10); + my $response=$ua->request($request); my $message=$response->status_line; if (($response->is_success) && ($response->content ne '')) { my %data = (); @@ -706,7 +745,7 @@ sub get_roster { # sub send_grade { - my ($id,$url,$ckey,$secret,$scoretype,$sigmethod,$msgformat,$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') { @@ -716,7 +755,7 @@ sub send_grade { $score = Math::Round::round($score); } else { $score = $total/$possible; - $score = sprintf("%.2f",$score); + $score = sprintf("%.4f",$score); } } if ($sigmethod eq '') { @@ -735,8 +774,13 @@ sub send_grade { result_statusofresult => 'final', result_date => $date, ); - my $hashref = &sign_params($url,$ckey,$secret,$sigmethod,\%ltiparams); - if (ref($hashref) eq 'HASH') { + 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($_); @@ -744,10 +788,10 @@ sub send_grade { ? join("&$name=", map {escape($_) } @{$hashref->{$_}}) : &escape($hashref->{$_}) ); } keys(%{$hashref}))); +#FIXME Need to handle case where passback failed. } } else { srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. - my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0))); my $uniqmsgid = int(rand(2**32)); my $gradexml = < @@ -761,15 +805,15 @@ sub send_grade { - - $id - - - - en - $score - - + + $id + + + + en + $score + + @@ -780,30 +824,64 @@ END while (length($bodyhash) % 4) { $bodyhash .= '='; } - my $gradereq = Net::OAuth->request('consumer')->new( - consumer_key => $ckey, - consumer_secret => $secret, - request_url => $url, - request_method => 'POST', - signature_method => $sigmethod, - timestamp => time(), - nonce => $nonce, - body_hash => $bodyhash, - ); - $gradereq->sign(); - $request = HTTP::Request->new( - $gradereq->request_method, - $gradereq->request_url, - [ - 'Authorization' => $gradereq->to_authorization_header, - 'Content-Type' => 'application/xml', - ], - $gradexml, - ); - } - my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10); - my $message=$response->status_line; + 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 $ua=new LWP::UserAgent; + $ua->timeout(10); + my $response=$ua->request($request); + 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 $ua=new LWP::UserAgent; + $ua->timeout(10); + my $request=new HTTP::Request('POST',$service_url); + $request->content($post); + my $response=$ua->request($request); + } + } + } + return; } # @@ -994,8 +1072,8 @@ sub enrolluser { # with LTI Instructor status. # # A list of users is obtained by a call to get_roster() -# if the calling Consumer support the LTI extension: -# Context Memberships Service. +# if the calling Consumer support the LTI extension: +# Context Memberships Service. # # If a user included in the retrieved list does not currently # have a user account in LON-CAPA, an account will be created. @@ -1031,20 +1109,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') { @@ -1063,8 +1142,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); @@ -1298,10 +1377,10 @@ sub get_lc_roles { # LON-CAPA as LTI Provider # # Compares current start and dates for a user's role -# with dates to apply for the same user/role to +# with dates to apply for the same user/role to # determine if there is a change between the current # ones and the updated ones. -# +# sub datechange_check { my ($oldstart,$oldend,$startdate,$enddate) = @_;