--- loncom/lti/ltiutils.pm 2018/08/14 17:24:21 1.14 +++ loncom/lti/ltiutils.pm 2018/08/14 21:42:36 1.15 @@ -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.15 2018/08/14 21:42:36 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -241,12 +241,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 +310,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 +318,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; } @@ -344,7 +358,7 @@ sub sign_params { extra_params => $paramsref, version => '1.0', ); - $request->sign; + $request->sign(); return $request->to_hash(); } @@ -466,6 +480,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 @@ -651,7 +706,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 +719,91 @@ 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; -#FIXME Handle case where pass back of score to LTI Consumer failed. + 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,$sigmethod,\%ltiparams); + 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->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. } #