[BACK]Return to ltiutils.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lti

Diff for /loncom/lti/ltiutils.pm between versions 1.11 and 1.15

version 1.11, 2018/05/28 23:26:04 version 1.15, 2018/08/14 21:42:36
Line 38  use Apache::loncoursedata; Line 38  use Apache::loncoursedata;
 use Apache::lonuserutils;  use Apache::lonuserutils;
 use Apache::lonenc();  use Apache::lonenc();
 use Apache::longroup();  use Apache::longroup();
   use Apache::lonlocal;
 use Math::Round();  use Math::Round();
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
   
Line 240  sub get_tool_secret { Line 241  sub get_tool_secret {
 #  #
   
 sub verify_request {  sub verify_request {
     my ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_;      my ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params,
     return unless (ref($errors) eq 'HASH');          $authheaders,$errors) = @_;
     my $request = Net::OAuth->request('request token')->from_hash($params,      unless (ref($errors) eq 'HASH') {
                                        request_url => $protocol.'://'.$hostname.$requri,          $errors->{15} = 1;
                                        request_method => $reqmethod,          return;
                                        consumer_secret => $consumer_secret,);      }
       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()) {      unless ($request->verify()) {
         $errors->{15} = 1;          $errors->{15} = 1;
         return;          return;
Line 275  sub verify_lis_item { Line 290  sub verify_lis_item {
     my ($has_action, $valid_for);      my ($has_action, $valid_for);
     if ($context eq 'grade') {      if ($context eq 'grade') {
         $has_action = $ltitools->{'passback'};          $has_action = $ltitools->{'passback'};
         $valid_for = $ltitools->{'passbackvalid'}          $valid_for = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds
     } elsif ($context eq 'roster') {      } elsif ($context eq 'roster') {
         $has_action = $ltitools->{'roster'};          $has_action = $ltitools->{'roster'};
         $valid_for = $ltitools->{'rostervalid'};          $valid_for = $ltitools->{'rostervalid'};
Line 295  sub verify_lis_item { Line 310  sub verify_lis_item {
                 if ($expected_sig eq $sigrec) {                  if ($expected_sig eq $sigrec) {
                     return 1;                      return 1;
                 } else {                  } else {
                     $errors->{17} = 1;                      $errors->{18} = 1;
                 }                  }
             } elsif ($context eq 'roster') {              } elsif ($context eq 'roster') {
                 my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;                  my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
Line 303  sub verify_lis_item { Line 318  sub verify_lis_item {
                 if ($expected_sig eq $sigrec) {                  if ($expected_sig eq $sigrec) {
                     return 1;                      return 1;
                 } else {                  } else {
                     $errors->{18} = 1;                      $errors->{19} = 1;
                 }                  }
             }              }
         } else {          } else {
             $errors->{19} = 1;              $errors->{20} = 1;
         }          }
     } else {      } else {
         $errors->{20} = 1;          $errors->{21} = 1;
     }      }
     return;      return;
 }  }
Line 343  sub sign_params { Line 358  sub sign_params {
             extra_params => $paramsref,              extra_params => $paramsref,
             version      => '1.0',              version      => '1.0',
             );              );
     $request->sign;      $request->sign();
     return $request->to_hash();      return $request->to_hash();
 }  }
   
Line 381  sub set_service_secret { Line 396  sub set_service_secret {
     my $warning;      my $warning;
     my ($needsnew,$oldsecret,$lifetime);      my ($needsnew,$oldsecret,$lifetime);
     if ($name eq 'grade') {      if ($name eq 'grade') {
         $lifetime = $ltitools->{'passbackvalid'}          $lifetime = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds
     } elsif ($name eq 'roster') {      } elsif ($name eq 'roster') {
         $lifetime = $ltitools->{'rostervalid'};          $lifetime = $ltitools->{'rostervalid'};
     }      }
     if ($toolsettings->{$name} eq '') {      if ($toolsettings->{$name.'secret'} eq '') {
         $needsnew = 1;          $needsnew = 1;
     } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) {      } elsif (($toolsettings->{$name.'secretdate'} + $lifetime) < $now) {
         $oldsecret = $toolsettings->{$name.'secret'};          $oldsecret = $toolsettings->{$name.'secret'};
         $needsnew = 1;          $needsnew = 1;
     }      }
Line 465  sub release_tool_lock { Line 480  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  # LON-CAPA as LTI Provider
 #  #
 # Use the part of the launch URL after /adm/lti to determine  # Use the part of the launch URL after /adm/lti to determine
Line 487  sub lti_provider_scope { Line 543  sub lti_provider_scope {
             $scope = 'map';              $scope = 'map';
             $realuri = $tail;              $realuri = $tail;
         } else {          } else {
             my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail);              my $symb = $tail;
               $symb =~ s{^/}{};
               my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
             $realuri = &Apache::lonnet::clutter($url);              $realuri = &Apache::lonnet::clutter($url);
             if ($url =~ /\.sequence$/) {              if ($url =~ /\.sequence$/) {
                 $scope = 'map';                  $scope = 'map';
             } else {              } else {
                 $scope = 'resource';                  $scope = 'resource';
                 $realuri .= '?symb='.$tail;                  $realuri .= '?symb='.$symb;
                 $passkey = $tail;                  $passkey = $symb;
                 if ($getunenc) {                  if ($getunenc) {
                     $unencsymb = $tail;                      $unencsymb = $symb;
                 }                  }
             }              }
         }          }
Line 506  sub lti_provider_scope { Line 564  sub lti_provider_scope {
             $scope = 'map';              $scope = 'map';
             $realuri = $tail;              $realuri = $tail;
         } else {          } else {
             my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail);              my $symb = $tail;
               $symb =~ s{^/?res/}{};
               my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
             $realuri = &Apache::lonnet::clutter($url);              $realuri = &Apache::lonnet::clutter($url);
             if ($url =~ /\.sequence$/) {              if ($url =~ /\.sequence$/) {
                 $scope = 'map';                  $scope = 'map';
             } else {              } else {
                 $scope = 'resource';                  $scope = 'resource';
                 $realuri .= '?symb='.$tail;                  $realuri .= '?symb='.$symb;
                 $passkey = $tail;                  $passkey = $symb;
                 if ($getunenc) {                  if ($getunenc) {
                     $unencsymb = $tail;                      $unencsymb = $symb;
                 }                  }
             }              }
         }          }
Line 561  sub lti_provider_scope { Line 621  sub lti_provider_scope {
     } elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) {      } elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) {
         $scope = 'course';          $scope = 'course';
         $realuri = '/adm/navmaps';          $realuri = '/adm/navmaps';
         $passkey = $tail;          $passkey = '';
     }      }
     if ($scope eq 'map') {      if ($scope eq 'map') {
         $passkey = $realuri;          $passkey = $realuri;
Line 573  sub lti_provider_scope { Line 633  sub lti_provider_scope {
     }      }
 }  }
   
   #
   # LON-CAPA as LTI Provider
   #
   # Obtain a list of course personnel and students from
   # the LTI Consumer which launched this instance.
   #
   
 sub get_roster {  sub get_roster {
     my ($id,$url,$ckey,$secret) = @_;      my ($id,$url,$ckey,$secret) = @_;
     my %ltiparams = (      my %ltiparams = (
Line 580  sub get_roster { Line 647  sub get_roster {
         lti_message_type           => 'basic-lis-readmembershipsforcontext',          lti_message_type           => 'basic-lis-readmembershipsforcontext',
         ext_ims_lis_memberships_id => $id,          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') {      if (ref($hashref) eq 'HASH') {
         my $request=new HTTP::Request('POST',$url);          my $request=new HTTP::Request('POST',$url);
         $request->content(join('&',map {          $request->content(join('&',map {
Line 631  sub get_roster { Line 698  sub get_roster {
     return;      return;
 }  }
   
   #
   # LON-CAPA as LTI Provider
   #
   # Passback a grade for a user to the LTI Consumer which originally
   # provided the lis_result_sourcedid
   #
   
 sub send_grade {  sub send_grade {
     my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_;      my ($id,$url,$ckey,$secret,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_;
     my $score;      my $score;
     if ($possible > 0) {      if ($possible > 0) {
         if ($scoretype eq 'ratio') {          if ($scoretype eq 'ratio') {
Line 645  sub send_grade { Line 719  sub send_grade {
             $score = sprintf("%.2f",$score);              $score = sprintf("%.2f",$score);
         }          }
     }      }
     my $date = &Apache::loncommon::utc_string(time);      if ($sigmethod eq '') {
     my %ltiparams = (          $sigmethod = 'HMAC-SHA1';
         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.  
     }      }
       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 = <<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 $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.
 }  }
   
   #
   # LON-CAPA as LTI Provider
   #
   # Create a new user in LON-CAPA. If the domain's configuration 
   # includes rules for format of "official" usernames, those rules
   # will apply when determining if a user is to be created.  In
   # additional if institutional user information is available that
   # will be used when creating a new user account.
   #
   
 sub create_user {  sub create_user {
     my ($ltiref,$uname,$udom,$domdesc,$data,$alerts,$rulematch,$inst_results,      my ($ltiref,$uname,$udom,$domdesc,$data,$alerts,$rulematch,$inst_results,
         $curr_rules,$got_rules) = @_;          $curr_rules,$got_rules) = @_;
Line 768  sub create_user { Line 913  sub create_user {
     return $result;      return $result;
 }  }
   
   #
   # LON-CAPA as LTI Provider
   #
   # Create a password for a new user if the authentication
   # type to assign to new users created following LTI launch is
   # to be LON-CAPA "internal".
   #
   
 sub create_passwd {  sub create_passwd {
     my $passwd = '';      my $passwd = '';
       srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
     my @letts = ("a".."z");      my @letts = ("a".."z");
     for (my $i=0; $i<8; $i++) {      for (my $i=0; $i<8; $i++) {
         my $lettnum = int(rand(2));          my $lettnum = int(rand(2));
Line 788  sub create_passwd { Line 942  sub create_passwd {
     return ($passwd);      return ($passwd);
 }  }
   
   #
   # LON-CAPA as LTI Provider
   #
   # Enroll a user in a LON-CAPA course, with the specified role and (optional)
   # section.  If this is a self-enroll case, i.e., a user launched the LTI tool
   # in the Consumer, user privs will be added to the user's environment for
   # the new role.
   #
   # If this is a self-enroll case, a Course Coordinator role will only be assigned 
   # if the current user is also the course owner.
   #
   
 sub enrolluser {  sub enrolluser {
     my ($udom,$uname,$role,$cdom,$cnum,$sec,$start,$end) = @_;      my ($udom,$uname,$role,$cdom,$cnum,$sec,$start,$end,$selfenroll) = @_;
     my $enrollresult;      my $enrollresult;
     my $area = "/$cdom/$cnum";      my $area = "/$cdom/$cnum";
     if (($role ne 'cc') && ($role ne 'co') && ($sec ne '')) {      if (($role ne 'cc') && ($role ne 'co') && ($sec ne '')) {
Line 801  sub enrolluser { Line 967  sub enrolluser {
         $enrollresult =          $enrollresult =
             &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,              &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,
                                                        undef,undef,$sec,$end,$start,                                                         undef,undef,$sec,$end,$start,
                                                        'ltienroll',undef,$cdom.'_'.$cnum,undef,                                                         'ltienroll',undef,$cdom.'_'.$cnum,
                                                        'ltienroll','',$instcid);                                                         $selfenroll,'ltienroll','',$instcid);
     } elsif ($role =~ /^(cc|in|ta|ep)$/) {      } elsif ($role =~ /^(cc|in|ta|ep)$/) {
         $enrollresult =          $enrollresult =
             &Apache::lonnet::assignrole($udom,$uname,$area,$role,$end,$start,              &Apache::lonnet::assignrole($udom,$uname,$area,$role,$end,$start,
                                         undef,undef,'ltienroll');                                          undef,$selfenroll,'ltienroll');
       }
       if ($enrollresult eq 'ok') {
           if ($selfenroll) {
               my (%userroles,%newrole,%newgroups);
               &Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,
                                                   $area);
               &Apache::lonnet::set_userprivs(\%userroles,\%newrole,\%newgroups);
               $userroles{'user.role.'.$spec} = $start.'.'.$end;
               &Apache::lonnet::appenv(\%userroles,[$role,'cm']);
           }
     }      }
     return $enrollresult;      return $enrollresult;
 }  }
   
   #
   # LON-CAPA as LTI Provider
   #
   # Batch addition of users following LTI launch by a user
   # 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 a user included in the retrieved list does not currently
   # have a user account in LON-CAPA, an account will be created.
   #
   # If a user already has an account, and the same role and
   # section assigned (currently active), then no change will
   # be made for that user.
   #
   # Information available for new users (besides username and)
   # role) may include: first name, last name, full name (from
   # which middle name will be extracted), permanent e-mail address,
   # and lis_result_sourcedid (for passback of grades).
   #
   # If grades are to be passed back, the passback url will be
   # the same as for the current user's session.
   #
   # The roles which may be assigned will be determined from the
   # LTI roles included in the retrieved roster, and the mapping
   # of LTI roles to LON-CAPA roles configured for this LTI Consumer
   # in the domain configuration.
   #
   # Course Coordinator roles will only be assigned if the current
   # user is also the course owner.
   #
   # The domain configuration for the corresponding Consumer can include
   # a section to assign to LTI users. If the roster includes students
   # any existing student roles with a different section will be expired,
   # and a role in the LTI section will be assigned.
   #
   # For non-student rules (excluding Course Coordinator) a role will be
   # assigned with the LTI section )or no section, if one is not rquired.
   #
   
 sub batchaddroster {  sub batchaddroster {
     my ($item) = @_;      my ($item) = @_;
     return unless(ref($item) eq 'HASH');      return unless(ref($item) eq 'HASH');
Line 1015  sub batchaddroster { Line 1233  sub batchaddroster {
     return;      return;
 }  }
   
   #
   # LON-CAPA as LTI Provider
   #
   # Gather a list of available LON-CAPA roles derived
   # from a comma separated list of LTI roles.
   #
   # Which LON-CAPA roles are assignable by the current user
   # and how LTI roles map to LON-CAPA roles (as defined in
   # the domain configuration for the specific Consumer) are 
   # factored in when compiling the list of available roles.
   #
   # Inputs: 3
   #  $rolestr - comma separated list of LTI roles.
   #  $allowedroles - reference to array of assignable LC roles
   #  $maproles - ref to HASH of mapping of LTI roles to LC roles
   #
   # Outputs: 2
   # (a) reference to array of available LC roles.
   # (b) reference to array of LTI roles.
   #
   
 sub get_lc_roles {  sub get_lc_roles {
     my ($rolestr,$allowedroles,$maproles) = @_;      my ($rolestr,$allowedroles,$maproles) = @_;
     my (@ltiroles,@lcroles);      my (@ltiroles,@lcroles);
Line 1055  sub get_lc_roles { Line 1294  sub get_lc_roles {
     return (\@lcroles,\@ltiroles);      return (\@lcroles,\@ltiroles);
 }  }
   
   #
   # 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 
   # determine if there is a change between the current
   # ones and the updated ones.
   # 
   
 sub datechange_check {  sub datechange_check {
     my ($oldstart,$oldend,$startdate,$enddate) = @_;      my ($oldstart,$oldend,$startdate,$enddate) = @_;
     my $datechange = 0;      my $datechange = 0;
Line 1073  sub datechange_check { Line 1321  sub datechange_check {
     return $datechange;      return $datechange;
 }  }
   
   #
   # LON-CAPA as LTI Provider
   #
   # Store the URL used by a specific LTI Consumer to process grades passed back
   # by an LTI Provider.
   #
   
 sub store_passbackurl {  sub store_passbackurl {
     my ($ltinum,$pburl,$cdom,$cnum) = @_;      my ($ltinum,$pburl,$cdom,$cnum) = @_;
     my %history = &Apache::lonnet::restore($ltinum,'passbackurl',$cdom,$cnum);      my %history = &Apache::lonnet::restore($ltinum,'passbackurl',$cdom,$cnum);
Removed from v.1.11  
changed lines
  Added in v.1.15

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>