[LON-CAPA-cvs] cvs: loncom /homework lonhomework.pm structuretags.pm /interface lontrackstudent.pm /lonnet/perl lonnet.pm /lti ltiutils.pm /metadata_database parse_activity_log.pl

raeburn raeburn at source.lon-capa.org
Thu Nov 21 02:26:04 EST 2024


raeburn		Thu Nov 21 07:26:04 2024 EDT

  Modified files:              
    /loncom/homework	structuretags.pm lonhomework.pm 
    /loncom/lonnet/perl	lonnet.pm 
    /loncom/metadata_database	parse_activity_log.pl 
    /loncom/interface	lontrackstudent.pm 
    /loncom/lti	ltiutils.pm 
  Log:
  - Where session launch was via LTI-mediated deep-linking from another CMS
    and launch payload included URL and uniqueID for return of score:
    (a) successful score transfer
       - logged in course's activity log (action = EXPORT)
       - passback information stored in student's $cdom_$cnum_lp_passback.db
    (b) unsuccessful score transfer
       - logged in student's activity log and lonnet.log
       - passback information stored in course's linkprot_passback_pending.db
  
  
-------------- next part --------------
Index: loncom/homework/structuretags.pm
diff -u loncom/homework/structuretags.pm:1.586 loncom/homework/structuretags.pm:1.587
--- loncom/homework/structuretags.pm:1.586	Mon Sep 30 04:52:53 2024
+++ loncom/homework/structuretags.pm	Thu Nov 21 07:26:01 2024
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA 
 # definition of tags that give a structure to a document
 #
-# $Id: structuretags.pm,v 1.586 2024/09/30 04:52:53 raeburn Exp $
+# $Id: structuretags.pm,v 1.587 2024/11/21 07:26:01 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1169,8 +1169,8 @@
 	delete(@Apache::lonhomework::results{@remove});
 	my ($symb,$courseid,$domain,$name) = 
 	    &Apache::lonnet::whichuser($given_symb);
-        my ($passback,$pbscope,$pbmap,$pbsymb,$pbtype,$crsdef,$ltinum,
-            $ltiref,$total,$possible,$dopassback);
+        my ($passback,$pbscope,$pbmap,$pbsymb,$crsdef,$ltinum,
+            $ltiref,$total,$possible,$dopassback,$scope);
 	if ($env{'request.state'} eq 'construct' 
 	    || $symb eq ''
 	    || $Apache::lonhomework::type eq 'practice') {
@@ -1191,7 +1191,7 @@
                         ($passback,$pbscope,$pbmap,$pbsymb,$ltinum,$ltiref) =
                             &needs_lti_passback($courseid,$symb,$map);
                     } elsif ($env{'request.deeplink.login'}) {
-                        ($passback,$pbscope,$pbmap,$pbsymb,$crsdef,$ltinum,$ltiref) =
+                        ($passback,$pbscope,$pbmap,$pbsymb,$crsdef,$ltinum,$ltiref,$scope) =
                             &needs_linkprot_passback($courseid,$symb,$map);
                     }
                 }
@@ -1338,7 +1338,7 @@
                         }
                     }
                 }
-                my ($pbid,$pburl,$pbtype);
+                my ($pbid,$pburl,$pbtype,$clientip);
                 if ($env{'request.lti.login'}) {
                     $pbid = $env{'request.lti.passbackid'};
                     $pburl = $env{'request.lti.passbackurl'};
@@ -1348,6 +1348,7 @@
                     $pburl = $env{'request.linkprotpburl'};
                     $pbtype = 'linkprot';
                 }
