--- loncom/lti/ltiutils.pm 2018/08/14 17:24:21 1.14 +++ loncom/lti/ltiutils.pm 2019/07/18 18:28:46 1.17 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Utility functions for managing LON-CAPA LTI interactions # -# $Id: ltiutils.pm,v 1.14 2018/08/14 17:24:21 raeburn Exp $ +# $Id: ltiutils.pm,v 1.17 2019/07/18 18:28:46 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,6 +31,7 @@ package LONCAPA::ltiutils; use strict; use Net::OAuth; use Digest::SHA; +use Digest::MD5 qw(md5_hex); use UUID::Tiny ':std'; use Apache::lonnet; use Apache::loncommon; @@ -241,12 +242,26 @@ sub get_tool_secret { # 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; @@ -296,7 +311,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 +319,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 +340,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 +361,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(); + } } # @@ -466,6 +491,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 @@ -592,7 +658,7 @@ sub get_roster { lti_message_type => 'basic-lis-readmembershipsforcontext', ext_ims_lis_memberships_id => $id, ); - my $hashref = &sign_params($url,$ckey,$secret,'',\%ltiparams); + my $hashref = &sign_params($url,$ckey,$secret,\%ltiparams); if (ref($hashref) eq 'HASH') { my $request=new HTTP::Request('POST',$url); $request->content(join('&',map { @@ -651,7 +717,7 @@ sub get_roster { # sub send_grade { - my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_; + my ($id,$url,$ckey,$secret,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_; my $score; if ($possible > 0) { if ($scoretype eq 'ratio') { @@ -664,30 +730,114 @@ sub send_grade { $score = sprintf("%.2f",$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 $hashref = &sign_params($url,$ckey,$secret,\%ltiparams,$sigmethod); + if (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}))); + } + } 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 = < + + + + V1.0 + $uniqmsgid + + + + + + + $id + + + + en + $score + + + + + + +END + chomp($gradexml); + my $bodyhash = Digest::SHA::sha1_base64($gradexml); + 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->add_required_message_params('body_hash'); + $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; #FIXME Handle case where pass back of score to LTI Consumer failed. +} + +sub setup_logout_callback { + my ($uname,$udom,$server,$ckey,$secret,$service_url,$idsdir,$protocol,$hostname) = @_; + if ($service_url =~ m{^https?://[^/]+/}) { + my $digest_user = &Encode::decode_utf8($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 $post = &sign_params($service_url,$ckey,$secret,\%ltiparams, + '','','',1); + my $request=new HTTP::Request('POST',$service_url); + $request->content($post); + my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10); + } } + return; } #