version 1.489.2.16, 2014/06/29 03:23:11
|
version 1.489.2.20, 2016/08/11 09:52:39
|
Line 2445 sub remove_user_file_handler {
|
Line 2445 sub remove_user_file_handler {
|
if (-e $file) { |
if (-e $file) { |
# |
# |
# If the file is a regular file unlink is fine... |
# If the file is a regular file unlink is fine... |
# However it's possible the client wants a dir. |
# However it's possible the client wants a dir |
# removed, in which case rmdir is more approprate: |
# removed, in which case rmdir is more appropriate |
|
# Note: rmdir will only remove an empty directory. |
# |
# |
if (-f $file){ |
if (-f $file){ |
unlink($file); |
unlink($file); |
|
# for html files remove the associated .bak file |
|
# which may have been created by the editor. |
|
if ($ufile =~ m{^((docs|supplemental)/(?:\d+|default)/\d+(?:|/.+)/)[^/]+\.x?html?$}i) { |
|
my $path = $1; |
|
if (-e $file.'.bak') { |
|
unlink($file.'.bak'); |
|
} |
|
} |
} elsif(-d $file) { |
} elsif(-d $file) { |
rmdir($file); |
rmdir($file); |
} |
} |
Line 2812 sub newput_user_profile_entry {
|
Line 2821 sub newput_user_profile_entry {
|
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
if (exists($hashref->{$key})) { |
if (exists($hashref->{$key})) { |
|
if (!&untie_user_hash($hashref)) { |
|
&logthis("error: ".($!+0)." untie (GDBM) failed ". |
|
"while attempting newput - early out as key exists"); |
|
} |
&Failure($client, "key_exists: ".$key."\n",$userinput); |
&Failure($client, "key_exists: ".$key."\n",$userinput); |
return 1; |
return 1; |
} |
} |
Line 3315 sub dump_with_regexp {
|
Line 3328 sub dump_with_regexp {
|
# namespace - Name of the database being modified |
# namespace - Name of the database being modified |
# rid - Resource keyword to modify. |
# rid - Resource keyword to modify. |
# what - new value associated with rid. |
# what - new value associated with rid. |
|
# laststore - (optional) version=timestamp |
|
# for most recent transaction for rid |
|
# in namespace, when cstore was called |
# |
# |
# $client - Socket open on the client. |
# $client - Socket open on the client. |
# |
# |
Line 3323 sub dump_with_regexp {
|
Line 3339 sub dump_with_regexp {
|
# 1 (keep on processing). |
# 1 (keep on processing). |
# Side-Effects: |
# Side-Effects: |
# Writes to the client |
# Writes to the client |
|
# Successful storage will cause either 'ok', or, if $laststore was included |
|
# in the tail of the request, and the version number for the last transaction |
|
# is larger than the version in $laststore, delay:$numtrans , where $numtrans |
|
# is the number of store evevnts recorded for rid in namespace since |
|
# lonnet::store() was called by the client. |
|
# |
sub store_handler { |
sub store_handler { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail); |
chomp($tail); |
|
my ($udom,$uname,$namespace,$rid,$what,$laststore) =split(/:/,$tail); |
if ($namespace ne 'roles') { |
if ($namespace ne 'roles') { |
|
|
chomp($what); |
|
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), "S", |
&GDBM_WRCREAT(), "S", |
"$rid:$what"); |
"$rid:$what"); |
if ($hashref) { |
if ($hashref) { |
my $now = time; |
my $now = time; |
my @previouskeys=split(/&/,$hashref->{"keys:$rid"}); |
my $numtrans; |
my $key; |
if ($laststore) { |
|
my ($previousversion,$previoustime) = split(/\=/,$laststore); |
|
my ($lastversion,$lasttime) = (0,0); |
|
$lastversion = $hashref->{"version:$rid"}; |
|
if ($lastversion) { |
|
$lasttime = $hashref->{"$lastversion:$rid:timestamp"}; |
|
} |
|
if (($previousversion) && ($previousversion !~ /\D/)) { |
|
if (($lastversion > $previousversion) && ($lasttime >= $previoustime)) { |
|
$numtrans = $lastversion - $previousversion; |
|
} |
|
} elsif ($lastversion) { |
|
$numtrans = $lastversion; |
|
} |
|
if ($numtrans) { |
|
$numtrans =~ s/D//g; |
|
} |
|
} |
|
|
$hashref->{"version:$rid"}++; |
$hashref->{"version:$rid"}++; |
my $version=$hashref->{"version:$rid"}; |
my $version=$hashref->{"version:$rid"}; |
my $allkeys=''; |
my $allkeys=''; |
Line 3352 sub store_handler {
|
Line 3392 sub store_handler {
|
$allkeys.='timestamp'; |
$allkeys.='timestamp'; |
$hashref->{"$version:keys:$rid"}=$allkeys; |
$hashref->{"$version:keys:$rid"}=$allkeys; |
if (&untie_user_hash($hashref)) { |
if (&untie_user_hash($hashref)) { |
&Reply($client, "ok\n", $userinput); |
my $msg = 'ok'; |
|
if ($numtrans) { |
|
$msg = 'delay:'.$numtrans; |
|
} |
|
&Reply($client, "$msg\n", $userinput); |
} else { |
} else { |
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
"while attempting store\n", $userinput); |
"while attempting store\n", $userinput); |
Line 5251 sub retrieve_auto_file_handler {
|
Line 5295 sub retrieve_auto_file_handler {
|
my ($filename) = split(/:/, $tail); |
my ($filename) = split(/:/, $tail); |
|
|
my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename; |
my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename; |
if ( (-e $source) && ($filename ne '') ) { |
if ($filename =~m{/\.\./}) { |
|
&Failure($client, "refused\n", $userinput); |
|
} elsif ( (-e $source) && ($filename ne '') ) { |
my $reply = ''; |
my $reply = ''; |
if (open(my $fh,$source)) { |
if (open(my $fh,$source)) { |
while (<$fh>) { |
while (<$fh>) { |
Line 5359 sub crsreq_update_handler {
|
Line 5405 sub crsreq_update_handler {
|
$title,$code,$accessstart,$accessend, |
$title,$code,$accessstart,$accessend, |
$incoming,\%rtnhash); |
$incoming,\%rtnhash); |
if ($outcome eq 'ok') { |
if ($outcome eq 'ok') { |
my @posskeys = qw(createdweb createdmsg queuedweb queuedmsg formitems reviewweb); |
my @posskeys = qw(createdweb createdmsg createdcustomized createdactions queuedweb queuedmsg formitems reviewweb validationjs onload javascript); |
foreach my $key (keys(%rtnhash)) { |
foreach my $key (keys(%rtnhash)) { |
if (grep(/^\Q$key\E/,@posskeys)) { |
if (grep(/^\Q$key\E/,@posskeys)) { |
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rtnhash{$key}).'&'; |
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rtnhash{$key}).'&'; |
Line 6575 sub make_new_child {
|
Line 6621 sub make_new_child {
|
&Authen::Krb5::init_context(); |
&Authen::Krb5::init_context(); |
|
|
my $no_ets; |
my $no_ets; |
if ($dist =~ /^(?:centos|rhes)(\d+)$/) { |
if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) { |
if ($1 >= 7) { |
if ($1 >= 7) { |
$no_ets = 1; |
$no_ets = 1; |
} |
} |
Line 6583 sub make_new_child {
|
Line 6629 sub make_new_child {
|
if (($1 eq '9.3') || ($1 >= 12.2)) { |
if (($1 eq '9.3') || ($1 >= 12.2)) { |
$no_ets = 1; |
$no_ets = 1; |
} |
} |
|
} elsif ($dist =~ /^sles(\d+)$/) { |
|
if ($1 > 11) { |
|
$no_ets = 1; |
|
} |
} elsif ($dist =~ /^fedora(\d+)$/) { |
} elsif ($dist =~ /^fedora(\d+)$/) { |
if ($1 < 7) { |
if ($1 < 7) { |
$no_ets = 1; |
$no_ets = 1; |