+                $clientip = &Apache::lonnet::get_requestor_ip();
                 my $ltigrade = {
                                  'ltinum'   => $ltinum,
                                  'lti'      => $ltiref,
@@ -1355,14 +1356,20 @@
                                  'cid'      => $courseid,
                                  'uname'    => $env{'user.name'},
                                  'udom'     => $env{'user.domain'},
+                                 'uhome'    => $env{'user.home'},
                                  'pbid'     => $pbid,
                                  'pburl'    => $pburl,
                                  'pbtype'   => $pbtype,
-                                 'scope'    => $pbscope,
+                                 'pbscope'  => $pbscope,
                                  'pbmap'    => $pbmap,
                                  'pbsymb'   => $pbsymb,
                                  'format'   => $scoreformat,
+                                 'scope'    => $scope,
+                                 'clientip' => $clientip,
                                };
+                if ($env{'request.linkprot'}) {
+                    $ltigrade->{'linkprot'} = $env{'request.linkprot'};
+                }
                 if ($pbscope eq 'resource') {
                     $ltigrade->{'total'} = $total;
                     $ltigrade->{'possible'} = $possible;
@@ -1466,7 +1473,7 @@
                                 }
                             }
                         }
-                        return ($passback,$pbscope,$deeplink_map,$deeplink_symb,$crsdef,$itemnum,$lti_in_use);
+                        return ($passback,$pbscope,$deeplink_map,$deeplink_symb,$crsdef,$itemnum,$lti_in_use,$scope);
                     }
                 }
             }
Index: loncom/homework/lonhomework.pm
diff -u loncom/homework/lonhomework.pm:1.383 loncom/homework/lonhomework.pm:1.384
--- loncom/homework/lonhomework.pm:1.383	Wed Feb 21 19:50:21 2024
+++ loncom/homework/lonhomework.pm	Thu Nov 21 07:26:01 2024
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Homework handler
 #
