--- loncom/lonnet/perl/lonnet.pm 2004/12/04 18:35:27 1.573
+++ loncom/lonnet/perl/lonnet.pm 2004/12/22 20:34:49 1.583
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.573 2004/12/04 18:35:27 banghart Exp $
+# $Id: lonnet.pm,v 1.583 2004/12/22 20:34:49 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1406,13 +1406,13 @@ sub finishuserfileupload {
}
# Save the file
{
- #&Apache::lonnet::logthis("Saving to $filepath $file");
open(FH,'>'.$filepath.'/'.$file);
print FH $ENV{'form.'.$formname};
close(FH);
}
# Notify homeserver to grep it
#
+ &Apache::lonnet::logthis("fetching ".$path.$file);
my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
if ($fetchresult eq 'ok') {
#
@@ -1588,11 +1588,23 @@ sub courseacclog {
my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};
if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) {
$what.=':POST';
+ # FIXME: Probably ought to escape things....
foreach (keys %ENV) {
if ($_=~/^form\.(.*)/) {
$what.=':'.$1.'='.$ENV{$_};
}
}
+ } elsif ($fnsymb =~ m:^/adm/searchcat:) {
+ # FIXME: We should not be depending on a form parameter that someone
+ # editing lonsearchcat.pm might change in the future.
+ if ($ENV{'form.phase'} eq 'course_search') {
+ $what.= ':POST';
+ # FIXME: Probably ought to escape things....
+ foreach my $element ('courseexp','crsfulltext','crsrelated',
+ 'crsdiscuss') {
+ $what.=':'.$element.'='.$ENV{'form.'.$element};
+ }
+ }
}
&courselog($what);
}
@@ -1644,6 +1656,7 @@ sub get_course_adv_roles {
if (($tend) && ($tend<$now)) { next; }
if (($tstart) && ($now<$tstart)) { next; }
my ($role,$username,$domain,$section)=split(/\:/,$_);
+ if ($username eq '' || $domain eq '') { next; }
if ((&privileged($username,$domain)) &&
(!$nothide{$username.':'.$domain})) { next; }
my $key=&plaintext($role);
@@ -2399,7 +2412,7 @@ sub rolesinit {
my ($area,$role)=split(/=/,$_);
$area=~s/\_\w\w$//;
my ($trole,$tend,$tstart)=split(/_/,$role);
- $userroles.=&set_arearole($trole,$area,$tstart,$tend);
+ $userroles.=&set_arearole($trole,$area,$tstart,$tend,$domain,$username);
if (($tend!=0) && ($tend<$now)) { $trole=''; }
if (($tstart!=0) && ($tstart>$now)) { $trole=''; }
if (($area ne '') && ($trole ne '')) {
@@ -2776,7 +2789,7 @@ sub customaccess {
# ------------------------------------------------- Check for a user privilege
sub allowed {
- my ($priv,$uri)=@_;
+ my ($priv,$uri,$symb)=@_;
$uri=&deversion($uri);
my $orguri=$uri;
$uri=&declutter($uri);
@@ -3057,7 +3070,7 @@ sub allowed {
if ($thisallowed=~/X/) {
if ($ENV{'acc.randomout'}) {
- my $symb=&symbread($uri,1);
+ if (!$symb) { $symb=&symbread($uri,1); }
if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) {
return '';
}
@@ -3818,41 +3831,44 @@ sub save_selected_files {
my ($user, $path, @files) = @_;
my $filename = $user."savedfiles";
my @other_files = &files_not_in_path($user, $path);
- foreach (@other_files) {
- &logthis("other dir file $_");
- }
- foreach (@files) {
- &logthis("current dir file $_");
- }
- open OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename;
+ open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
foreach my $file (@files) {
- print OUT $ENV{'form.currentpath'}.$file."\n";
+ print (OUT $ENV{'form.currentpath'}.$file."\n");
}
foreach my $file (@other_files) {
- print OUT $file."\n";
+ print (OUT $file."\n");
}
- close OUT;
+ close (OUT);
return 'ok';
}
+sub clear_selected_files {
+ my ($user) = @_;
+ my $filename = $user."savedfiles";
+ open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
+ print (OUT undef);
+ close (OUT);
+ return ("ok");
+}
+
sub files_in_path {
my ($user, $path) = @_;
my $filename = $user."savedfiles";
my %return_files;
- open IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename;
+ open (IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
while (my $line_in = <IN>) {
- chomp $line_in;
- my @paths_and_file = split m!/!, $line_in;
- my $file_part = pop @paths_and_file;
- my $path_part = join '/', @paths_and_file;
+ chomp ($line_in);
+ my @paths_and_file = split (m!/!, $line_in);
+ my $file_part = pop (@paths_and_file);
+ my $path_part = join ('/', @paths_and_file);
$path_part.='/';
my $path_and_file = $path_part.$file_part;
if ($path_part eq $path) {
$return_files{$file_part}= 'selected';
}
}
- close IN;
- return \%return_files;
+ close (IN);
+ return (\%return_files);
}
# called in portfolio select mode, to show files selected NOT in current directory
@@ -3861,21 +3877,21 @@ sub files_not_in_path {
my $filename = $user."savedfiles";
my @return_files;
my $path_part;
- open IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename;
+ open (IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
while (<IN>) {
#ok, I know it's clunky, but I want it to work
my @paths_and_file = split m!/!, $_;
- my $file_part = pop @paths_and_file;
- chomp $file_part;
- my $path_part = join '/', @paths_and_file;
+ my $file_part = pop (@paths_and_file);
+ chomp ($file_part);
+ my $path_part = join ('/', @paths_and_file);
$path_part .= '/';
my $path_and_file = $path_part.$file_part;
if ($path_part ne $path) {
- push @return_files, ($path_and_file);
+ push (@return_files, ($path_and_file));
}
}
- close OUT;
- return @return_files;
+ close (OUT);
+ return (@return_files);
}
#--------------------------------------------------------------Get Marked as Read Only
@@ -3897,7 +3913,25 @@ sub get_marked_as_readonly {
}
return @readonly_files;
}
+#-----------------------------------------------------------Get Marked as Read Only Hash
+sub get_marked_as_readonly_hash {
+ my ($domain,$user,$what) = @_;
+ my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
+ my %readonly_files;
+ while (my ($file_name,$value) = each(%current_permissions)) {
+ if (ref($value) eq "ARRAY"){
+ foreach my $stored_what (@{$value}) {
+ if ($stored_what eq $what) {
+ $readonly_files{$file_name} = 'locked';
+ } elsif (!defined($what)) {
+ $readonly_files{$file_name} = 'locked';
+ }
+ }
+ }
+ }
+ return %readonly_files;
+}
# ------------------------------------------------------------ Unmark as Read Only
sub unmark_as_readonly {
@@ -4690,7 +4724,9 @@ sub gettitle {
my $symb=&symbread($urlsymb);
if ($symb) {
my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600);
- if (defined($cached)) { return $result; }
+ if (defined($cached)) {
+ return $result;
+ }
my ($map,$resid,$url)=&decode_symb($symb);
my $title='';
my %bighash;
@@ -4766,8 +4802,11 @@ sub symbverify {
if (
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
eq $symb) {
- $okay=1;
- }
+ if (($ENV{'request.role.adv'}) ||
+ $bighash{'encrypted_'.$_} eq $ENV{'request.enc'}) {
+ $okay=1;
+ }
+ }
}
}
untie(%bighash);
@@ -4962,8 +5001,25 @@ sub numval2 {
return int($total);
}
+sub numval3 {
+ use integer;
+ my $txt=shift;
+ $txt=~tr/A-J/0-9/;
+ $txt=~tr/a-j/0-9/;
+ $txt=~tr/K-T/0-9/;
+ $txt=~tr/k-t/0-9/;
+ $txt=~tr/U-Z/0-5/;
+ $txt=~tr/u-z/0-5/;
+ $txt=~s/\D//g;
+ my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt);
+ my $total;
+ foreach my $val (@txts) { $total+=$val; }
+ if ($_64bit) { $total=(($total<<32)>>32); }
+ return $total;
+}
+
sub latest_rnd_algorithm_id {
- return '64bit3';
+ return '64bit4';
}
sub get_rand_alg {
@@ -5002,7 +5058,13 @@ sub rndseed {
if (!$username) { $username=$wusername }
my $which=&get_rand_alg();
if (defined(&getCODE())) {
- return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
+ if ($which eq '64bit4') {
+ return &rndseed_CODE_64bit4($symb,$courseid,$domain,$username);
+ } else {
+ return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
+ }
+ } elsif ($which eq '64bit4') {
+ return &rndseed_64bit4($symb,$courseid,$domain,$username);
} elsif ($which eq '64bit3') {
return &rndseed_64bit3($symb,$courseid,$domain,$username);
} elsif ($which eq '64bit2') {
@@ -5099,6 +5161,30 @@ sub rndseed_64bit3 {
}
}
+sub rndseed_64bit4 {
+ my ($symb,$courseid,$domain,$username)=@_;
+ {
+ use integer;
+ # strings need to be an even # of cahracters long, it it is odd the
+ # last characters gets thrown away
+ my $symbchck=unpack("%32S*",$symb.' ') << 21;
+ my $symbseed=numval3($symb) << 10;
+ my $namechck=unpack("%32S*",$username.' ');
+
+ my $nameseed=numval3($username) << 21;
+ my $domainseed=unpack("%32S*",$domain.' ') << 10;
+ my $courseseed=unpack("%32S*",$courseid.' ');
+
+ my $num1=$symbchck+$symbseed+$namechck;
+ my $num2=$nameseed+$domainseed+$courseseed;
+ #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+ #&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit");
+ if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
+
+ return "$num1:$num2";
+ }
+}
+
sub rndseed_CODE_64bit {
my ($symb,$courseid,$domain,$username)=@_;
{
@@ -5118,6 +5204,25 @@ sub rndseed_CODE_64bit {
}
}
+sub rndseed_CODE_64bit4 {
+ my ($symb,$courseid,$domain,$username)=@_;
+ {
+ use integer;
+ my $symbchck=unpack("%32S*",$symb.' ') << 16;
+ my $symbseed=numval3($symb);
+ my $CODEchck=unpack("%32S*",&getCODE().' ') << 16;
+ my $CODEseed=numval3(&getCODE());
+ my $courseseed=unpack("%32S*",$courseid.' ');
+ my $num1=$symbseed+$CODEchck;
+ my $num2=$CODEseed+$courseseed+$symbchck;
+ #&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck");
+ #&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
+ if ($_64bit) { $num1=(($num1<<32)>>32); }
+ if ($_64bit) { $num2=(($num2<<32)>>32); }
+ return "$num1:$num2";
+ }
+}
+
sub setup_random_from_rndseed {
my ($rndseed)=@_;
if ($rndseed =~/([,:])/) {
@@ -5456,10 +5561,10 @@ sub thaw_unescape {
}
sub mod_perl_version {
+ return 1;
if (defined($perlvar{'MODPERL2'})) {
return 2;
}
- return 1;
}
sub correct_line_ends {
@@ -5492,6 +5597,7 @@ BEGIN {
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf
unless ($readit) {
{
+ # FIXME: Use LONCAPA::Configuration::read_conf here and omit next block
open(my $config,"</etc/httpd/conf/loncapa.conf");
while (my $configline=<$config>) {
@@ -6127,9 +6233,10 @@ returns the data handle
=item *
symbverify($symb,$thisfn) : verifies that $symb actually exists and is
-a possible symb for the URL in $thisfn, returns a 1 on success, 0 on
-failure, user must be in a course, as it assumes the existance of the
-course initi hash, and uses $ENV('request.course.id'}
+a possible symb for the URL in $thisfn, and if is an encryypted
+resource that the user accessed using /enc/ returns a 1 on success, 0
+on failure, user must be in a course, as it assumes the existance of
+the course initial hash, and uses $ENV('request.course.id'}
=item *