version 1.564, 2020/10/22 19:23:22
|
version 1.569, 2021/10/26 15:52:55
|
Line 213 my %trust = (
|
Line 213 my %trust = (
|
autovalidateclass_sec => {catalog => 1}, |
autovalidateclass_sec => {catalog => 1}, |
autovalidatecourse => {remote => 1, enroll => 1}, |
autovalidatecourse => {remote => 1, enroll => 1}, |
autovalidateinstcode => {domroles => 1, remote => 1, enroll => 1}, |
autovalidateinstcode => {domroles => 1, remote => 1, enroll => 1}, |
|
autovalidateinstcrosslist => {remote => 1, enroll => 1}, |
|
autoinstsecreformat => {remote => 1, enroll => 1}, |
changeuserauth => {remote => 1, domroles => 1}, |
changeuserauth => {remote => 1, domroles => 1}, |
chatretr => {remote => 1, enroll => 1}, |
chatretr => {remote => 1, enroll => 1}, |
chatsend => {remote => 1, enroll => 1}, |
chatsend => {remote => 1, enroll => 1}, |
Line 237 my %trust = (
|
Line 239 my %trust = (
|
du2 => {remote => 1, enroll => 1}, |
du2 => {remote => 1, enroll => 1}, |
dump => {remote => 1, enroll => 1, domroles => 1}, |
dump => {remote => 1, enroll => 1, domroles => 1}, |
edit => {institutiononly => 1}, #not used currently |
edit => {institutiononly => 1}, #not used currently |
|
edump => {remote => 1, enroll => 1, domroles => 1}, |
eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently |
eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently |
egetdom => {remote => 1, domroles => 1, enroll => 1, }, |
egetdom => {remote => 1, domroles => 1, enroll => 1, }, |
ekey => {anywhere => 1}, |
ekey => {anywhere => 1}, |
Line 3827 sub dump_with_regexp {
|
Line 3830 sub dump_with_regexp {
|
} |
} |
®ister_handler("dump", \&dump_with_regexp, 0, 1, 0); |
®ister_handler("dump", \&dump_with_regexp, 0, 1, 0); |
|
|
|
# |
|
# Process the encrypted dump request. Original call should |
|
# be from lonnet::dump() with seventh arg ($encrypt) set to |
|
# 1, to ensure that both request and response are encrypted. |
|
# |
|
# Parameters: |
|
# $cmd - Command keyword of request (edump). |
|
# $tail - Tail of the command. |
|
# See &dump_with_regexp for more |
|
# information about this. |
|
# $client - File open on the client. |
|
# Returns: |
|
# 1 - Continue processing |
|
# 0 - server should exit. |
|
# |
|
|
|
sub encrypted_dump_with_regexp { |
|
my ($cmd, $tail, $client) = @_; |
|
my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientversion); |
|
|
|
if ($res =~ /^error:/) { |
|
Failure($client, \$res, "$cmd:$tail"); |
|
} 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","$cmd:$tail"); |
|
} else { |
|
&Failure( $client, "error:no_key\n","$cmd:$tail"); |
|
} |
|
} |
|
} |
|
®ister_handler("edump", \&encrypted_dump_with_regexp, 0, 1, 0); |
|
|
# Store a set of key=value pairs associated with a versioned name. |
# Store a set of key=value pairs associated with a versioned name. |
# |
# |
# Parameters: |
# Parameters: |
Line 5077 sub del_domain_handler {
|
Line 5121 sub del_domain_handler {
|
# domain directory. |
# domain directory. |
# |
# |
# Parameters: |
# Parameters: |
# $cmd - Command request keyword (get). |
# $cmd - Command request keyword (getdom). |
# $tail - Tail of the command. This is a colon separated list |
# $tail - Tail of the command. This is a colon separated list |
# consisting of the domain and the 'namespace' |
# consisting of the domain and the 'namespace' |
# which selects the gdbm file to do the lookup in, |
# which selects the gdbm file to do the lookup in, |
Line 5094 sub del_domain_handler {
|
Line 5138 sub del_domain_handler {
|
sub get_domain_handler { |
sub get_domain_handler { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
|
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$namespace,$what)=split(/:/,$tail,3); |
my ($udom,$namespace,$what)=split(/:/,$tail,3); |
chomp($what); |
|
if ($namespace =~ /^enc/) { |
if ($namespace =~ /^enc/) { |
&Failure( $client, "refused\n", $userinput); |
&Failure( $client, "refused\n", $userinput); |
} else { |
} else { |
my @queries=split(/\&/,$what); |
my $res = LONCAPA::Lond::get_dom($userinput); |
my $qresult=''; |
if ($res =~ /^error:/) { |
my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER()); |
&Failure($client, \$res, $userinput); |
if ($hashref) { |
|
for (my $i=0;$i<=$#queries;$i++) { |
|
$qresult.="$hashref->{$queries[$i]}&"; |
|
} |
|
if (&untie_domain_hash($hashref)) { |
|
$qresult=~s/\&$//; |
|
&Reply($client, \$qresult, $userinput); |
|
} else { |
|
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". |
|
"while attempting getdom\n",$userinput); |
|
} |
|
} else { |
} else { |
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
&Reply($client, \$res, $userinput); |
"while attempting getdom\n",$userinput); |
|
} |
} |
} |
} |
|
|
Line 5131 sub encrypted_get_domain_handler {
|
Line 5161 sub encrypted_get_domain_handler {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$namespace,$what)=split(/:/,$tail,3); |
my $res = LONCAPA::Lond::get_dom($userinput); |
chomp($what); |
if ($res =~ /^error:/) { |
my @queries=split(/\&/,$what); |
&Failure($client, \$res, $userinput); |
my $qresult=''; |
} else { |
my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER()); |
if ($cipher) { |
if ($hashref) { |
my $cmdlength=length($res); |
for (my $i=0;$i<=$#queries;$i++) { |
$res.=" "; |
$qresult.="$hashref->{$queries[$i]}&"; |
my $encres=''; |
} |
for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { |
if (&untie_domain_hash($hashref)) { |
$encres.= unpack("H16", |
$qresult=~s/\&$//; |
$cipher->encrypt(substr($res, |
if ($cipher) { |
$encidx, |
my $cmdlength=length($qresult); |
8))); |
$qresult.=" "; |
|
my $encqresult=''; |
|
for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { |
|
$encqresult.= unpack("H16", |
|
$cipher->encrypt(substr($qresult, |
|
$encidx, |
|
8))); |
|
} |
|
&Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput); |
|
} else { |
|
&Failure( $client, "error:no_key\n", $userinput); |
|
} |
} |
|
&Reply( $client,"enc:$cmdlength:$encres\n",$userinput); |
} else { |
} else { |
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". |
&Failure( $client, "error:no_key\n",$userinput); |
"while attempting egetdom\n",$userinput); |
|
} |
} |
} else { |
|
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting egetdom\n",$userinput); |
|
} |
} |
return 1; |
return 1; |
} |
} |
Line 5593 sub tmp_put_handler {
|
Line 5609 sub tmp_put_handler {
|
} |
} |
my ($id,$store); |
my ($id,$store); |
$tmpsnum++; |
$tmpsnum++; |
if (($context eq 'resetpw') || ($context eq 'createaccount')) { |
my $numtries = 0; |
$id = &md5_hex(&md5_hex(time.{}.rand().$$)); |
my $execdir=$perlvar{'lonDaemons'}; |
|
if (($context eq 'resetpw') || ($context eq 'createaccount') || |
|
($context eq 'sso') || ($context eq 'link') || ($context eq 'retry')) { |
|
$id = &md5_hex(&md5_hex(time.{}.rand().$$.$tmpsnum)); |
|
while ((-e "$execdir/tmp/$id.tmp") && ($numtries <10)) { |
|
undef($id); |
|
$id = &md5_hex(&md5_hex(time.{}.rand().$$.$tmpsnum)); |
|
$numtries ++; |
|
} |
} else { |
} else { |
$id = $$.'_'.$clientip.'_'.$tmpsnum; |
$id = $$.'_'.$clientip.'_'.$tmpsnum; |
} |
} |
$id=~s/\W/\_/g; |
$id=~s/\W/\_/g; |
$record=~s/\n//g; |
$record=~s/\n//g; |
my $execdir=$perlvar{'lonDaemons'}; |
if (($id ne '') && |
if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) { |
($store=IO::File->new(">$execdir/tmp/$id.tmp"))) { |
print $store $record; |
print $store $record; |
close $store; |
close $store; |
&Reply($client, \$id, $userinput); |
&Reply($client, \$id, $userinput); |
Line 5976 sub validate_instcode_handler {
|
Line 6000 sub validate_instcode_handler {
|
} |
} |
®ister_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0); |
®ister_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0); |
|
|
|
# |
|
# Validate co-owner for cross-listed institutional code and |
|
# institutional course code itself used for a LON-CAPA course. |
|
# |
|
# Formal Parameters: |
|
# $cmd - The command request that got us dispatched. |
|
# $tail - The tail of the command. In this case, |
|
# this is a colon separated string containing: |
|
# $dom - Course's LON-CAPA domain |
|
# $instcode - Institutional course code for the course |
|
# $inst_xlist - Institutional course Id for the crosslisting |
|
# $coowner - Username of co-owner |
|
# (values for all but $dom have been escaped). |
|
# |
|
# $client - Socket open on the client. |
|
# Returns: |
|
# 1 - Indicating processing should continue. |
|
# |
|
sub validate_instcrosslist_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my ($dom,$instcode,$inst_xlist,$coowner) = split(/:/,$tail); |
|
$instcode = &unescape($instcode); |
|
$inst_xlist = &unescape($inst_xlist); |
|
$coowner = &unescape($coowner); |
|
my $outcome = &localenroll::validate_crosslist_access($dom,$instcode, |
|
$inst_xlist,$coowner); |
|
&Reply($client, \$outcome, $userinput); |
|
|
|
return 1; |
|
} |
|
®ister_handler("autovalidateinstcrosslist", \&validate_instcrosslist_handler, 0, 1, 0); |
|
|
# Get the official sections for which auto-enrollment is possible. |
# Get the official sections for which auto-enrollment is possible. |
# Since the admin people won't know about 'unofficial sections' |
# Since the admin people won't know about 'unofficial sections' |
# we cannot auto-enroll on them. |
# we cannot auto-enroll on them. |
Line 6100 sub validate_class_access_handler {
|
Line 6157 sub validate_class_access_handler {
|
®ister_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0); |
®ister_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0); |
|
|
# |
# |
|
# Modify institutional sections (using customized &instsec_reformat() |
|
# routine in localenroll.pm), to either clutter or declutter, for |
|
# purposes of ensuring an institutional course section (string) can |
|
# be unambiguously separated into institutional course and section. |
|
# |
|
# Formal Parameters: |
|
# $cmd - The command request that got us dispatched. |
|
# $tail - The tail of the command. In this case this is a colon separated |
|
# set of values that will be split into: |
|
# $cdom - The LON-CAPA domain of the course. |
|
# $action - Either: clutter or declutter |
|
# clutter adds character(s) to eliminate ambiguity |
|
# declutter removes the added characters (e.g., for |
|
# display of the institutional course section string. |
|
# $info - A frozen hash in which keys are: |
|
# LON-CAPA course number:Institutional course code |
|
# and values are a reference to an array of the |
|
# items to modify -- either institutional sections, |
|
# or institutional course sections (for crosslistings). |
|
# $client - The socket open on the client. |
|
# Returns: |
|
# 1 - continue processing. |
|
# |
|
|
|
sub instsec_reformat_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my ($cdom,$action,$info) = split(/:/,$tail); |
|
my $instsecref = &Apache::lonnet::thaw_unescape($info); |
|
my ($outcome,$result); |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
$outcome=&localenroll::instsec_reformat($cdom,$action,$instsecref); |
|
if ($outcome eq 'ok') { |
|
if (ref($instsecref) eq 'HASH') { |
|
foreach my $key (keys(%{$instsecref})) { |
|
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($instsecref->{$key}).'&'; |
|
} |
|
$result =~ s/\&$//; |
|
} |
|
} |
|
}; |
|
if (!$@) { |
|
if ($outcome eq 'ok') { |
|
&Reply( $client, \$result, $userinput); |
|
} else { |
|
&Reply($client,\$outcome, $userinput); |
|
} |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("autoinstsecreformat",\&instsec_reformat_handler, 0, 1, 0); |
|
|
|
# |
# Validate course owner or co-owners(s) access to enrollment data for all sections |
# Validate course owner or co-owners(s) access to enrollment data for all sections |
# and crosslistings for a particular course. |
# and crosslistings for a particular course. |
# |
# |
Line 7878 sub make_new_child {
|
Line 7991 sub make_new_child {
|
Debug("Main: Got $user_input\n"); |
Debug("Main: Got $user_input\n"); |
$keep_going = &process_request($user_input); |
$keep_going = &process_request($user_input); |
alarm(0); |
alarm(0); |
&status('Listening to '.$clientname." ($keymode)"); |
&status('Listening to '.$clientname." ($keymode)"); |
} |
} |
|
|
# --------------------------------------------- client unknown or fishy, refuse |
# --------------------------------------------- client unknown or fishy, refuse |
Line 7894 sub make_new_child {
|
Line 8007 sub make_new_child {
|
|
|
&logthis("<font color='red'>CRITICAL: " |
&logthis("<font color='red'>CRITICAL: " |
."Disconnect from $clientip ($clientname)</font>"); |
."Disconnect from $clientip ($clientname)</font>"); |
|
|
|
|
# this exit is VERY important, otherwise the child will become |
# this exit is VERY important, otherwise the child will become |
# a producer of more and more children, forking yourself into |
# a producer of more and more children, forking yourself into |
# process death. |
# process death. |