[LON-CAPA-cvs] cvs: loncom / Lond.pm lond lontrans.pm /auth lonacc.pm lonauth.pm lonlogin.pm lonshibauth.pm migrateuser.pm switchserver.pm /homework lonhomework.pm structuretags.pm /interface lonconfigsettings.pm lonexttool.pm lontiny.pm /lonnet/perl lonnet.pm /lti ltiauth.pm ltiutils.pm

raeburn raeburn at source.lon-capa.org
Thu Jun 1 21:20:29 EDT 2023


raeburn		Fri Jun  2 01:20:29 2023 EDT

  Modified files:              
    /loncom/auth	lonacc.pm lonauth.pm lonshibauth.pm lonlogin.pm 
                	migrateuser.pm switchserver.pm 
    /loncom/interface	lonconfigsettings.pm lonexttool.pm lontiny.pm 
    /loncom/homework	lonhomework.pm structuretags.pm 
    /loncom/lti	ltiutils.pm ltiauth.pm 
    /loncom	lontrans.pm lond Lond.pm 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Bugs 6754 and 6907
    - Return of grades to launcher CMS supported for resources or folders
      accessed via LTI-mediated deep link.
    - Support option: "Encrypt stored consumer secrets defined in domain"
    - Signing of LTI payloads for roster retrieval, passback of grades,
      and callback to logput launcher CMS session all now occur on
      primary library server for course's domain. 
  
  
-------------- next part --------------
Index: loncom/auth/lonacc.pm
diff -u loncom/auth/lonacc.pm:1.207 loncom/auth/lonacc.pm:1.208
--- loncom/auth/lonacc.pm:1.207	Sat Sep 17 23:38:50 2022
+++ loncom/auth/lonacc.pm	Fri Jun  2 01:20:26 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Cookie Based Access Handler
 #
-# $Id: lonacc.pm,v 1.207 2022/09/17 23:38:50 raeburn Exp $
+# $Id: lonacc.pm,v 1.208 2023/06/02 01:20:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -333,7 +333,8 @@
         }
     }
 
-    my ($linkprot,$linkprotuser,$linkprotexit,$linkkey,$deeplinkurl);
+    my ($linkprot,$linkprotuser,$linkprotexit,$linkkey,$deeplinkurl,
+        $linkprotpbid,$linkprotpburl);
 
 #
 # If Shibboleth auth is in use, and a dual SSO and non-SSO login page
@@ -373,6 +374,8 @@
             $linkprot = $info{'linkprot'};
             $linkprotuser = $info{'linkprotuser'};
             $linkprotexit = $info{'linkprotexit'};
+            $linkprotpbid = $info{'linkprotpbid'};
+            $linkprotpburl = $info{'linkprotpburl'};
         } elsif ($info{'linkkey'} ne '') {
             $linkkey = $info{'linkkey'};
         }
@@ -401,6 +404,8 @@
                 $linkprot = $form{'linkprot'};
                 $linkprotuser = $form{'linkprotuser'};
                 $linkprotexit = $form{'linkprotexit'};
+                $linkprotpbid = $form{'linkprotpbid'};
+                $linkprotpburl = $form{'linkprotpburl'};
             } elsif ($form{'linkkey'} ne '') {
                 $linkkey = $form{'linkkey'};
             }
@@ -430,6 +435,8 @@
                 $linkprot = $form{'linkprot'};
                 $linkprotuser = $form{'linkprotuser'};
                 $linkprotexit = $form{'linkprotexit'};
+                $linkprotpbid = $form{'linkprotpbid'};
+                $linkprotpburl = $form{'linkprotpburl'};
             } elsif ($form{'linkkey'} ne '') {
                 $linkkey = $form{'linkkey'};
             }
@@ -444,6 +451,12 @@
             if ($link_info{'linkprotexit'} ne '') {
                 $linkprotexit = $link_info{'linkprotexit'};
             }
+            if ($link_info{'linkprotpbid'} ne '') {
+                $linkprotpbid = $link_info{'linkprotpbid'};
+            }
+            if ($link_info{'linkprotpburl'} ne '') {
+                $linkprotpburl = $link_info{'linkprotpburl'};
+            }
         }
         my $delete = &Apache::lonnet::tmpdel($form{'ltoken'});
         delete($form{'ltoken'});
@@ -466,6 +479,8 @@
                            linkprot => $linkprot,
                            linkprotuser => $linkprotuser,
                            linkprotexit => $linkprotexit,
+                           linkprotpbid => $linkprotpbid,
+                           linkprotpburl => $linkprotpburl,
                        );
             if ($env{'form.lcssowin'}) {
                 $data{'lcssowin'} = $env{'form.lcssowin'};
@@ -538,6 +553,12 @@
                     if ($linkprotexit ne '') {
                         $env{'request.linkprotexit'} = $linkprotexit;
                     }
+                    if ($linkprotpbid ne '') {
+                        $env{'request.linkprotpbid'} = $linkprotpbid;
+                    }
+                    if ($linkprotpburl ne '') {
+                        $env{'request.linkprotpburl'} = $linkprotpburl;
+                    }
                 } elsif ($linkkey ne '') {
                     $env{'request.linkkey'} = $linkkey;
                 }
@@ -598,6 +619,12 @@
                     if ($linkprotexit ne '') {
                         $info{'linkprotexit'} = $linkprotexit;
                     }
+                    if ($linkprotpbid ne '') {
+                        $info{'linkprotpbid'} = $linkprotpbid;
+                    }
+                    if ($linkprotpburl ne '') {
+                        $info{'linkprotpburl'} = $linkprotpburl;
+                    }
                 } elsif ($linkkey ne '') {
                     $info{'linkkey'} = $linkkey;
                 }
@@ -824,6 +851,8 @@
                                 linkprot => $info{'linkprot'},
                                 linkprotuser => $info{'linkprotuser'},
                                 linkprotexit => $info{'linkprotexit'},
+                                linkprotpbid => $info{'linkprotpbid'},
+                                linkprotpburl => $info{'linkprotpburl'},
                             );
                         } elsif ($info{'ltoken'} ne '') {
                             my %ltoken_info = &Apache::lonnet::tmpget($info{'ltoken'});
@@ -834,6 +863,8 @@
                                     linkprot => $ltoken_info{'linkprot'},
                                     linkprotuser => $ltoken_info{'linkprotuser'},
                                     linkprotexit => $ltoken_info{'linkprotexit'},
+                                    linkprotpbid => $ltoken_info{'linkprotpbid'},
+                                    linkprotpburl => $ltoken_info{'linkprotpburl'},
                                 );
                             }
                         }
Index: loncom/auth/lonauth.pm
diff -u loncom/auth/lonauth.pm:1.178 loncom/auth/lonauth.pm:1.179
--- loncom/auth/lonauth.pm:1.178	Sat Sep 17 23:38:50 2022
+++ loncom/auth/lonauth.pm	Fri Jun  2 01:20:26 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # User Authentication Module
 #
