[LON-CAPA-cvs] cvs: loncom / Lond.pm lond /interface courseprefs.pm /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Tue Feb 15 19:06:12 EST 2022
raeburn Wed Feb 16 00:06:12 2022 EDT
Modified files:
/loncom/interface courseprefs.pm
/loncom Lond.pm lond
/loncom/lonnet/perl lonnet.pm
Log:
- Bug 6907
- Support encryption of link protection secrets set in a course.
- Requires perl-Crypt-CBC
-------------- next part --------------
Index: loncom/interface/courseprefs.pm
diff -u loncom/interface/courseprefs.pm:1.102 loncom/interface/courseprefs.pm:1.103
--- loncom/interface/courseprefs.pm:1.102 Tue Feb 15 04:28:01 2022
+++ loncom/interface/courseprefs.pm Wed Feb 16 00:06:04 2022
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set configuration settings for a course
#
-# $Id: courseprefs.pm,v 1.102 2022/02/15 04:28:01 raeburn Exp $
+# $Id: courseprefs.pm,v 1.103 2022/02/16 00:06:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -224,6 +224,7 @@
use Apache::courseclassifier;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);
+use Crypt::CBC;
my $registered_cleanup;
my $modified_courses;
@@ -1477,7 +1478,7 @@
sub process_linkprot {
my ($cdom,$cnum,$values,$changes,$context) = @_;
- my ($dest,$ltiauth,$errors,%linkprot);
+ my ($home,$dest,$ltiauth,$privkey,$privnum,$cipher,$errors,%linkprot);
if (ref($values) eq 'HASH') {
foreach my $id (keys(%{$values})) {
if ($id =~ /^\d+$/) {
@@ -1487,6 +1488,31 @@
}
}
}
+ my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
+ my @ids=&Apache::lonnet::current_machine_ids();
+ if ($context eq 'domain') {
+ $home = &Apache::lonnet::domain($cdom,'primary');
+ } else {
+ $home = &Apache::lonnet::homeserver($cnum,$cdom);
+ }
+ if ((($context eq 'domain') && ($domdefs{'linkprotenc_dom'})) ||
+ (($context eq 'course') && ($domdefs{'linkprotenc_crs'}))) {
+ unless (($home eq 'no_host') || ($home eq '')) {
+ if (grep(/^\Q$home\E$/, at ids)) {
+ if (ref($domdefs{'privhosts'}) eq 'ARRAY') {
+ if (grep(/^\Q$home\E$/,@{$domdefs{'privhosts'}})) {
+ my %privhash = &Apache::lonnet::restore_dom('lti','private',$cdom,$home,1);
+ $privkey = $privhash{'key'};
+ $privnum = $privhash{'version'};
+ if (($privnum) && ($privkey ne '')) {
+ $cipher = Crypt::CBC->new({'key' => $privkey,
+ 'cipher' => 'DES'});
+ }
+ }
+ }
+ }
+ }
+ }
if ($context eq 'domain') {
$dest = '/adm/domainprefs';
$ltiauth = 1;
@@ -1619,14 +1645,24 @@
if ($current{'usable'}) {
if ($env{'form.linkprot_changesecret_'.$idx}) {
if ($env{$secretitem} ne '') {
- $linkprot{$itemid}{'secret'} = $env{$secretitem};
+ if ($privnum && $cipher) {
+ $linkprot{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem});
+ $linkprot{$itemid}{'cipher'} = $privnum;
+ } else {
+ $linkprot{$itemid}{'secret'} = $env{$secretitem};
+ }
$haschanges{$itemid} = 1;
}
} else {
$linkprot{$itemid}{'secret'} = $current{'secret'};
}
} elsif ($env{$secretitem} ne '') {
- $linkprot{$itemid}{'secret'} = $env{$secretitem};
+ if ($privnum && $cipher) {
+ $linkprot{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem});
+ $linkprot{$itemid}{'cipher'} = $privnum;
+ } else {
+ $linkprot{$itemid}{'secret'} = $env{$secretitem};
+ }
$haschanges{$itemid} = 1;
}
}
@@ -2141,10 +2177,12 @@
sub store_linkprot {
my ($cdom,$cnum,$context,$changes,$oldlinkprot) = @_;
- my ($ltiauth,$lti_save_error,$output,$error,%ltienc, at deletions);
+ my ($ltiauth,$home,$lti_save_error,$output,$error,%ltienc, at deletions);
if ($context eq 'domain') {
$ltiauth = 1;
+ $home = &Apache::lonnet::domain($cdom,'primary');
} else {
+ $home = &Apache::lonnet::homeserver($cnum,$cdom);
if (exists($env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'})) {
$ltiauth = $env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'};
} else {
@@ -2170,7 +2208,6 @@
}
}
}
- my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
my @ids=&Apache::lonnet::current_machine_ids();
if (keys(%ltienc) > 0) {
if ($context eq 'domain') {
@@ -2180,7 +2217,7 @@
}
}
} else {
- unless (($chome eq 'no_host') || ($chome eq '')) {
+ unless (($home eq 'no_host') || ($home eq '')) {
my $allowed;
foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
if ($allowed) {
@@ -2202,8 +2239,8 @@
if (&Apache::lonnet::put('lti',$changes,$cdom,$cnum,1) eq 'ok') {
my $hashid=$cdom.'_'.$cnum;
&Apache::lonnet::devalidate_cache_new('courselti',$hashid);
- unless (($chome eq 'no_host') || ($chome eq '')) {
- if (grep(/^\Q$chome\E$/, at ids)) {
+ unless (($home eq 'no_host') || ($home eq '')) {
+ if (grep(/^\Q$home\E$/, at ids)) {
&Apache::lonnet::devalidate_cache_new('courseltienc',$hashid);
}
}
@@ -2223,7 +2260,7 @@
if (exists($ltienc{$id}{$title})) {
if ($title eq 'secret') {
my $length = length($ltienc{$id}{$title});
- $display .= $desc{$title}.': '.('*' x $length).', ';
+ $display .= $desc{$title}.': ['.&mt('not shown').'], ';
} else {
$display .= $desc{$title}.': '.$ltienc{$id}{$title}.', ';
}
Index: loncom/Lond.pm
diff -u loncom/Lond.pm:1.19 loncom/Lond.pm:1.20
--- loncom/Lond.pm:1.19 Mon Feb 14 02:48:49 2022
+++ loncom/Lond.pm Wed Feb 16 00:06:08 2022
@@ -1,6 +1,6 @@
# The LearningOnline Network
#
-# $Id: Lond.pm,v 1.19 2022/02/14 02:48:49 raeburn Exp $
+# $Id: Lond.pm,v 1.20 2022/02/16 00:06:08 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -42,6 +42,7 @@
use Crypt::X509::CRL;
use Crypt::PKCS10;
use Net::OAuth;
+use Crypt::CBC;
sub dump_with_regexp {
my ( $tail, $clientversion ) = @_;
@@ -1063,7 +1064,7 @@
$allkeys.='timestamp';
$hashref->{"$version:keys:$rid"}=$allkeys;
&untie_user_hash($hashref) or
- return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";
+ return "error: ".($!+0)." untie(GDBM) Failed while attempting $cmd";
return 'ok';
}
@@ -1140,9 +1141,22 @@
return if (!keys(%crslti_by_key));
+ my %courselti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
+
if (ref($crslti_by_key{$consumer_key}) eq 'ARRAY') {
foreach my $id (@{$crslti_by_key{$consumer_key}}) {
my $secret = $crslti{$id}{'secret'};
+ if (ref($courselti{$id}) eq 'HASH') {
+ if ((exists($courselti{$id}{'cipher'})) &&
+ ($courselti{$id}{'cipher'} =~ /^\d+$/)) {
+ my $keynum = $courselti{$id}{'cipher'};
+ my $privkey = &get_dom("getdom:$cdom:private:$keynum:lti:key");
+ if ($privkey ne '') {
+ my $cipher = new Crypt::CBC($privkey);
+ $secret = $cipher->decrypt_hex($secret);
+ }
+ }
+ }
my $request = Net::OAuth->request('request token')->from_hash($params,
request_url => $url,
request_method => $method,
Index: loncom/lond
diff -u loncom/lond:1.572 loncom/lond:1.573
--- loncom/lond:1.572 Tue Feb 1 23:13:21 2022
+++ loncom/lond Wed Feb 16 00:06:08 2022
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.572 2022/02/01 23:13:21 raeburn Exp $
+# $Id: lond,v 1.573 2022/02/16 00:06:08 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -65,7 +65,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.572 $'; #' stupid emacs
+my $VERSION='$Revision: 1.573 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -5142,7 +5142,7 @@
my $userinput = "$cmd:$tail";
my ($udom,$namespace,$what)=split(/:/,$tail,3);
- if ($namespace =~ /^enc/) {
+ if (($namespace =~ /^enc/) || ($namespace eq 'private')) {
&Failure( $client, "refused\n", $userinput);
} else {
my $res = LONCAPA::Lond::get_dom($userinput);
@@ -5181,23 +5181,28 @@
my $userinput = "$cmd:$tail";
- my $res = LONCAPA::Lond::get_dom($userinput);
- if ($res =~ /^error:/) {
- &Failure($client, \$res, $userinput);
+ my ($udom,$namespace,$what) = split(/:/,$tail,3);
+ if ($namespace eq 'private') {
+ &Failure( $client, "refused\n", $userinput);
} else {
- if ($cipher) {
- my $cmdlength=length($res);
- $res.=" ";
- my $encres='';
- for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
- $encres.= unpack("H16",
- $cipher->encrypt(substr($res,
- $encidx,
- 8)));
- }
- &Reply( $client,"enc:$cmdlength:$encres\n",$userinput);
+ my $res = LONCAPA::Lond::get_dom($userinput);
+ if ($res =~ /^error:/) {
+ &Failure($client, \$res, $userinput);
} else {
- &Failure( $client, "error:no_key\n",$userinput);
+ if ($cipher) {
+ my $cmdlength=length($res);
+ $res.=" ";
+ my $encres='';
+ for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
+ $encres.= unpack("H16",
+ $cipher->encrypt(substr($res,
+ $encidx,
+ 8)));
+ }
+ &Reply( $client,"enc:$cmdlength:$encres\n",$userinput);
+ } else {
+ &Failure( $client, "error:no_key\n",$userinput);
+ }
}
}
return 1;
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1481 loncom/lonnet/perl/lonnet.pm:1.1482
--- loncom/lonnet/perl/lonnet.pm:1.1481 Mon Feb 14 02:48:53 2022
+++ loncom/lonnet/perl/lonnet.pm Wed Feb 16 00:06:12 2022
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1481 2022/02/14 02:48:53 raeburn Exp $
+# $Id: lonnet.pm,v 1.1482 2022/02/16 00:06:12 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2263,7 +2263,7 @@
}
sub store_dom {
- my ($storehash,$id,$namespace,$dom,$home) = @_;
+ my ($storehash,$id,$namespace,$dom,$home,$encrypt) = @_;
$$storehash{'ip'}=&get_requestor_ip();
$$storehash{'host'}=$perlvar{'lonHostID'};
my $namevalue='';
@@ -2276,12 +2276,43 @@
} else {
if ($namespace eq 'private') {
return 'refused';
+ } elsif ($encrypt) {
+ return reply("encrypt:storedom:$dom:$namespace:$id:$namevalue",$home);
} else {
- return reply("storedom:$dom:$namespace:$id:$namevalue","$home");
+ return reply("storedom:$dom:$namespace:$id:$namevalue",$home);
}
}
}
+sub restore_dom {
+ my ($id,$namespace,$dom,$home,$encrypt) = @_;
+ my $answer;
+ if (grep { $_ eq $home } current_machine_ids()) {
+ $answer = LONCAPA::Lond::restore_dom("restoredom:$dom:$namespace:$id");
+ } elsif ($namespace ne 'private') {
+ if ($encrypt) {
+ $answer=&reply("encrypt:restoredom:$dom:$namespace:$id",$home);
+ } else {
+ $answer=&reply("restoredom:$dom:$namespace:$id",$home);
+ }
+ }
+ my %returnhash=();
+ unless (($answer eq '') || ($answer eq 'con_lost') || ($answer eq 'refused') ||
+ ($answer eq 'unknown_cmd') || ($answer eq 'rejected')) {
+ foreach my $line (split(/\&/,$answer)) {
+ my ($name,$value)=split(/\=/,$line);
+ $returnhash{&unescape($name)}=&thaw_unescape($value);
+ }
+ my $version;
+ for ($version=1;$version<=$returnhash{'version'};$version++) {
+ foreach my $item (split(/\:/,$returnhash{$version.':keys'})) {
+ $returnhash{$item}=$returnhash{$version.':'.$item};
+ }
+ }
+ }
+ return %returnhash;
+}
+
# ----------------------------------construct domainconfig user for a domain
sub get_domainconfiguser {
my ($udom) = @_;
@@ -2637,7 +2668,7 @@
'coursedefaults','usersessions',
'requestauthor','selfenrollment',
'coursecategories','ssl','autoenroll',
- 'trust','helpsettings','wafproxy'],$domain);
+ 'trust','helpsettings','wafproxy','ltisec'],$domain);
my @coursetypes = ('official','unofficial','community','textbook','placement');
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
@@ -2811,7 +2842,19 @@
$domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};
}
}
- }
+ }
+ if (ref($domconfig{'ltisec'}) eq 'HASH') {
+ if (ref($domconfig{'ltisec'}{'encrypt'}) eq 'HASH') {
+ $domdefaults{'linkprotenc_crs'} = $domconfig{'ltisec'}{'encrypt'}{'crs'};
+ $domdefaults{'linkprotenc_dom'} = $domconfig{'ltisec'}{'encrypt'}{'dom'};
+ $domdefaults{'ltienc_consumers'} = $domconfig{'ltisec'}{'encrypt'}{'consumers'};
+ }
+ if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') {
+ if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') {
+ $domdefaults{'privhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
+ }
+ }
+ }
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
return %domdefaults;
}
More information about the LON-CAPA-cvs
mailing list