[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.14

version 1.11, 2018/05/28 23:26:04 version 1.14, 2018/08/14 17:24:21
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 275  sub verify_lis_item { Line 276  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 381  sub set_service_secret { Line 382  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 487  sub lti_provider_scope { Line 488  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 509  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 566  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 578  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 592  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 643  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,$total,$possible) = @_;
     my $score;      my $score;
Line 656  sub send_grade { Line 675  sub send_grade {
         result_statusofresult         => 'final',          result_statusofresult         => 'final',
         result_date                   => $date,          result_date                   => $date,
     );      );
     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 671  sub send_grade { Line 690  sub send_grade {
     }      }
 }  }
   
   #
   # 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 797  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 826  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 851  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 1117  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 1178  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 1205  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.14

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