-# $Id: lonhomework.pm,v 1.383 2024/02/21 19:50:21 raeburn Exp $
+# $Id: lonhomework.pm,v 1.384 2024/11/21 07:26:01 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1978,6 +1978,8 @@
 
 sub do_ltipassback {
     if (@Apache::lonhomework::ltipassback) {
+        my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
+        my $ip = &Apache::lonnet::get_host_ip($lonhost);
         foreach my $item (@Apache::lonhomework::ltipassback) {
             if (ref($item) eq 'HASH') {
                 if ((ref($item->{'lti'}) eq 'HASH') && ($item->{'cid'} =~ /^($match_domain)_($match_courseid)$/)) {
@@ -1988,25 +1990,94 @@
                     my $id = $item->{'pbid'};
                     my $url = $item->{'pburl'};
                     my $type = $item->{'pbtype'};
-                    my $scope = $item->{'scope'};
+                    my $pbscope = $item->{'pbscope'};
                     my $map = $item->{'pbmap'};
                     my $symb = $item->{'pbsymb'};
                     my $uname = $item->{'uname'};
                     my $udom = $item->{'udom'};
+                    my $uhome = $item->{'uhome'};
                     my $keynum = $item->{'lti'}->{'cipher'};
                     my $crsdef = $item->{'crsdef'};
                     my $scoretype = $item->{'format'};
+                    my $scope = $item->{'scope'};
+                    my $clientip = $item->{'clientip'};
                     my ($total,$possible);
-                    if ($scope eq 'resource') {
+                    if ($pbscope eq 'resource') {
                         $total = $item->{'total'};
                         $possible = $item->{'possible'};
-                    } elsif (($scope eq 'map') || ($scope eq 'nonrec')) {
-                        ($total,$possible) = &get_lti_score($uname,$udom,$map,$scope);
-                    } elsif ($scope eq 'course') {
-                        ($total,$possible) = &get_lti_score($uname,$udom);
+                    } else {
+                        if (($pbscope eq 'map') || ($pbscope eq 'nonrec')) {
+                            ($total,$possible) = &get_lti_score($uname,$udom,$map,$pbscope);
+                        } elsif ($pbscope eq 'course') {
+                            ($total,$possible) = &get_lti_score($uname,$udom);
+                        }
+                        $item->{'total'} = $total;
+                        $item->{'possible'} = $possible;
                     }
                     if (($id ne '') && ($url ne '') && ($possible)) {
-                        &LONCAPA::ltiutils::send_grade($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,$url,$scoretype,$sigmethod,$msgformat,$total,$possible);
+                        my ($sent,$score,$code,$result) = 
+                            &LONCAPA::ltiutils::send_grade($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,
+                                                           $url,$scoretype,$sigmethod,$msgformat,$total,$possible);
+                        $item->{'score'} = $score;
+                        my ($linkprotector,$linkuri,$no_passback,$appname);
+                        if ($item->{'linkprot'}) {
+                            ($linkprotector,$linkuri) = split(/:/,$item->{'linkprot'});
+                        }
+                        if ($sent) {
+                            if ($code == 200) {
+                                if ($item->{'linkprot'}) {
+                                    my $key = join("\0",($linkuri,$linkprotector,$scope));
+                                    my $namespace = $cdom.'_'.$cnum.'_lp_passback';
+                                    my $store = {
+                                                 'score' => $score,
+                                                 'ip' => $ip,
+                                                 'host' => $Apache::lonnet::perlvar{'lonHostID'},
+                                                 'protector' => $linkprotector,
+                                                 'deeplink' => $linkuri,
+                                                 'scope' => $scope,
+                                                 'url' => $url,
+                                                 'id' => $id,
+                                                 'clientip' => $clientip,
+                                                 'whodoneit' => $env{'user.name'}.':'.$env{'user.domain'},
+                                                };
+                                    my $value='';
+                                    foreach my $key (keys(%{$store})) {
+                                        $value.=&escape($key).'='.&Apache::lonnet::freeze_escape($store->{$key}).'&';
+                                    }
+                                    $value=~s/\&$//;
+                                    &Apache::lonnet::courselog(&escape($linkuri).':'.$uname.':'.$udom.':EXPORT:'.$value);
+                                    &Apache::lonnet::cstore({'score' => $score},$key,$namespace,$udom,$uname,'',$ip,1);
+                                }
+                            } else {
+                                if ($item->{'linkprot'}) {
+                                    $no_passback = "Passback response was $code ($result).";
+                                }
+                            }
+                        } else {
+                            if ($item->{'linkprot'}) {
+                                $no_passback = 'No passback of scores.';
+                            }
+                        }
+                        if ($no_passback) {
+                            if ($item->{'linkprot'}) {
+                                my ($ltinum,$ltitype) = ($linkprotector =~ /^(\d+)(c|d)$/);
+                                if ($ltitype eq 'c') {
+                                    my %lti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
+                                    if (ref($lti{$ltinum}) eq 'HASH') {
+                                        $appname = $lti{$ltinum}{'name'};
+                                    }
+                                } elsif ($ltitype eq 'd') {
+                                    my %lti = &Apache::lonnet::get_domain_lti($cdom,'linkprot');
+                                    if (ref($lti{$ltinum}) eq 'HASH') {
+                                        $appname = $lti{$ltinum}{'name'};
+                                    }
+                                }
+                                $no_passback .= " LTI launcher $linkprotector ($appname) for $linkuri (${cdom}_${cnum})";
+                                &Apache::lonnet::logthis($no_passback." for $uname:$udom");
+                                &Apache::lonnet::log($udom,$uname,$uhome,"$no_passback score=$score total=$total poss=$possible");
+                                &Apache::lonnet::put('linkprot_passback_pending',$item,$cdom,$cnum);
+                            }
+                        }
                     }
                 }
             }
@@ -2016,7 +2087,7 @@
 }
 
 sub get_lti_score {
-    my ($uname,$udom,$mapurl,$scope) = @_;
+    my ($uname,$udom,$mapurl,$pbscope) = @_;
     my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom);
     if (ref($navmap)) {
         my $iterator;
@@ -2025,7 +2096,7 @@
             my $firstres = $map->map_start();
             my $finishres = $map->map_finish();
             my $recursive = 1;
-            if ($scope eq 'nonrec') {
+            if ($pbscope eq 'nonrec') {
                 $recursive = 0;
             }
             $iterator = $navmap->getIterator($firstres,$finishres,undef,$recursive);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1529 loncom/lonnet/perl/lonnet.pm:1.1530
--- loncom/lonnet/perl/lonnet.pm:1.1529	Wed Sep 25 17:29:15 2024
+++ loncom/lonnet/perl/lonnet.pm	Thu Nov 21 07:26:02 2024
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1529 2024/09/25 17:29:15 raeburn Exp $
+# $Id: lonnet.pm,v 1.1530 2024/11/21 07:26:02 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -6749,18 +6749,22 @@
 # -------------------------------------------------------------- Critical Store
 
 sub cstore {
-    my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_;
+    my ($storehash,$symb,$namespace,$domain,$stuname,$laststore,$ip,$nolog) = @_;
     my $home='';
 
     if ($stuname) { $home=&homeserver($stuname,$domain); }
 
-    $symb=&symbclean($symb);
+    unless (($symb eq '_feedback') || ($symb eq '_discussion')) {
+        $symb=&symbclean($symb);
+    }
     if (!$symb) { unless ($symb=&symbread()) { return ''; } }
 
     if (!$domain) { $domain=$env{'user.domain'}; }
     if (!$stuname) { $stuname=$env{'user.name'}; }
 
-    &devalidate($symb,$stuname,$domain);
+    unless (($symb eq '_feedback') || ($symb eq '_discussion')) {
+        &devalidate($symb,$stuname,$domain);
+    }
 
     $symb=escape($symb);
     if (!$namespace) { 
@@ -6770,7 +6774,11 @@
     }
     if (!$home) { $home=$env{'user.home'}; }
 
-    $$storehash{'ip'}=&get_requestor_ip();
+    if ($ip ne '') {
+        $$storehash{'ip'} = $ip;
+    } else {
+        $$storehash{'ip'} = &get_requestor_ip();
+    }
     $$storehash{'host'}=$perlvar{'lonHostID'};
 
     my $namevalue='';
@@ -6778,7 +6786,9 @@
         $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
     }
     $namevalue=~s/\&$//;
-    &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
+    unless ($nolog) {
+        &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
+    }
     return critical
                 ("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home");
 }
Index: loncom/metadata_database/parse_activity_log.pl
diff -u loncom/metadata_database/parse_activity_log.pl:1.25 loncom/metadata_database/parse_activity_log.pl:1.26
--- loncom/metadata_database/parse_activity_log.pl:1.25	Mon Nov 24 02:36:34 2014
+++ loncom/metadata_database/parse_activity_log.pl	Thu Nov 21 07:26:02 2024
@@ -2,7 +2,7 @@
 #
 # The LearningOnline Network
 #
-# $Id: parse_activity_log.pl,v 1.25 2014/11/24 02:36:34 raeburn Exp $
+# $Id: parse_activity_log.pl,v 1.26 2024/11/21 07:26:02 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -483,6 +483,8 @@
         # %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value)
         # or
         # %3aPUTSTORE%3a(name)%3d(value)%26(name)%3d(value)
+        # or
+        # %3aEXPORT%3a(name)%3d(value)%26(name)%3d(value)
         #
         # get delimiter between timestamped entries to be &&&
         $log=~s/\%26(\d{9,10})\%3a/\&\&\&$1\%3a/g;
@@ -513,7 +515,7 @@
             if (! defined($action) || $action eq '') {
                 $action = 'VIEW';
             }
-            if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE|PUTSTORE)$/) {
+            if ($action !~ /^(LOGIN|VIEW|POST|CSTORE|STORE|PUTSTORE|EXPORT)$/) {
                 $warningflag .= 'action';
                 print $error_fh 'full log entry:'.$log.$/;
                 print $error_fh 'error on chunk (saving)'.$/;
Index: loncom/interface/lontrackstudent.pm
diff -u loncom/interface/lontrackstudent.pm:1.40 loncom/interface/lontrackstudent.pm:1.41
--- loncom/interface/lontrackstudent.pm:1.40	Sun Nov 12 23:06:51 2017
+++ loncom/interface/lontrackstudent.pm	Thu Nov 21 07:26:03 2024
@@ -1,6 +1,6 @@
 # The LearningOnline Network with CAPA
 #
-# $Id: lontrackstudent.pm,v 1.40 2017/11/12 23:06:51 raeburn Exp $
+# $Id: lontrackstudent.pm,v 1.41 2024/11/21 07:26:03 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -46,6 +46,7 @@
 use Apache::Constants qw(:common :http);
 use Apache::lonmysql;
 use Apache::lonnet;
+use Apache::loncommon;
 use Apache::lonlocal;
 use Time::HiRes;
 use DateTime();
@@ -324,6 +325,9 @@
 	    $_=&unescape($_);
 	}
         my ($title,$src);
+        if ($symb =~ m{^\Q/tiny/$cdom/\E\w+$}) {
+            $symb = &Apache::loncommon::symb_from_tinyurl($symb,$cnum,$cdom);
+        }
         if ($symb =~ m:^/adm/:) {
             $title = $symb;
             $src = $symb;
@@ -346,6 +350,9 @@
                     $src   = '/dev/null';
                 }
             }
+            if ($src =~ /.sequence$/) {
+                $src .= '?navmap=1';
+            }
         }
         my %classes;
         my $class_count=0;
@@ -432,7 +439,7 @@
 sub display_values {
     my ($action,$values)=@_;
     my $result='<table>';
-    if (($action eq 'CSTORE') || ($action eq 'PUTSTORE')) {
+    if (($action eq 'CSTORE') || ($action eq 'PUTSTORE') || ($action eq 'EXPORT')) {
         my $is_anon;
 	my %values=map {split('=',$_,-1)} split(/\&/,$values);
 	foreach my $key (sort(keys(%values))) {
Index: loncom/lti/ltiutils.pm
diff -u loncom/lti/ltiutils.pm:1.21 loncom/lti/ltiutils.pm:1.22
--- loncom/lti/ltiutils.pm:1.21	Tue Feb 27 04:04:06 2024
+++ loncom/lti/ltiutils.pm	Thu Nov 21 07:26:04 2024
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Utility functions for managing LON-CAPA LTI interactions
 #
-# $Id: ltiutils.pm,v 1.21 2024/02/27 04:04:06 raeburn Exp $
+# $Id: ltiutils.pm,v 1.22 2024/11/21 07:26:04 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -34,6 +34,7 @@
 use Digest::MD5 qw(md5_hex);
 use Encode;
 use UUID::Tiny ':std';
+use HTTP::Status;
 use Apache::lonnet;
 use Apache::loncommon;
 use Apache::loncoursedata;
@@ -758,7 +759,7 @@
     if ($sigmethod eq '') {
         $sigmethod = 'HMAC-SHA1';
     }
-    my $request;
+    my ($request,$sendit,$respcode,$result);
     if ($msgformat eq '1.0') {
         my $date = &Apache::loncommon::utc_string(time);
         my %ltiparams = (
@@ -785,7 +786,7 @@
                               ? join("&$name=", map {escape($_) } @{$hashref->{$_}})
                               : &escape($hashref->{$_}) );
                               } keys(%{$hashref})));
-#FIXME Need to handle case where passback failed.
+            $sendit = 1;
         }
     } else {
         srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
@@ -842,11 +843,16 @@
                            ],
                            $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.
+            $sendit = 1;
         }
     }
+    if ($sendit) {
+        my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
+        my $message=$response->status_line;
+        $respcode = $response->code;
+        $result = HTTP::Status::status_message($respcode); 
+    }
+    return ($sendit,$score,$respcode,$result);
 }
 
 sub setup_logout_callback {


More information about the LON-CAPA-cvs mailing list