Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.488 and 1.491

version 1.488, 2004/04/23 19:36:46 version 1.491, 2004/04/29 07:57:47
Line 1338  sub finishuserfileupload { Line 1338  sub finishuserfileupload {
     }          }    
 }  }
   
   sub removeuserfile {
       my ($docuname,$docudom,$fname)=@_;
       my $home=&homeserver($docuname,$docudom);
       return &reply("removeuserfile:$docudom/$docuname/$fname",$home);
   }
   
 # ------------------------------------------------------------------------- Log  # ------------------------------------------------------------------------- Log
   
 sub log {  sub log {
Line 3938  sub metadata { Line 3944  sub metadata {
     # if it is a non metadata possible uri return quickly      # if it is a non metadata possible uri return quickly
     if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) ||      if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||          ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||
  ($uri =~ m|home/[^/]+/public_html/|) || ($uri =~ m|^uploaded/|)) {   ($uri =~ m|home/[^/]+/public_html/|)) {
  return undef;   return undef;
     }      }
     my $filename=$uri;      my $filename=$uri;
Line 3967  sub metadata { Line 3973  sub metadata {
  }   }
         my %metathesekeys=();          my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }          unless ($filename=~/\.meta$/) { $filename.='.meta'; }
  my $metastring=&getfile(&filelocation('',&clutter($filename)));   my $metastring;
    if ($uri !~ m|^uploaded/|) {
       $metastring=&getfile(&filelocation('',&clutter($filename)));
    }
         my $parser=HTML::LCParser->new(\$metastring);          my $parser=HTML::LCParser->new(\$metastring);
         my $token;          my $token;
         undef %metathesekeys;          undef %metathesekeys;
Line 4439  sub latest_rnd_algorithm_id { Line 4448  sub latest_rnd_algorithm_id {
     return '64bit2';      return '64bit2';
 }  }
   
   sub getCODE {
       if (defined($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; }
       if (defined($Apache::lonhomework::parsing_a_problem) &&
    defined($Apache::lonhomework::history{'resource.CODE'})) {
    return $Apache::lonhomework::history{'resource.CODE'};
       }
       return undef;
   }
   
 sub rndseed {  sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;      my ($symb,$courseid,$domain,$username)=@_;
   
Line 4450  sub rndseed { Line 4468  sub rndseed {
     if (!$domain) { $domain=$wdomain; }      if (!$domain) { $domain=$wdomain; }
     if (!$username) { $username=$wusername }      if (!$username) { $username=$wusername }
     my $which=$ENV{"course.$courseid.rndseed"};      my $which=$ENV{"course.$courseid.rndseed"};
     my $CODE=$ENV{'form.CODE'};      if (defined(&getCODE())) {
     if (defined($CODE)) {  
  return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);   return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit2') {      } elsif ($which eq '64bit2') {
  return &rndseed_64bit2($symb,$courseid,$domain,$username);   return &rndseed_64bit2($symb,$courseid,$domain,$username);
Line 4526  sub rndseed_CODE_64bit { Line 4543  sub rndseed_CODE_64bit {
  use integer;   use integer;
  my $symbchck=unpack("%32S*",$symb.' ') << 16;   my $symbchck=unpack("%32S*",$symb.' ') << 16;
  my $symbseed=numval2($symb);   my $symbseed=numval2($symb);
  my $CODEchck=unpack("%32S*",$ENV{'form.CODE'}.' ') << 16;   my $CODEchck=unpack("%32S*",&getCODE().' ') << 16;
  my $CODEseed=numval($ENV{'form.CODE'});   my $CODEseed=numval(&getCODE());
  my $courseseed=unpack("%32S*",$courseid.' ');   my $courseseed=unpack("%32S*",$courseid.' ');
  my $num1=$symbseed+$CODEchck;   my $num1=$symbseed+$CODEchck;
  my $num2=$CODEseed+$courseseed+$symbchck;   my $num2=$CODEseed+$courseseed+$symbchck;

Removed from v.1.488  
changed lines
  Added in v.1.491


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>