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

Diff for /loncom/lti/ltiutils.pm between versions 1.20 and 1.21

version 1.20, 2024/02/27 03:55:55 version 1.21, 2024/02/27 04:04:06
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Utility functions for managing LON-CAPA LTI interactions   # Utility functions for managing LON-CAPA LTI interactions
 #  #
 # $Id$  # $Id$
 #  #
Line 54  use LONCAPA qw(:DEFAULT :match); Line 54  use LONCAPA qw(:DEFAULT :match);
 # When LON-CAPA is operating as a Consumer, nonce checking  # When LON-CAPA is operating as a Consumer, nonce checking
 # occurs when a Tool Provider launched from an instance of  # occurs when a Tool Provider launched from an instance of
 # an external tool in a LON-CAPA course makes a request to  # an external tool in a LON-CAPA course makes a request to
 # (a) /adm/service/roster or (b) /adm/service/passback to,   # (a) /adm/service/roster or (b) /adm/service/passback to,
 # respectively, retrieve a roster or store the grade for   # respectively, retrieve a roster or store the grade for
 # the original launch by a specific user.  # the original launch by a specific user.
 #  #
 # When LON-CAPA is operating as a Provider, nonce checking   # When LON-CAPA is operating as a Provider, nonce checking
 # occurs when a user in course context in another LMS (the   # occurs when a user in course context in another LMS (the
 # Consumer) launches an external tool to access a LON-CAPA URL:   # Consumer) launches an external tool to access a LON-CAPA URL:
 # /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended.  # /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended.
 #  #
   