-# $Id: lonauth.pm,v 1.178 2022/09/17 23:38:50 raeburn Exp $
+# $Id: lonauth.pm,v 1.179 2023/06/02 01:20:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -192,7 +192,7 @@
         my %info;
         if ($env{'request.linkprot'}) {
             $info{'linkprot'} = $env{'request.linkprot'};
-            foreach my $item ('linkprotuser','linkprotexit') {
+            foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                 if ($form->{$item}) {
                     $info{$item} = $form->{$item};
                 }
@@ -377,7 +377,7 @@
             my %info = (
                          'linkprot' => $form->{'linkprot'},
                        );
-            foreach my $item ('linkprotuser','linkprotexit') {
+            foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                 if ($form->{$item} ne '') {
                     $info{$item} = $form->{$item};
                 }
@@ -823,7 +823,7 @@
             }
             if ($form{'linkprot'}) {
                 $env{'request.linkprot'} = $form{'linkprot'};
-                foreach my $item ('linkprotuser','linkprotexit') {
+                foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                     if ($form{$item}) {
                         $env{'request.'.$item} = $form{$item};
                     }
@@ -864,7 +864,7 @@
                 }
                 if ($form{'linkprot'}) {
                     $env{'request.linkprot'} = $form{'linkprot'};
-                    foreach my $item ('linkprotuser','linkprotexit') {
+                    foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                         if ($form{$item}) {
                             $env{'request.'.$item} = $form{$item};
                         }
@@ -973,6 +973,12 @@
                 if ($form{'linkprotexit'}) {
                     $extra_env->{'request.linkprotexit'} = $form{'linkprotexit'};
                 }
+                if ($form{'linkprotpbid'}) {
+                    $extra_env->{'request.linkprotpbid'} = $form{'linkprotpbid'};
+                }
+                if ($form{'linkprotpburl'}) {
+                    $extra_env->{'request.linkprotpburl'} = $form{'linkprotpburl'};
+                }
             } elsif ($form{'linkkey'} ne '') {
                 if (ref($extra_env) eq 'HASH') {
                     %{$extra_env} = ( %{$extra_env}, 'request.linkkey' => $form{'linkkey'} );
@@ -1061,7 +1067,7 @@
     my ($form,$lonhost,$querystr) = @_;
     if (ref($form) eq 'HASH') {
         my ($firsturl,$token,$extras, at names);
-        @names = ('role','symb','linkprotuser','linkprotexit','linkprot','linkkey','iptoken');
+        @names = ('role','symb','linkprotuser','linkprotexit','linkprot','linkkey','iptoken','linkprotpbid','linkprotpburl');
         foreach my $name (@names) {
             if ($form->{$name} ne '') {
                 $extras .= '&'.$name.'='.&escape($form->{$name});
Index: loncom/auth/lonshibauth.pm
diff -u loncom/auth/lonshibauth.pm:1.17 loncom/auth/lonshibauth.pm:1.18
--- loncom/auth/lonshibauth.pm:1.17	Sat Sep 17 23:38:50 2022
+++ loncom/auth/lonshibauth.pm	Fri Jun  2 01:20:26 2023
@@ -2,7 +2,7 @@
 # Redirect Single Sign On authentication to designated URL: 
 # /adm/sso, by default.
 #
-# $Id: lonshibauth.pm,v 1.17 2022/09/17 23:38:50 raeburn Exp $
+# $Id: lonshibauth.pm,v 1.18 2023/06/02 01:20:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -334,7 +334,7 @@
                 &Apache::lonnet::tmpdel($env{'form.ltoken'});
                 if ($info{'linkprot'}) {
                     $extras .= '&linkprot='.&escape($info{'linkprot'});
-                    foreach my $item ('linkprotuser','linkprotexit') {
+                    foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                         if ($info{$item} ne '') {
                             $extras .= '&'.$item.'='.&escape($info{$item});
                         }
Index: loncom/auth/lonlogin.pm
diff -u loncom/auth/lonlogin.pm:1.205 loncom/auth/lonlogin.pm:1.206
--- loncom/auth/lonlogin.pm:1.205	Fri Feb  3 23:09:30 2023
+++ loncom/auth/lonlogin.pm	Fri Jun  2 01:20:26 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Login Screen
 #
-# $Id: lonlogin.pm,v 1.205 2023/02/03 23:09:30 raeburn Exp $
+# $Id: lonlogin.pm,v 1.206 2023/06/02 01:20:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -68,7 +68,7 @@
             $env{'form.ltoken'} = $info{'ltoken'};
         } elsif ($info{'linkprot'}) {
             $env{'form.linkprot'} = $info{'linkprot'};
-            foreach my $item ('linkprotuser','linkprotexit') {
+            foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                 if ($info{$item} ne '') {
                     $env{'form.'.$item} = $info{$item};
                 }
@@ -199,7 +199,7 @@
                     $link_info{'ltoken'} = $env{'form.ltoken'};
                 } elsif ($env{'form.linkprot'}) {
                     $link_info{'linkprot'} = $env{'form.linkprot'};
-                    foreach my $item ('linkprotuser','linkprotexit') {
+                    foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                         if ($env{'form.'.$item} ne '') {
                             $link_info{$item} = $env{'form.'.$item};
                         }
@@ -277,7 +277,7 @@
             $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
         }
         if (($env{'form.ltoken'}) || ($env{'form.linkprot'})) {
-            my ($linkprot,$linkprotuser,$linkprotexit);
+            my ($linkprot,$linkprotuser,$linkprotexit,$linkprotpbid,$linkprotpburl);
             if ($env{'form.ltoken'}) {
                 my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
                 $linkprot = $info{'linkprot'};
@@ -287,10 +287,18 @@
                 if ($info{'linkprotexit'} ne '') {
                     $linkprotexit = $info{'linkprotexit'};
                 }
+                if ($info{'linkprotpbid'} ne '') {
+                    $linkprotpbid = $info{'linkprotpbid'};
+                }
+                if ($info{'linkprotpburl'} ne '') {
+                    $linkprotpburl = $info{'linkprotpburl'};
+                }
             } else {
                 $linkprot = $env{'form.linkprot'};
                 $linkprotuser = $env{'form.linkprotuser'};
                 $linkprotexit = $env{'form.linkprotexit'};
+                $linkprotpbid = $env{'form.linkprotpbid'};
+                $linkprotpburl = $env{'form.linkprotpburl'}; 
             }
             if ($linkprot) {
                 my ($linkprotector,$deeplink) = split(/:/,$linkprot,2);
@@ -302,7 +310,9 @@
                                           linkprot => $linkprot,
                                           linkprotuser => $linkprotuser,
                                           linkprotexit => $linkprotexit,
-                                       );    
+                                          linkprotpbid => $linkprotpbid,
+                                          linkprotpburl => $linkprotpburl,
+                                       );
                     if ($env{'form.ltoken'}) {
                         my $delete = &Apache::lonnet::tmpdel($env{'form.ltoken'});
                     }
@@ -493,7 +503,8 @@
 
 # -------------------------------------------------------- Store away log token
     my ($tokenextras,$tokentype,$linkprot_for_login);
-    my @names = ('role','symb','iptoken','ltoken','linkprotuser','linkprotexit','linkprot','linkkey','display');
+    my @names = ('role','symb','iptoken','ltoken','linkprotuser','linkprotexit',
+                 'linkprot','linkkey','display','linkprotpbid','linkprotpburl');
     foreach my $name (@names) {
         if ($env{'form.'.$name} ne '') {
             if ($name eq 'ltoken') {
@@ -501,7 +512,7 @@
                 if ($info{'linkprot'}) {
                     $linkprot_for_login = $info{'linkprot'};
                     $tokenextras .= '&linkprot='.&escape($info{'linkprot'});
-                    foreach my $item ('linkprotuser','linkprotexit') {
+                    foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                         if ($info{$item}) {
                             $tokenextras .= '&'.$item.'='.&escape($info{$item});
                         }
@@ -1260,7 +1271,7 @@
                 $args->{'only_body'} = 1;
             } elsif ($env{'form.linkprot'}) {
                 $link_info{'linkprot'} = $env{'form.linkprot'};
-                foreach my $item ('linkprotuser','linkprotexit') {
+                foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                     if ($env{'form.'.$item}) {
                         $link_info{$item} = $env{'form.'.$item};
                     }
Index: loncom/auth/migrateuser.pm
diff -u loncom/auth/migrateuser.pm:1.66 loncom/auth/migrateuser.pm:1.67
--- loncom/auth/migrateuser.pm:1.66	Sat Sep 17 23:38:50 2022
+++ loncom/auth/migrateuser.pm	Fri Jun  2 01:20:26 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Starts a user off based of an existing token.
 #
-# $Id: migrateuser.pm,v 1.66 2022/09/17 23:38:50 raeburn Exp $
+# $Id: migrateuser.pm,v 1.67 2023/06/02 01:20:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -289,7 +289,7 @@
                     'username'        => $dataref->{'username'},
                     'sessionserver'   => $lonhost,
                   );
-        my @names = ('origurl','symb','role','linkprotuser','linkprotexit','linkprot','linkkey');
+        my @names = ('origurl','symb','role','linkprotuser','linkprotexit','linkprot','linkkey','linkprotpbid','linkprotpburl');
         foreach my $name (@names) {
             if ($dataref->{$name} ne '') {
                 $info{$name} = $dataref->{$name};
@@ -760,6 +760,12 @@
                 unless ($env{'request.linkprotexit'} eq $data{'linkprotexit'}) {
                     $checklaunch = 1;
                 }
+                unless ($env{'request.linkprotpbid'} eq $data{'linkprotpbid'}) {
+                    $checklaunch = 1;
+                }
+                unless ($env{'request.linkprotpburl'} eq $data{'linkprotpburl'}) {
+                    $checklaunch = 1;
+                }
                 unless ($env{'request.linkkey'} eq $data{'linkkey'}) {
                     $checklaunch = 1;
                 }
@@ -771,7 +777,7 @@
                 if (($env{'user.name'} ne $data{'username'}) ||
                     ($env{'user.domain'} ne $data{'domain'})) {
                     my %linkprot_env;
-                    foreach my $item ('linkprot','linkprotexit','deeplink.login') {
+                    foreach my $item ('linkprot','linkprotexit','linkprotpbid','linkprotpburl','deeplink.login') {
                         if ($data{$item}) {
                             $linkprot_env{$item} = $data{$item};
                         }
@@ -921,7 +927,7 @@
                     my %info;
                     if ($env{'request.linkprot'}) {
                         $info{'linkprot'} = $env{'request.linkprot'};
-                        foreach my $item ('linkprotuser','linkprotexit') {
+                        foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                             if ($data{$item}) {
                                 $info{$item} = $data{$item};
                             }
@@ -980,8 +986,14 @@
                         if ($data{'linkprotexit'}) {
                             $extra_env->{'request.linkprotexit'} = $data{'linkprotexit'};
                         }
+                        if ($data{'linkprotpbid'}) {
+                            $extra_env->{'request.linkprotpbid'} = $data{'linkprotpbid'};
+                        }
+                        if ($data{'linkprotpburl'}) {
+                            $extra_env->{'request.linkprotpburl'} = $data{'linkprotpburl'};
+                        }
                     }
-                    foreach my $item ('linkprotuser','linkprotexit') {
+                    foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                         if ($data{$item} ne '') {
                             $form{$item} = $data{$item};
                         }
@@ -1093,7 +1105,13 @@
                 if ($data{'linkprotexit'}) {
                     $extra_env->{'request.linkprotexit'} = $data{'linkprotexit'};
                 }
-                foreach my $item ('linkprotuser','linkprotexit') {
+                if ($data{'linkprotpbid'}) {
+                    $extra_env->{'request.linkprotpassbid'} = $data{'linkprotpbid'};
+                }
+                if ($data{'linkprotpburl'}) {
+                    $extra_env->{'request.linkprotpassburl'} = $data{'linkprotpburl'};
+                }
+                foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                     if ($data{$item}) {
                         $form{'request.'.$item} = $data{$item};
                     }
Index: loncom/auth/switchserver.pm
diff -u loncom/auth/switchserver.pm:1.64 loncom/auth/switchserver.pm:1.65
--- loncom/auth/switchserver.pm:1.64	Sat Sep 17 23:38:50 2022
+++ loncom/auth/switchserver.pm	Fri Jun  2 01:20:26 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Switch Servers Handler
 #
-# $Id: switchserver.pm,v 1.64 2022/09/17 23:38:50 raeburn Exp $
+# $Id: switchserver.pm,v 1.65 2023/06/02 01:20:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -362,7 +362,7 @@
     }
     if ($env{'request.linkprot'}) {
         $info{'linkprot'} = $env{'request.linkprot'};
-        foreach my $item ('linkprotuser','linkprotexit') {
+        foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
             if ($env{'request.'.$item}) {
                 $info{$item} = $env{'request.'.$item};
             }
Index: loncom/interface/lonconfigsettings.pm
diff -u loncom/interface/lonconfigsettings.pm:1.69 loncom/interface/lonconfigsettings.pm:1.70
--- loncom/interface/lonconfigsettings.pm:1.69	Thu Apr 13 15:21:00 2023
+++ loncom/interface/lonconfigsettings.pm	Fri Jun  2 01:20:26 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Handler to set domain-wide configuration settings
 #
-# $Id: lonconfigsettings.pm,v 1.69 2023/04/13 15:21:00 raeburn Exp $
+# $Id: lonconfigsettings.pm,v 1.70 2023/06/02 01:20:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -346,7 +346,8 @@
                                     $onload .= "toggleChgSecret(document.display,'$num','secret','linkprot');";
                                 }
                             }
-                            $onload .= "toggleLinkProtExtra(document.display,'returnurl','divurlparam','1','inline-block','$num');";
+                            $onload .= "toggleLinkProtExtra(document.display,'returnurl','divurlparam','1','inline-block','$num');".
+                                       "toggleLinkProtExtra(document.display,'passback','passbackparam','1','inline-block','$num');";
                             if ($ltiauth) {
                                 $onload .= "toggleLinkProtExtra(document.display,'requser','optional','1','block','$num');".
                                            "toggleLinkProtExtra(document.display,'mapuser','userfield','other','inline-block','$num');";
Index: loncom/interface/lonexttool.pm
diff -u loncom/interface/lonexttool.pm:1.24 loncom/interface/lonexttool.pm:1.25
--- loncom/interface/lonexttool.pm:1.24	Mon May 22 21:10:55 2023
+++ loncom/interface/lonexttool.pm	Fri Jun  2 01:20:26 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Launch External Tool Provider (LTI)
 #
-# $Id: lonexttool.pm,v 1.24 2023/05/22 21:10:55 raeburn Exp $
+# $Id: lonexttool.pm,v 1.25 2023/06/02 01:20:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -445,8 +445,8 @@
 sub launch_html {
     my ($cdom,$cnum,$crstool,$url,$idx,$keynum,$submittext,$paramsref,$inforef) = @_;
     my ($status,$hashref) =
-        &Apache::lonnet::sign_lti($cdom,$cnum,$crstool,$url,$idx,$keynum,
-                                  '',$paramsref,$inforef);
+        &Apache::lonnet::sign_lti($cdom,$cnum,$crstool,'tools','launch',$url,$idx,$keynum,
+                                  $paramsref,$inforef);
     unless ($status eq 'ok') {
         return '<div class="LC_warning">'.&mt('External Tool Unavailable').'</div>';
     }
Index: loncom/interface/lontiny.pm
diff -u loncom/interface/lontiny.pm:1.18 loncom/interface/lontiny.pm:1.19
--- loncom/interface/lontiny.pm:1.18	Sat Oct 29 18:13:28 2022
+++ loncom/interface/lontiny.pm	Fri Jun  2 01:20:26 2023
@@ -2,7 +2,7 @@
 # Extract domain, courseID, and symb from a shortened URL,
 # and switch role to a role in designated course.
 #
-# $Id: lontiny.pm,v 1.18 2022/10/29 18:13:28 raeburn Exp $
+# $Id: lontiny.pm,v 1.19 2023/06/02 01:20:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -68,7 +68,7 @@
                         my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
                         if ($chome ne 'no_host') {
                             &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['ttoken']);
-                            my ($linkprot,$linkprotuser,$linkprotexit,$ltoken);
+                            my ($linkprot,$linkprotuser,$linkprotexit,$ltoken,$linkprotpbid,$linkprotpburl);
                             if ($env{'form.ttoken'}) {
                                 my %link_info = &Apache::lonnet::tmpget($env{'form.ttoken'});
                                 if ($link_info{'origurl'} eq $r->uri) {
@@ -78,6 +78,8 @@
                                         $linkprot = $ltoken_info{'linkprot'};
                                         $linkprotuser = $ltoken_info{'linkprotuser'};
                                         $linkprotexit = $ltoken_info{'linkprotexit'};
+                                        $linkprotpbid = $ltoken_info{'linkprotpbid'};
+                                        $linkprotpbid = $ltoken_info{'linkprotpburl'};
                                     } elsif ($link_info{'linkprot'}) {
                                         $linkprot = $link_info{'linkprot'};
                                         if ($link_info{'linkprotuser'}) {
@@ -86,6 +88,12 @@
                                         if ($link_info{'linkprotexit'}) {
                                             $linkprotexit = $link_info{'linkprotexit'};
                                         }
+                                        if ($link_info{'linkprotpbid'}) {
+                                            $linkprotpbid = $link_info{'linkprotpbid'};
+                                        }
+                                        if ($link_info{'linkprotpburl'}) {
+                                            $linkprotpburl = $link_info{'linkprotpburl'};
+                                        }
                                     }
                                 }
                             }
@@ -247,7 +255,8 @@
                                     }
                                 }
                                 if (@allposs == 0) {
-                                    &show_roles($r,\%crsenv,\%active,'','',\%future,\%expired,$linkprot,$linkprotuser,$linkprotexit,$ltoken);
+                                    &show_roles($r,\%crsenv,\%active,'','',\%future,\%expired,$linkprot,$linkprotuser,
+                                                $linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken);
                                 } elsif (@allposs == 1) {
                                     my $newrole = "$allposs[0]./$cdom/$cnum";
                                     $newrole = "$allposs[0]./$cdom/$cnum";
@@ -299,7 +308,7 @@
 
 sub launch_check {
     my ($linkuri,$symb) = @_;
-    my ($linkprotector,$linkproturi,$linkprotexit,$linkkey,$newlauncher);
+    my ($linkprotector,$linkproturi,$linkprotexit,$linkprotpbid,$linkprotpburl,$linkkey,$newlauncher);
     if ($env{'form.ttoken'}) {
         my %link_info = &Apache::lonnet::tmpget($env{'form.ttoken'});
         &Apache::lonnet::tmpdel($env{'form.ttoken'});
@@ -340,6 +349,12 @@
             if ($link_info{'linkprotexit'}) {
                 $linkprotexit = $link_info{'linkprotexit'};
             }
+            if ($link_info{'linkprotpbid'}) {
+                $linkprotpbid = $link_info{'linkprotpbid'};
+            }
+            if ($link_info{'linkprotpburl'}) {
+                $linkprotpburl = $link_info{'linkprotpburl'};
+            }
         } elsif ($link_info{'linkkey'} ne '') {
             $linkkey = $link_info{'linkkey'};
             my $keyedlinkuri = $linkuri;
@@ -413,6 +428,12 @@
                 if ($env{'request.linkprotexit'} ne '') {
                     &Apache::lonnet::delenv('request.linkprotexit');
                 }
+                if ($env{'request.linkprotpbid'} ne '') {
+                    &Apache::lonnet::delenv('request.linkprotpbid');
+                }
+                if ($env{'request.linkprotpburl'} ne '') {
+                    &Apache::lonnet::delenv('request.linkprotpburl');
+                }
             }
         } else {
             unless ($currdeeplinklogin eq $linkuri) {
@@ -427,6 +448,16 @@
                     } elsif ($env{'request.linkprotexit'}) {
                         &Apache::lonnet::delenv('request.linkprotexit');
                     }
+                    if ($linkprotpbid) {
+                        &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
+                    } elsif ($env{'request.linkprotpbid'}) {
+                        &Apache::lonnet::delenv('request.linkprotpbid');
+                    }
+                    if ($linkprotpburl) {
+                        &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
+                    } elsif ($env{'request.linkprotpburl'}) {
+                        &Apache::lonnet::delenv('request.linkprotpburl');
+                    }
                     if ($linkkey ne '') {
                         &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
                     } elsif ($env{'request.linkkey'} ne '') {
@@ -453,6 +484,16 @@
         } elsif ($env{'request.linkprotexit'}) {
             &Apache::lonnet::delenv('request.linkprotexit');
         }
+        if ($linkprotpbid) {
+            &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
+        } elsif ($env{'request.linkprotpbid'}) {
+            &Apache::lonnet::delenv('request.linkprotpbid');
+        }
+        if ($linkprotpburl) {
+            &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
+        } elsif ($env{'request.linkprotpburl'}) {
+            &Apache::lonnet::delenv('request.linkprotpburl');
+        }
         if ($linkkey ne '') {
             &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
         } else {
@@ -495,7 +536,8 @@
 }
 
 sub show_roles {
-    my ($r,$crsenv,$possroles,$hassection,$hascustom,$futureroles,$expiredroles,$linkprot,$linkprotuser,$linkprotexit,$ltoken) = @_;
+    my ($r,$crsenv,$possroles,$hassection,$hascustom,$futureroles,$expiredroles,
+        $linkprot,$linkprotuser,$linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken) = @_;
     my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
     if (ref($crsenv) eq 'HASH') {
         $crsdesc = $crsenv->{'description'};
@@ -636,6 +678,8 @@
                                 origurl => $r->uri,
                                 linkprot => $linkprot,
                                 linkprotexit => $linkprotexit,
+                                linkprotpbid => $linkprotpbid,
+                                linkprotpburl => $linkprotpburl,
                     );
                     my $token =
                         &Apache::lonnet::tmpput(\%data,$r->dir_config('lonHostID'),'retry');
Index: loncom/homework/lonhomework.pm
diff -u loncom/homework/lonhomework.pm:1.375 loncom/homework/lonhomework.pm:1.376
--- loncom/homework/lonhomework.pm:1.375	Sun Apr  2 03:16:28 2023
+++ loncom/homework/lonhomework.pm	Fri Jun  2 01:20:27 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # The LON-CAPA Homework handler
 #
-# $Id: lonhomework.pm,v 1.375 2023/04/02 03:16:28 raeburn Exp $
+# $Id: lonhomework.pm,v 1.376 2023/06/02 01:20:27 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1930,17 +1930,19 @@
             if (ref($item) eq 'HASH') {
                 if ((ref($item->{'lti'}) eq 'HASH') && ($item->{'cid'} =~ /^($match_domain)_($match_courseid)$/)) {
                     my ($cdom,$cnum) = ($1,$2);
-                    my $ckey = $item->{'lti'}->{'key'};
-                    my $secret = $item->{'lti'}->{'secret'};
                     my $msgformat = $item->{'lti'}->{'passbackformat'};
                     my $sigmethod = 'HMAC-SHA1';
+                    my $ltinum = $item->{'ltinum'};
                     my $id = $item->{'pbid'};
                     my $url = $item->{'pburl'};
+                    my $type = $item->{'pbtype'};
                     my $scope = $item->{'scope'};
                     my $map = $item->{'ltimap'};
                     my $symb = $item->{'ltisymb'};
                     my $uname = $item->{'uname'};
                     my $udom = $item->{'udom'};
+                    my $keynum = $item->{'lti'}->{'cipher'};
+                    my $crsdef = $item->{'crsdef'};
                     my $scoretype = $item->{'format'};
                     my ($total,$possible);
                     if ($scope eq 'resource') {
@@ -1951,9 +1953,8 @@
                     } elsif ($scope eq 'course') {
                         ($total,$possible) = &get_lti_score($uname,$udom);
                     }
-                    if (($ckey ne '') && ($secret ne '') && ($id ne '') && ($url ne '') && ($possible)) {
-                        &LONCAPA::ltiutils::send_grade($id,$url,$ckey,$secret,$scoretype,$sigmethod,
-                                                       $msgformat,$total,$possible);
+                    if (($id ne '') && ($url ne '') && ($possible)) {
+                        &LONCAPA::ltiutils::send_grade($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,$url,$scoretype,$sigmethod,$msgformat,$total,$possible);
                     }
                 }
             }
Index: loncom/homework/structuretags.pm
diff -u loncom/homework/structuretags.pm:1.574 loncom/homework/structuretags.pm:1.575
--- loncom/homework/structuretags.pm:1.574	Sun Apr  2 03:16:28 2023
+++ loncom/homework/structuretags.pm	Fri Jun  2 01:20:27 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA 
 # definition of tags that give a structure to a document
 #
-# $Id: structuretags.pm,v 1.574 2023/04/02 03:16:28 raeburn Exp $
+# $Id: structuretags.pm,v 1.575 2023/06/02 01:20:27 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -62,6 +62,7 @@
 use Apache::londefdef;
 use Apache::lonenc();
 use Apache::loncommon();
+use Apache::lonnavmaps;
 use Time::HiRes qw( gettimeofday tv_interval );
 use HTML::Entities();
 use lib '/home/httpd/lib/perl/';
@@ -1149,7 +1150,8 @@
 	delete(@Apache::lonhomework::results{@remove});
 	my ($symb,$courseid,$domain,$name) = 
 	    &Apache::lonnet::whichuser($given_symb);
-        my ($passback,$ltiscope,$ltimap,$ltisymb,$ltiref,$total,$possible,$dopassback);
+        my ($passback,$pbscope,$pbmap,$pbsymb,$pbtype,$crsdef,$ltinum,
+            $ltiref,$total,$possible,$dopassback);
 	if ($env{'request.state'} eq 'construct' 
 	    || $symb eq ''
 	    || $Apache::lonhomework::type eq 'practice') {
@@ -1163,11 +1165,16 @@
             if (($env{'user.name'} eq $name) && ($env{'user.domain'} eq $domain) &&
                 (!$Apache::lonhomework::scantronmode) && (!defined($env{'form.grade_symb'})) &&
                 (!defined($env{'form.grade_courseid'}))) {
-                if ($env{'request.lti.login'}) {
+                if (($env{'request.lti.login'}) || ($env{'request.deeplink.login'})) {
                     my ($map)=&Apache::lonnet::decode_symb($symb);
                     $map = &Apache::lonnet::clutter($map);
-                    ($passback,$ltiscope,$ltimap,$ltisymb,$ltiref) = 
-                        &needs_lti_passback($courseid,$symb,$map);
+                    if ($env{'request.lti.login'}) {
+                        ($passback,$pbscope,$pbmap,$pbsymb,$ltinum,$ltiref) = 
+                            &needs_lti_passback($courseid,$symb,$map);
+                    } elsif ($env{'request.deeplink.login'}) {
+                        ($passback,$pbscope,$pbmap,$pbsymb,$crsdef,$ltinum,$ltiref) =
+                            &needs_linkprot_passback($courseid,$symb,$map);
+                    }
                 }
                 if ($Apache::lonhomework::history{'version'}) {
                     $laststore = $Apache::lonhomework::history{'version'}.'='.
@@ -1264,7 +1271,7 @@
                     }
                 }
             }
-            if (($dopassback) && ($ltiscope eq 'resource') && ($ltisymb eq $symb)) {
+            if (($dopassback) && ($pbscope eq 'resource') && ($pbsymb eq $symb)) {
                 $total = 0;
                 $possible = 0;
                 my $navmap = Apache::lonnavmaps::navmap->new();
@@ -1305,24 +1312,39 @@
             &store_aggregates($symb,$courseid);
             if ($dopassback) {
                 my $scoreformat = 'decimal';
-                if (ref($ltiref) eq 'HASH') {
-                    if ($ltiref->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) {
-                        $scoreformat = $1;
+                if (($env{'request.lti.login'}) || ($env{'request.deeplink.login'})) {
+                    if (ref($ltiref) eq 'HASH') {
+                        if ($ltiref->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) {
+                            $scoreformat = $1;
+                        }
                     }
                 }
+                my ($pbid,$pburl,$pbtype);
+                if ($env{'request.lti.login'}) {
+                    $pbid = $env{'request.lti.passbackid'};
+                    $pburl = $env{'request.lti.passbackurl'};
+                    $pbtype = 'lti';
+                } elsif ($env{'request.deeplink.login'}) {
+                    $pbid = $env{'request.linkprotpbid'};
+                    $pburl = $env{'request.linkprotpburl'};
+                    $pbtype = 'linkprot';
+                }
                 my $ltigrade = {
+                                 'ltinum'   => $ltinum,
                                  'lti'      => $ltiref,
+                                 'crsdef'   => $crsdef,
                                  'cid'      => $courseid,
                                  'uname'    => $env{'user.name'},
                                  'udom'     => $env{'user.domain'},
-                                 'pbid'     => $env{'request.lti.passbackid'},
-                                 'pburl'    => $env{'request.lti.passbackurl'},
-                                 'scope'    => $ltiscope,
-                                 'ltimap'   => $ltimap,
-                                 'ltisymb'  => $ltisymb,
+                                 'pbid'     => $pbid,
+                                 'pburl'    => $pburl,
+                                 'pbtype'   => $pbtype,
+                                 'scope'    => $pbscope,
+                                 'pbmap'    => $pbmap,
+                                 'pbsymb'   => $pbsymb,
                                  'format'   => $scoreformat,
                                };
-                if ($ltiscope eq 'resource') {
+                if ($pbscope eq 'resource') {
                     $ltigrade->{'total'} = $total;
                     $ltigrade->{'possible'} = $possible;
                 }
@@ -1343,6 +1365,7 @@
             my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
             if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
                 if ($lti{$env{'request.lti.login'}}{'passback'}) {
+                    my $itemnum = $env{'request.lti.login'};
                     my ($ltiscope,$ltiuri,$ltisymb) =
                         &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
                                                                $cdom,$cnum,1);
@@ -1361,7 +1384,7 @@
                             $passback = 1;
                         }
                     }
-                    return ($passback,$ltiscope,$ltimap,$ltisymb,$lti{$env{'request.lti.login'}});
+                    return ($passback,$ltiscope,$ltimap,$ltisymb,$itemnum,$lti{$itemnum});
                 }
             }
         }
@@ -1369,6 +1392,59 @@
     return;
 }
 
+sub needs_linkprot_passback {
+    my ($courseid,$symb,$map) = @_;
+    if (($env{'request.linkprotpbid'}) && ($env{'request.linkprotpburl'})) {
+        if ($courseid =~ /^($LONCAPA::match_domain)_($LONCAPA::match_courseid)$/) {
+            my ($cdom,$cnum) = ($1,$2);
+            my ($deeplink_symb,$deeplink_map,$deeplink,$passback);
+            $deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom);
+            if ($deeplink_symb) {
+                if ($deeplink_symb =~ /\.(page|sequence)$/) {
+                    $deeplink_map = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
+                    my $navmap = Apache::lonnavmaps::navmap->new();
+                    if (ref($navmap)) {
+                        $deeplink = $navmap->get_mapparam(undef,$deeplink_map,'0.deeplink');
+                    }
+                } else {
+                    $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
+                    $deeplink_map = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[0]);
+                }
+                if (($deeplink ne '') && ($env{'request.linkprot'} ne '')) {
+                    my ($itemid,$tinyurl) = split(/:/,$env{'request.linkprot'});
+                    if ($itemid =~ /^(\d+)(c|d)$/) {
+                        my ($itemnum,$itemtype) = ($1,$2);
+                        my ($crsdef,$lti_in_use);
+                        if ($itemtype eq 'c') {
+                            $crsdef = 1;
+                            my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
+                            $lti_in_use = $crslti{$itemnum};
+                        } else {
+                            my %domlti = &Apache::lonnet::get_domain_lti($cdom,'linkprot');
+                            $lti_in_use = $domlti{$itemnum};
+                        }
+                        my ($state,$others,$listed,$scope,$protect,$display,$target,$exit) = split(/,/,$deeplink);
+                        my $passback;
+                        if ($scope eq 'resource') {
+                            if ($deeplink_symb eq $symb) {
+                                $passback = 1;
+                            }
+                        } elsif ($scope eq 'map') {
+                            if (&Apache::lonnet::clutter($deeplink_map) eq $map) {
+                                $passback = 1;
+                            }
+                        } elsif ($scope eq 'recurse') {
+#FIXME check if $deeplink_map contains $map
+                            $passback = 1;
+                        }
+                        return ($passback,$scope,$deeplink_map,$deeplink_symb,$crsdef,$itemnum,$lti_in_use);
+                    }
+                }
+            }
+        }
+    }
+}
+
 =pod
 
 =item check_correctness_changes()
Index: loncom/lti/ltiutils.pm
diff -u loncom/lti/ltiutils.pm:1.18 loncom/lti/ltiutils.pm:1.19
--- loncom/lti/ltiutils.pm:1.18	Tue Mar 29 20:12:46 2022
+++ loncom/lti/ltiutils.pm	Fri Jun  2 01:20:28 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Utility functions for managing LON-CAPA LTI interactions 
 #
-# $Id: ltiutils.pm,v 1.18 2022/03/29 20:12:46 raeburn Exp $
+# $Id: ltiutils.pm,v 1.19 2023/06/02 01:20:28 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -42,6 +42,7 @@
 use Apache::longroup();
 use Apache::lonlocal;
 use Math::Round();
+use LONCAPA::Lond;
 use LONCAPA qw(:DEFAULT :match);
 
 #
@@ -210,11 +211,30 @@
         %{$toolsettings}=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);
         if ($toolsettings->{'id'}) {
             my $idx = $toolsettings->{'id'};
-            my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer');
-            if (ref($lti{$idx}) eq 'HASH') {
-                %{$ltitools} = %{$lti{$idx}};
-                if ($ltitools->{'key'} eq $key) {
-                    $consumer_secret = $ltitools->{'secret'};
+            my ($crsdef,$ltinum);
+            if ($idx =~ /^c(\d+)$/) {
+                $ltinum = $1;
+                $crsdef = 1;
+                my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'consumer');
+                if (ref($crslti{$ltinum}) eq 'HASH') {
+                    %{$ltitools} = %{$crslti{$ltinum}};
+                } else {
+                    undef($ltinum);
+                }
+            } elsif ($idx =~ /^\d+$/) {
+                my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer');
+                if (ref($lti{$idx}) eq 'HASH') {
+                    %{$ltitools} = %{$lti{$idx}};
+                    $ltinum = $idx;
+                }
+            }
+            if ($ltinum ne '') {
+                my $loncaparev = &Apache::lonnet::get_server_loncaparev($cdom);
+                my $keynum = $ltitools->{'cipher'};
+                my ($poss_key,$poss_secret) =
+                    &LONCAPA::Lond::get_lti_credentials($cdom,$cnum,$crsdef,'tools',$ltinum,$keynum,$loncaparev);
+                if ($poss_key eq $key) {
+                    $consumer_secret = $poss_secret;
                     $nonce_lifetime = $ltitools->{'lifetime'};
                 } else {
                     $errors->{11} = 1;
@@ -242,6 +262,8 @@
 # secret for the specific LTI Provider.
 #
 
+# FIXME Move to Lond.pm and perform on course's homeserver
+
 sub verify_request {
     my ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params,
         $authheaders,$errors) = @_;
@@ -653,14 +675,16 @@
 #
 
 sub get_roster {
-    my ($id,$url,$ckey,$secret) = @_;
+    my ($cdom,$cnum,$ltinum,$keynum,$id,$url) = @_;
     my %ltiparams = (
         lti_version                => 'LTI-1p0',
         lti_message_type           => 'basic-lis-readmembershipsforcontext',
         ext_ims_lis_memberships_id => $id,
     );
-    my $hashref = &sign_params($url,$ckey,$secret,\%ltiparams);
-    if (ref($hashref) eq 'HASH') {
+    my %info = ();
+    my ($status,$hashref) =
+        &Apache::lonnet::sign_lti($cdom,$cnum,'','lti','roster',$url,$ltinum,$keynum,\%ltiparams,\%info);
+    if (($status eq 'ok') && (ref($hashref) eq 'HASH')) {
         my $request=new HTTP::Request('POST',$url);
         $request->content(join('&',map {
                           my $name = escape($_);
@@ -718,7 +742,7 @@
 #
 
 sub send_grade {
-    my ($id,$url,$ckey,$secret,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_;
+    my ($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,$url,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_;
     my $score;
     if ($possible > 0) {
         if ($scoretype eq 'ratio') {
@@ -747,8 +771,13 @@
             result_statusofresult         => 'final',
             result_date                   => $date,
         );
-        my $hashref = &sign_params($url,$ckey,$secret,\%ltiparams,$sigmethod);
-        if (ref($hashref) eq 'HASH') {
+        my %info = (
+                        method => $sigmethod,
+                   ); 
+        my ($status,$hashref) =
+            &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,
+                                      \%ltiparams,\%info);   
+        if (($status eq 'ok') && (ref($hashref) eq 'HASH')) {
             $request=new HTTP::Request('POST',$url);
             $request->content(join('&',map {
                               my $name = escape($_);
@@ -756,10 +785,10 @@
                               ? join("&$name=", map {escape($_) } @{$hashref->{$_}})
                               : &escape($hashref->{$_}) );
                               } keys(%{$hashref})));
+#FIXME Need to handle case where passback failed.
         }
     } 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"?>
@@ -792,35 +821,36 @@
         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->add_required_message_params('body_hash');
-        $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;
+        my $reqmethod = 'POST';
+        my %info = (
+                      body_hash => $bodyhash,
+                      method => $sigmethod,
+                      reqtype => 'consumer',
+                      reqmethod => $reqmethod,
+                      respfmt => 'to_authorization_header',
+                   );
+        my %params;
+        my ($status,$authheader) =
+            &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,\%params,\%info);
+        if (($status eq 'ok') && ($authheader ne '')) {
+            $request = HTTP::Request->new(
+	                   $reqmethod,
+	                   $url,
+	                   [
+		              'Authorization' => $authheader,
+		              '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.
+        }
+    }
 }
 
 sub setup_logout_callback {
-    my ($uname,$udom,$server,$ckey,$secret,$service_url,$idsdir,$protocol,$hostname) = @_;
+    my ($cdom,$cnum,$crstool,$idx,$keynum,$uname,$udom,$server,$service_url,$idsdir,$protocol,$hostname) = @_;
     if ($service_url =~ m{^https?://[^/]+/}) {
         my $digest_user = &Encode::decode('UTF-8',$uname.':'.$udom);
         my $loginfile = &Digest::SHA::sha1_hex($digest_user).&md5_hex(&md5_hex(time.{}.rand().$$));
@@ -831,11 +861,17 @@
             my %ltiparams = (
                 callback   => $callback,
             );
-            my $post = &sign_params($service_url,$ckey,$secret,\%ltiparams,
-                                    '','','',1);
-            my $request=new HTTP::Request('POST',$service_url);
-            $request->content($post);
-            my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
+            my %info = (
+                respfmt => 'to_post_body',
+            );
+            my ($status,$post) = 
+                &Apache::lonnet::sign_lti($cdom,$cnum,$crstool,'lti','logout',$service_url,$idx,
+                                          $keynum,\%ltiparams,\%info);
+            if (($status eq 'ok') && ($post ne '')) {
+                my $request=new HTTP::Request('POST',$service_url);
+                $request->content($post);
+                my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
+            }
         }
     }
     return;
@@ -1066,20 +1102,21 @@
 
 sub batchaddroster {
     my ($item) = @_;
-    return unless(ref($item) eq 'HASH');
-    return unless (ref($item->{'ltiref'}) eq 'HASH');
+    return unless((ref($item) eq 'HASH') &&
+                  (ref($item->{'ltiref'}) eq 'HASH'));
     my ($cdom,$cnum) = split(/_/,$item->{'cid'});
+    return if (($cdom eq '') || ($cnum eq ''));
     my $udom = $cdom;
     my $id = $item->{'id'};
     my $url = $item->{'url'};
+    my $ltinum = $item->{'lti'};
+    my $keynum = $item->{'ltiref'}->{'cipher'};
     my @intdoms;
     my $intdomsref = $item->{'intdoms'};
     if (ref($intdomsref) eq 'ARRAY') {
         @intdoms = @{$intdomsref};
     }
     my $uriscope = $item->{'uriscope'};
-    my $ckey = $item->{'ltiref'}->{'key'};
-    my $secret = $item->{'ltiref'}->{'secret'};
     my $section = $item->{'ltiref'}->{'section'};
     $section =~ s/\W//g;
     if ($section eq 'none') {
@@ -1098,8 +1135,8 @@
     if (ref($item->{'possroles'}) eq 'ARRAY') {
         @possroles = @{$item->{'possroles'}};
     }
-    if (($ckey ne '') && ($secret ne '') && ($id ne '') && ($url ne '')) {
-        my %data = &get_roster($id,$url,$ckey,$secret);
+    if (($id ne '') && ($url ne '')) {
+        my %data = &get_roster($cdom,$cnum,$ltinum,$keynum,$id,$url);
         if (keys(%data) > 0) {
             my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info);
             my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
Index: loncom/lti/ltiauth.pm
diff -u loncom/lti/ltiauth.pm:1.41 loncom/lti/ltiauth.pm:1.42
--- loncom/lti/ltiauth.pm:1.41	Wed May 24 14:55:57 2023
+++ loncom/lti/ltiauth.pm	Fri Jun  2 01:20:28 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Basic LTI Authentication Module
 #
-# $Id: ltiauth.pm,v 1.41 2023/05/24 14:55:57 raeburn Exp $
+# $Id: ltiauth.pm,v 1.42 2023/06/02 01:20:28 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -183,6 +183,13 @@
                                 $exiturl = $params->{'custom_'.$lti_in_use{'returnurl'}};
                             }
                         }
+                        my ($pbid,$pburl);
+                        if ($params->{'lis_result_sourcedid'}) {
+                            $pbid = $params->{'lis_result_sourcedid'};
+                        }
+                        if ($params->{'lis_outcome_service_url'}) {
+                            $pburl = $params->{'lis_outcome_service_url'};
+                        }
                         if (($itemid) && ($lti_in_use{'requser'})) {
                             my %courseinfo = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                             my $ltiauth;
@@ -233,7 +240,8 @@
                                                 foreach my $key (%{$params}) {
                                                     delete($env{'form.'.$key});
                                                 }
-                                                &linkprot_session($r,$uname,$cnum,$cdom,$uhome,$itemid,$ltitype,$tail,$lonhost,$exiturl);
+                                                &linkprot_session($r,$uname,$cnum,$cdom,$uhome,$itemid,$ltitype,
+                                                                  $tail,$lonhost,$exiturl,$pbid,$pburl);
                                                 return OK;
                                             }
                                         }
@@ -259,6 +267,12 @@
                             if ($exiturl ne '') {
                                 $info{'linkprotexit'} = $exiturl; 
                             }
+                            if ($pbid ne '') {
+                                $info{'linkprotpbid'} = $pbid;
+                            }
+                            if ($pburl ne '') {
+                                $info{'linkprotpburl'} = $pburl;
+                            }
                             my $ltoken = &Apache::lonnet::tmpput(\%info,$lonhost,'link');
                             if (($ltoken eq 'con_lost') || ($ltoken eq 'refused') || ($ltoken =~ /^error:/) ||
                                 ($ltoken eq 'unknown_cmd') || ($ltoken eq 'no_such_host') ||
@@ -442,7 +456,7 @@
 #
 
     my %lti;
-    my $itemid = &get_lti_itemid($requri,$hostname,$params,$cdom);
+    my $itemid = &get_lti_itemid($requri,$hostname,$params,$cdom,'','provider');
     if ($itemid) {
         %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
     }
@@ -923,9 +937,8 @@
         # login but immediately go to switch server.
         &Apache::lonauth::success($r,$uname,$udom,$uhome,'noredirect');
         if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
-            &LONCAPA::ltiutils::setup_logout_callback($uname,$udom,$otherserver,
-                                                      $ltihash->{'key'},
-                                                      $ltihash->{'secret'},
+            &LONCAPA::ltiutils::setup_logout_callback($cdom,$cnum,'',$itemid,$ltihash->{'cipher'},
+                                                      $uname,$udom,$otherserver,
                                                       $params->{$ltihash->{'callback'}},
                                                       $r->dir_config('ltiIDsDir'),
                                                       $protocol,$r->hostname);
@@ -998,9 +1011,8 @@
             delete($env{'form.'.$key});
         }
         if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
-            &LONCAPA::ltiutils::setup_logout_callback($uname,$udom,$lonhost,
-                                                      $ltihash->{'key'},
-                                                      $ltihash->{'secret'},
+            &LONCAPA::ltiutils::setup_logout_callback($cdom,$cnum,'',$itemid,$ltihash->{'cipher'},
+                                                      $uname,$udom,$lonhost,
                                                       $params->{$ltihash->{'callback'}},
                                                       $r->dir_config('ltiIDsDir'),
                                                       $protocol,$r->hostname);
@@ -1072,7 +1084,7 @@
 }
 
 sub linkprot_session {
-    my ($r,$uname,$cnum,$cdom,$uhome,$itemid,$ltitype,$dest,$lonhost,$exiturl) = @_;
+    my ($r,$uname,$cnum,$cdom,$uhome,$itemid,$ltitype,$dest,$lonhost,$exiturl,$pbid,$pburl) = @_;
     $r->user($uname);
     if ($ltitype eq 'c') {
         &Apache::lonnet::logthis("Course Link Protector ($itemid) authorized student: $uname:$cdom, course: $cdom\_$cnum");
@@ -1090,6 +1102,12 @@
         if ($exiturl ne '') {
             $env{'request.linkprotexit'} = $exiturl;
         }
+        if ($pbid ne '') {
+            $env{'request.linkprotpbid'} = $pbid;
+        }
+        if ($pburl ne '') {
+            $env{'request.linkprotpburl'} = $pburl;
+        }
         my $redirecturl = '/adm/switchserver';
         if ($otherserver ne '') {
             $redirecturl .= '?otherserver='.$otherserver;
@@ -1109,6 +1127,12 @@
                   'origurl'        => $dest,
                   'deeplink.login' => $dest,
                  );
+        if ($pbid ne '') {
+            $info{'linkprotpbid'} = $pbid;
+        }
+        if ($pburl ne '') {
+            $info{'linkprotpburl'} = $pburl;
+        }
         if ($exiturl ne '') {
             $info{'linkprotexit'} = $exiturl; 
         }
Index: loncom/lontrans.pm
diff -u loncom/lontrans.pm:1.40 loncom/lontrans.pm:1.41
--- loncom/lontrans.pm:1.40	Thu Jun 30 21:04:15 2022
+++ loncom/lontrans.pm	Fri Jun  2 01:20:28 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # URL translation for User Files
 #
-# $Id: lontrans.pm,v 1.40 2022/06/30 21:04:15 raeburn Exp $
+# $Id: lontrans.pm,v 1.41 2023/06/02 01:20:28 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -40,6 +40,10 @@
     # FIXME line remove when mod_perl fixes BUG#4948
     $r->notes->set('error-notes' => '');
     my $hdrhost = $r->headers_in->get('Host');
+    if (($r->uri eq '/adm/service/passback') ||
+        ($r->uri eq '/adm/service/roster')) {
+        return OK;
+    }
     if ($r->uri=~m{^/raw/}) {
         if ($hdrhost) {
             unless ($hdrhost =~ /^internal\-/) {
@@ -276,7 +280,7 @@
             my %link_info = &Apache::lonnet::tmpget($info{'ltoken'});
             if ($link_info{'linkprot'}) {
                 $info{'linkprot'} = $link_info{'linkprot'};
-                foreach my $item ('linkprotuser','linkprotexit') {
+                foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
                     if ($link_info{$item} ne '') {
                         $info{$item} = $link_info{$item};
                     }
Index: loncom/lond
diff -u loncom/lond:1.577 loncom/lond:1.578
--- loncom/lond:1.577	Mon May 22 21:10:56 2023
+++ loncom/lond	Fri Jun  2 01:20:28 2023
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.577 2023/05/22 21:10:56 raeburn Exp $
+# $Id: lond,v 1.578 2023/06/02 01:20:28 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -65,7 +65,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.577 $'; #' stupid emacs
+my $VERSION='$Revision: 1.578 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -5316,13 +5316,14 @@
 #   $cmd             - Command request keyword (signlti).
 #   $tail            - Tail of the command.  This is a colon-separated list
 #                      consisting of the domain, coursenum (if for an External
-#                      Tool defined in a course), crstool (true if defined in
-#                      a course), escaped launch URL, numeric ID of external tool
+#                      Tool defined in a course), crsdef (true if defined in
+#                      a course), context (launch, roster, logout, or grade),
+#                      escaped launch URL, numeric ID of external tool,
 #                      version number for encryption key (if tool's LTI secret was
-#                      encrypted before storing), post (true if signed data are
-#                      to be returned from Net::OAuth, as a post_body),
-#                      a frozen hash of LTI launch parameters, and a frozen hash
-#                      of LTI config data (i.e., method => signature method).
+#                      encrypted before storing), a frozen hash of LTI launch 
+#                      parameters, and a frozen hash of LTI information,
+#                      (e.g., method => 'HMAC-SHA1',
+#                             respfmt => 'to_authorization_header').
 #   $client          - File descriptor open on the client.
 # Returns:
 #   1       - Continue processing.
@@ -5331,7 +5332,7 @@
 #     The reply will contain the LTI payload, as & separated key=value pairs,
 #     where value is itself a frozen hash, if the required key and secret
 #     for the apecific tool ID are available. The payload data are retrived from
-#     a call to Lond::sign_params(), and the reply is encrypted before being
+#     a call to Lond::sign_lti_payload(), and the reply is encrypted before being
 #     written to $client.
 #
 sub sign_lti_handler {
@@ -5339,13 +5340,13 @@
 
     my $userinput = "$cmd:$tail";
 
-    my ($cdom,$cnum,$crstool,$escurl,$idx,$keynum,$post,$paramsref,$inforef) = split(/:/,$tail);
+    my ($cdom,$cnum,$crsdef,$context,$escurl,$ltinum,$keynum,$paramsref,$inforef) = split(/:/,$tail);
     my $url = &unescape($escurl);
     my $params = &Apache::lonnet::thaw_unescape($paramsref);
     my $info = &Apache::lonnet::thaw_unescape($inforef);
     my $res =
-        &LONCAPA::Lond::sign_params($cdom,$cnum,$crstool,$url,$idx,$keynum,
-                                    $post,$perlvar{'lonVersion'},$params,$info);
+        &LONCAPA::Lond::sign_lti_payload($cdom,$cnum,$crsdef,$context,$url,$ltinum,$keynum,
+                                         $perlvar{'lonVersion'},$params,$info);
     my $result;
     if (ref($res) eq 'HASH') {
         foreach my $key (keys(%{$res})) {
Index: loncom/Lond.pm
diff -u loncom/Lond.pm:1.22 loncom/Lond.pm:1.23
--- loncom/Lond.pm:1.22	Mon May 22 21:10:56 2023
+++ loncom/Lond.pm	Fri Jun  2 01:20:28 2023
@@ -1,6 +1,6 @@
 # The LearningOnline Network
 #
-# $Id: Lond.pm,v 1.22 2023/05/22 21:10:56 raeburn Exp $
+# $Id: Lond.pm,v 1.23 2023/06/02 01:20:28 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1197,6 +1197,9 @@
         $name = $context;
     } else {
         $name = 'lti';
+        if ($context eq '') {
+            $context = 'provider';
+        }
     }
     $cachename = $name.'enc';
     my %ltienc;
@@ -1257,10 +1260,10 @@
     return $itemid;
 }
 
-sub sign_params {
-    my ($cdom,$cnum,$crstool,$url,$idx,$keynum,$post,$loncaparev,$paramsref,$inforef) = @_;
+sub sign_lti_payload {
+    my ($cdom,$cnum,$crsdef,$type,$context,$url,$idx,$keynum,$loncaparev,$paramsref,$inforef) = @_;
     return unless (ref($paramsref) eq 'HASH');
-    my ($sigmethod,$type,$callback);
+    my ($sigmethod,$callback,$reqtype,$reqmethod,$respfmt,$bodyhash);
     if (ref($inforef) eq 'HASH') {
         if (exists($inforef->{'method'})) {
             $sigmethod = $inforef->{'method'};
@@ -1268,54 +1271,143 @@
         if (exists($inforef->{'cb'})) {
             $callback = $inforef->{'cb'};
         }
-        if (exists($inforef->{'type'})) {
-            $type = $inforef->{'type'};
+        if (exists($inforef->{'reqtype'})) {
+            $reqtype = $inforef->{'reqtype'};
+        }
+        if (exists($inforef->{'reqmethod'})) {
+            $reqmethod = $inforef->{'reqmethod'};
+        }
+        if (exists($inforef->{'body_hash'})) {
+            $bodyhash = $inforef->{'body_hash'};
         }
+        if (exists($inforef->{'respfmt'})) {
+            $respfmt = $inforef->{'respfmt'};
+        }
+    }
+    my ($key,$secret) = &get_lti_credentials($cdom,$cnum,$crsdef,$type,$idx,$keynum,$loncaparev);
+    return if (($key eq '') || ($secret eq ''));
+    if ($sigmethod eq '') {
+        $sigmethod = 'HMAC-SHA1';
+    }
+    if ($callback eq '') {
+        $callback = 'about:blank',
+    }
+    if ($reqtype eq '') {
+        $reqtype = 'request token';
     }
-    my ($cachename,$hashid,$key,$secret,%ltitoolsenc);
-    if ($crstool) {
-        $cachename = 'crsltitoolsenc';
+    if ($reqmethod eq '') {
+        $reqmethod = 'POST';
+    }
+    srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
+    my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
+    my $request;
+    if (($context eq 'grade') && ($reqtype eq 'consumer') && ($bodyhash ne '')) { 
+        $request = Net::OAuth->request($reqtype)->new(
+                           consumer_key => $key,
+                           consumer_secret => $secret,
+                           request_url => $url,
+                           request_method => $reqmethod,
+                           signature_method => $sigmethod,
+                           timestamp => time(),
+                           nonce => $nonce,
+                           body_hash => $bodyhash,
+        );
+        $request->add_required_message_params('body_hash');
+    } else {
+        $request = Net::OAuth->request($reqtype)->new(
+            consumer_key => $key,
+            consumer_secret => $secret,
+            request_url => $url,
+            request_method => 'POST',
+            signature_method => $sigmethod,
+            timestamp => time,
+            nonce => $nonce,
+            callback => $callback,
+            extra_params => $paramsref,
+            version      => '1.0',
+            );
+    }
+    $request->sign();
+    if ($respfmt eq 'to_post_body') {
+        return $request->to_post_body();
+    } elsif ($respfmt eq 'to_authorization_header') {
+        return $request->to_authorization_header();
+    } else {
+        return $request->to_hash();
+    }
+}
+
+sub get_lti_credentials {
+    my ($cdom,$cnum,$crsdef,$type,$idx,$keynum,$loncaparev) = @_;
+    my ($dbname,$name,$cachename,$hashid,$key,$secret,%ltienc);
+    if ($crsdef) {
         $hashid = $cdom.'_'.$cnum;
     } else {
-        $cachename = 'ltitoolsenc';
         $hashid = $cdom;
     }
+    if ($type eq 'tools') {
+        if ($crsdef) {
+            $dbname = 'nohist_toolsenc';
+            $cachename = 'crsltitoolsenc';
+        } else {
+            $name = 'ltitools';
+            $dbname = 'encconfig';
+            $cachename = 'ltitoolsenc';
+        }
+    } elsif ($type eq 'linkprot') {
+        if ($crsdef) {
+            $dbname = 'nohist_ltienc';
+            $cachename = 'courseltienc';
+        } else {
+            $name = 'linkprot';
+            $dbname = 'encconfig';
+            $cachename = 'linkprotenc';
+        }
+    } elsif ($type eq 'lti') {
+        $name = 'lti';
+        $dbname = 'encconfig';
+        $cachename = 'ltienc';
+    }
     my ($encresult,$enccached)=&Apache::lonnet::is_cached_new($cachename,$hashid);
     if (defined($enccached)) {
         if (ref($encresult) eq 'HASH') {
-            %ltitoolsenc = %{$encresult};
+            %ltienc = %{$encresult};
         }
     } else {
-        if ($crstool) {
-            my $reply = &dump_with_regexp(join(":",($cdom,$cnum,'nohist_toolsenc','','')),$loncaparev);
-            %ltitoolsenc = %{&Apache::lonnet::unserialize($reply)};
+        if ($crsdef) {
+            my $reply = &dump_with_regexp(join(":",($cdom,$cnum,$dbname,'','')),$loncaparev);
+            %ltienc = %{&Apache::lonnet::unserialize($reply)};
         } else {
-            my $reply = &get_dom("getdom:$cdom:encconfig:ltitools");
-            my $ltitoolsencref = &Apache::lonnet::thaw_unescape($reply);
-            if (ref($ltitoolsencref) eq 'HASH') {
-                %ltitoolsenc = %{$ltitoolsencref};
+            my $reply = &get_dom("getdom:$cdom:$dbname:$name");
+            my $encref = &Apache::lonnet::thaw_unescape($reply);
+            if (ref($encref) eq 'HASH') {
+                %ltienc = %{$encref};
             }
         }
         my $cachetime = 24*60*60;
-        &Apache::lonnet::do_cache_new($cachename,$hashid,\%ltitoolsenc,$cachetime);
+        &Apache::lonnet::do_cache_new($cachename,$hashid,\%ltienc,$cachetime);
     }
-    if (!keys(%ltitoolsenc)) {
-         return;
-    } elsif (exists($ltitoolsenc{$idx})) {
-        if (ref($ltitoolsenc{$idx}) eq 'HASH') {
-            if (exists($ltitoolsenc{$idx}{'key'})) {
-                $key = $ltitoolsenc{$idx}{'key'};
-            }
-            if (exists($ltitoolsenc{$idx}{'secret'})) {
-                $secret = $ltitoolsenc{$idx}{'secret'};
-                my $privhost;
+    if (!keys(%ltienc)) {
+         return ();
+    } elsif (exists($ltienc{$idx})) {
+        if (ref($ltienc{$idx}) eq 'HASH') {
+            if (exists($ltienc{$idx}{'key'})) {
+                $key = $ltienc{$idx}{'key'};
+            }
+            if (exists($ltienc{$idx}{'secret'})) {
+                $secret = $ltienc{$idx}{'secret'};
                 if ($keynum =~ /^\d+$/) {
-                    if ($crstool) {
+                    my $privhost;
+                    my $privname = 'ltitools';
+                    if (($type eq 'lti') || ($type eq 'linkprot')) {
+                        $privname = 'lti';
+                    }
+                    if ($crsdef) {
                         my $primary = &Apache::lonnet::domain($cdom,'primary');
                         my @ids = &Apache::lonnet::current_machine_ids();
                         unless (grep(/^\Q$primary\E$/, at ids)) {
                             $privhost = $primary;
-                            my ($result,$plainsecret) = &decrypt_secret($privhost,$secret,$keynum,'ltitools');
+                            my ($result,$plainsecret) = &decrypt_secret($privhost,$secret,$keynum,$privname);
                             if ($result eq 'ok') {
                                 $secret = $plainsecret;
                             } else {
@@ -1324,7 +1416,7 @@
                         }
                     }
                     unless ($privhost) {
-                        my $privkey = &get_dom("getdom:$cdom:private:$keynum:ltitools:key");
+                        my $privkey = &get_dom("getdom:$cdom:private:$keynum:$privname:key");
                         if (($privkey ne '') && ($secret ne '')) {
                             my $cipher = new Crypt::CBC($privkey);
                             $secret = $cipher->decrypt_hex($secret);
@@ -1336,36 +1428,7 @@
             }
         }
     }
-    return if (($key eq '') || ($secret eq ''));
-    if ($sigmethod eq '') {
-        $sigmethod = 'HMAC-SHA1';
-    }
-    if ($type eq '') {
-        $type = 'request token';
-    }
-    if ($callback eq '') {
-        $callback = 'about:blank',
-    }
-    srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
-    my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
-    my $request = Net::OAuth->request($type)->new(
-            consumer_key => $key,
-            consumer_secret => $secret,
-            request_url => $url,
-            request_method => 'POST',
-            signature_method => $sigmethod,
-            timestamp => time,
-            nonce => $nonce,
-            callback => $callback,
-            extra_params => $paramsref,
-            version      => '1.0',
-            );
-    $request->sign();
-    if ($post) {
-        return $request->to_post_body();
-    } else {
-        return $request->to_hash();
-    }
+    return ($key,$secret);
 }
 
 sub decrypt_secret {
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1510 loncom/lonnet/perl/lonnet.pm:1.1511
--- loncom/lonnet/perl/lonnet.pm:1.1510	Mon May 22 21:10:55 2023
+++ loncom/lonnet/perl/lonnet.pm	Fri Jun  2 01:20:29 2023
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1510 2023/05/22 21:10:55 raeburn Exp $
+# $Id: lonnet.pm,v 1.1511 2023/06/02 01:20:29 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -416,10 +416,10 @@
 }
 
 sub sign_lti {
-    my ($cdom,$cnum,$crstool,$url,$idx,$keynum,$post,$paramsref,$inforef) = @_;
+    my ($cdom,$cnum,$crsdef,$type,$context,$url,$ltinum,$keynum,$paramsref,$inforef) = @_;
     my $chome;
     if (&domain($cdom) ne '') {
-        if ($crstool) {
+        if ($crsdef) {
             $chome = &homeserver($cnum,$cdom);
         } else {
             $chome = &domain($cdom,'primary');
@@ -432,11 +432,11 @@
             if (grep { $_ eq $chome } &current_machine_ids()) {
                 # domain information is hosted on this machine
                 $rep =
-                    &LONCAPA::Lond::sign_params($cdom,$cnum,$crstool,$url,
-                                                $idx,$keynum,$post,
-                                                $perlvar{'lonVersion'},
-                                                $paramsref,$inforef);
-                if ($rep ne '') {
+                    &LONCAPA::Lond::sign_lti_payload($cdom,$cnum,$crsdef,$type,
+                                                     $context,$url,$ltinum,$keynum,
+                                                     $perlvar{'lonVersion'},
+                                                     $paramsref,$inforef);
+                if (ref($rep) eq 'HASH') {
                     return ('ok',$rep);
                 }
             } else {
@@ -448,10 +448,13 @@
                 if (ref($inforef) eq 'HASH') {
                     $info = &freeze_escape($inforef);
                 }
-                $rep=&reply("encrypt:signlti:$cdom:$cnum:$crstool:$escurl:$idx:$keynum:$post:$params:$info",$chome);
+                $rep=&reply("encrypt:signlti:$cdom:$cnum:$crsdef:$type:$context:$escurl:$ltinum:$keynum:$params:$info",$chome);
             }
             if (($rep eq '') || ($rep =~ /^con_lost|error|no_such_host|unknown_cmd/i)) {
                 return ();
+            } elsif (($inforef->{'respfmt'} eq 'to_post_body') ||
+                     ($inforef->{'respfmt'} eq 'to_authorization_header')) {
+                return ('ok',$rep);
             } else {
                 my %returnhash;
                 foreach my $item (split(/\&/,$rep)) {
@@ -12550,13 +12553,11 @@
     } else {
         return %lti;
     }
-
     if ($context eq 'linkprot') {
         $cachename = $context;
     } else {
         $cachename = $name;
     }
-    
     my ($result,$cached)=&is_cached_new($cachename,$cdom);
     if (defined($cached)) {
         if (ref($result) eq 'HASH') {
@@ -12572,18 +12573,6 @@
             } else {
                 %lti = %{$domconfig{$name}};
             }
-            if (($context eq 'consumer') && (keys(%lti))) {
-                my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1);
-                if (ref($encdomconfig{$name}) eq 'HASH') {
-                    foreach my $id (keys(%lti)) {
-                        if (ref($encdomconfig{$name}{$id}) eq 'HASH') {
-                            foreach my $item ('key','secret') {
-                                $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};
-                            }
-                        }
-                    }
-                }
-            }
         }
         my $cachetime = 24*60*60;
         &do_cache_new($cachename,$cdom,\%lti,$cachetime);


More information about the LON-CAPA-cvs mailing list