Line 98  sub check_nonce { Line 98  sub check_nonce {
 # LON-CAPA as LTI Consumer  # LON-CAPA as LTI Consumer
 #  #
 # Determine the domain and the courseID of the LON-CAPA course  # Determine the domain and the courseID of the LON-CAPA course
 # for which access is needed by a Tool Provider -- either to   # for which access is needed by a Tool Provider -- either to
 # retrieve a roster or store the grade for an instance of an   # retrieve a roster or store the grade for an instance of an
 # external tool in the course.  # external tool in the course.
 #  #
   
Line 144  sub get_loncapa_course { Line 144  sub get_loncapa_course {
 #  #
 # LON-CAPA as LTI Consumer  # LON-CAPA as LTI Consumer
 #  #
 # Determine the symb and (optionally) LON-CAPA user for an   # Determine the symb and (optionally) LON-CAPA user for an
 # instance of an external tool in a course -- either to   # instance of an external tool in a course -- either to
 # to retrieve a roster or store a grade.  # to retrieve a roster or store a grade.
 #  #
 # Use the digested symb to lookup the real symb in exttools.db  # Use the digested symb to lookup the real symb in exttools.db
Line 157  sub get_tool_instance { Line 157  sub get_tool_instance {
     my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_;      my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_;
     return unless (ref($errors) eq 'HASH');      return unless (ref($errors) eq 'HASH');
     my ($marker,$symb,$uname,$udom);      my ($marker,$symb,$uname,$udom);
     my @keys = ($digsymb);       my @keys = ($digsymb);
     if ($diguser) {      if ($diguser) {
         push(@keys,$diguser);          push(@keys,$diguser);
     }      }
Line 188  sub get_tool_instance { Line 188  sub get_tool_instance {
 # LON-CAPA as LTI Consumer  # LON-CAPA as LTI Consumer
 #  #
 # Retrieve data needed to validate a request from a Tool Provider  # 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.  # 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  # configuration or the Tool Provider ID stored in the
 # exttool_$marker db file and compare the Consumer key with the  # exttool_$marker db file and compare the Consumer key with the
 # one in the POSTed data.  # 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  # contents of the .db file (instance of tool in course) and the
 # $ltitools hashref with the configuration for the tool (at  # $ltitools hashref with the configuration for the tool (at
 # domain level).  # domain level).
Line 309  sub verify_request { Line 309  sub verify_request {
   
 sub verify_lis_item {  sub verify_lis_item {
     my ($sigrec,$context,$digsymb,$diguser,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_;      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'));                     (ref($errors) eq 'HASH'));
     my ($has_action, $valid_for);      my ($has_action, $valid_for);
     if ($context eq 'grade') {      if ($context eq 'grade') {
Line 330  sub verify_lis_item { Line 330  sub verify_lis_item {
             my $expected_sig;              my $expected_sig;
             if ($context eq 'grade') {              if ($context eq 'grade') {
                 my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum;                  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) {                  if ($expected_sig eq $sigrec) {
                     return 1;                      return 1;
                 } else {                  } else {
Line 338  sub verify_lis_item { Line 338  sub verify_lis_item {
                 }                  }
             } elsif ($context eq 'roster') {              } elsif ($context eq 'roster') {
                 my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;                  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) {                  if ($expected_sig eq $sigrec) {
                     return 1;                      return 1;
                 } else {                  } else {
Line 358  sub verify_lis_item { Line 358  sub verify_lis_item {
 # LON-CAPA as LTI Consumer  # LON-CAPA as LTI Consumer
 #  #
 # Sign a request used to launch an instance of an external  # Sign a request used to launch an instance of an external
 # tool in a LON-CAPA course, using the key and secret supplied   # tool in a LON-CAPA course, using the key and secret supplied
 # by the Tool Provider.  # by the Tool Provider.
 #   #
   
 sub sign_params {  sub sign_params {
     my ($url,$key,$secret,$paramsref,$sigmethod,$type,$callback,$post) = @_;      my ($url,$key,$secret,$paramsref,$sigmethod,$type,$callback,$post) = @_;
Line 417  sub get_service_id { Line 417  sub get_service_id {
 # grade store). An existing secret past its expiration date  # grade store). An existing secret past its expiration date
 # will be stored as old<service name>secret, and a new secret  # will be stored as old<service name>secret, and a new secret
 # <service name>secret will be stored.  # <service name>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).  # (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.  # domain configuration for the specific tool and the service.
 #   #
   
 sub set_service_secret {  sub set_service_secret {
     my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$ltitools) = @_;      my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$ltitools) = @_;
Line 472  sub set_service_secret { Line 472  sub set_service_secret {
 #  #
 # LON-CAPA as LTI Consumer  # 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.  # when generating and storing a service secret.
 #  #
   
Line 539  sub parse_grade_xml { Line 539  sub parse_grade_xml {
                 my ($text) = @_;                  my ($text) = @_;
                 if ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord sourcedGUID sourcedId") {                  if ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord sourcedGUID sourcedId") {
                     $data{$count}{sourcedid} = $text;                      $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;                      $data{$count}{score} = $text;
                 }                  }
             }, "dtext"],              }, "dtext"],
Line 773  sub send_grade { Line 773  sub send_grade {
         );          );
         my %info = (          my %info = (
                         method => $sigmethod,                          method => $sigmethod,
                    );                      );
         my ($status,$hashref) =          my ($status,$hashref) =
             &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,              &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,
                                       \%ltiparams,\%info);                                           \%ltiparams,\%info);
         if (($status eq 'ok') && (ref($hashref) eq 'HASH')) {          if (($status eq 'ok') && (ref($hashref) eq 'HASH')) {
             $request=new HTTP::Request('POST',$url);              $request=new HTTP::Request('POST',$url);
             $request->content(join('&',map {              $request->content(join('&',map {
Line 802  sub send_grade { Line 802  sub send_grade {
   <imsx_POXBody>    <imsx_POXBody>
     <replaceResultRequest>      <replaceResultRequest>
       <resultRecord>        <resultRecord>
  <sourcedGUID>          <sourcedGUID>
   <sourcedId>$id</sourcedId>            <sourcedId>$id</sourcedId>
  </sourcedGUID>          </sourcedGUID>
  <result>          <result>
   <resultScore>            <resultScore>
     <language>en</language>              <language>en</language>
     <textString>$score</textString>              <textString>$score</textString>
   </resultScore>            </resultScore>
  </result>          </result>
       </resultRecord>        </resultRecord>
     </replaceResultRequest>      </replaceResultRequest>
   </imsx_POXBody>    </imsx_POXBody>
Line 834  END Line 834  END
             &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,\%params,\%info);              &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,\%params,\%info);
         if (($status eq 'ok') && ($authheader ne '')) {          if (($status eq 'ok') && ($authheader ne '')) {
             $request = HTTP::Request->new(              $request = HTTP::Request->new(
                    $reqmethod,                             $reqmethod,
                    $url,                             $url,
                    [                             [
               'Authorization' => $authheader,                                'Authorization' => $authheader,
               'Content-Type'  => 'application/xml',                                'Content-Type'  => 'application/xml',
                    ],                             ],
                    $gradexml,                             $gradexml,
             );              );
             my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);              my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
             my $message=$response->status_line;              my $message=$response->status_line;
Line 864  sub setup_logout_callback { Line 864  sub setup_logout_callback {
             my %info = (              my %info = (
                 respfmt => 'to_post_body',                  respfmt => 'to_post_body',
             );              );
             my ($status,$post) =               my ($status,$post) =
                 &Apache::lonnet::sign_lti($cdom,$cnum,$crstool,'lti','logout',$service_url,$idx,                  &Apache::lonnet::sign_lti($cdom,$cnum,$crstool,'lti','logout',$service_url,$idx,
                                           $keynum,\%ltiparams,\%info);                                            $keynum,\%ltiparams,\%info);
             if (($status eq 'ok') && ($post ne '')) {              if (($status eq 'ok') && ($post ne '')) {
Line 880  sub setup_logout_callback { Line 880  sub setup_logout_callback {
 #  #
 # LON-CAPA as LTI Provider  # LON-CAPA as LTI Provider
 #  #
 # Create a new user in LON-CAPA. If the domain's configuration   # Create a new user in LON-CAPA. If the domain's configuration
 # includes rules for format of "official" usernames, those rules  # includes rules for format of "official" usernames, those rules
 # will apply when determining if a user is to be created.  In  # will apply when determining if a user is to be created.  In
 # additional if institutional user information is available that  # additional if institutional user information is available that
Line 1021  sub create_passwd { Line 1021  sub create_passwd {
 # in the Consumer, user privs will be added to the user's environment for  # in the Consumer, user privs will be added to the user's environment for
 # the new role.  # the new role.
 #  #
 # If this is a self-enroll case, a Course Coordinator role will only be assigned   # If this is a self-enroll case, a Course Coordinator role will only be assigned
 # if the current user is also the course owner.  # if the current user is also the course owner.
 #  #
   
Line 1065  sub enrolluser { Line 1065  sub enrolluser {
 # with LTI Instructor status.  # with LTI Instructor status.
 #  #
 # A list of users is obtained by a call to get_roster()  # A list of users is obtained by a call to get_roster()
 # if the calling Consumer support the LTI extension:   # if the calling Consumer support the LTI extension:
 # Context Memberships Service.   # Context Memberships Service.
 #  #
 # If a user included in the retrieved list does not currently  # If a user included in the retrieved list does not currently
 # have a user account in LON-CAPA, an account will be created.  # have a user account in LON-CAPA, an account will be created.
Line 1313  sub batchaddroster { Line 1313  sub batchaddroster {
 #  #
 # Which LON-CAPA roles are assignable by the current user  # Which LON-CAPA roles are assignable by the current user
 # and how LTI roles map to LON-CAPA roles (as defined in  # and how LTI roles map to LON-CAPA roles (as defined in
 # the domain configuration for the specific Consumer) are   # the domain configuration for the specific Consumer) are
 # factored in when compiling the list of available roles.  # factored in when compiling the list of available roles.
 #  #
 # Inputs: 3  # Inputs: 3
Line 1370  sub get_lc_roles { Line 1370  sub get_lc_roles {
 # LON-CAPA as LTI Provider  # LON-CAPA as LTI Provider
 #  #
 # Compares current start and dates for a user's role  # 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  # determine if there is a change between the current
 # ones and the updated ones.  # ones and the updated ones.
 #   #
   
 sub datechange_check {  sub datechange_check {
     my ($oldstart,$oldend,$startdate,$enddate) = @_;      my ($oldstart,$oldend,$startdate,$enddate) = @_;
Removed from v.1.20  
changed lines
  Added in v.1.21

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