[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.574 and 1.579

version 1.574, 2004/12/06 18:08:39 version 1.579, 2004/12/17 22:40:09
Line 1406  sub finishuserfileupload { Line 1406  sub finishuserfileupload {
     }      }
 # Save the file  # Save the file
     {      {
  #&Apache::lonnet::logthis("Saving to $filepath $file");  
  open(FH,'>'.$filepath.'/'.$file);   open(FH,'>'.$filepath.'/'.$file);
  print FH $ENV{'form.'.$formname};   print FH $ENV{'form.'.$formname};
  close(FH);   close(FH);
     }      }
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
       &Apache::lonnet::logthis("fetching ".$path.$file);
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);      my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {      if ($fetchresult eq 'ok') {
 #  #
Line 1644  sub get_course_adv_roles { Line 1644  sub get_course_adv_roles {
         if (($tend) && ($tend<$now)) { next; }          if (($tend) && ($tend<$now)) { next; }
         if (($tstart) && ($now<$tstart)) { next; }          if (($tstart) && ($now<$tstart)) { next; }
         my ($role,$username,$domain,$section)=split(/\:/,$_);          my ($role,$username,$domain,$section)=split(/\:/,$_);
    if ($username eq '' || $domain eq '') { next; }
  if ((&privileged($username,$domain)) &&    if ((&privileged($username,$domain)) && 
     (!$nothide{$username.':'.$domain})) { next; }      (!$nothide{$username.':'.$domain})) { next; }
         my $key=&plaintext($role);          my $key=&plaintext($role);
Line 2399  sub rolesinit { Line 2400  sub rolesinit {
             my ($area,$role)=split(/=/,$_);              my ($area,$role)=split(/=/,$_);
             $area=~s/\_\w\w$//;              $area=~s/\_\w\w$//;
             my ($trole,$tend,$tstart)=split(/_/,$role);              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 (($tend!=0) && ($tend<$now)) { $trole=''; }
             if (($tstart!=0) && ($tstart>$now)) { $trole=''; }              if (($tstart!=0) && ($tstart>$now)) { $trole=''; }
             if (($area ne '') && ($trole ne '')) {              if (($area ne '') && ($trole ne '')) {
Line 2776  sub customaccess { Line 2777  sub customaccess {
 # ------------------------------------------------- Check for a user privilege  # ------------------------------------------------- Check for a user privilege
   
 sub allowed {  sub allowed {
     my ($priv,$uri)=@_;      my ($priv,$uri,$symb)=@_;
     $uri=&deversion($uri);      $uri=&deversion($uri);
     my $orguri=$uri;      my $orguri=$uri;
     $uri=&declutter($uri);      $uri=&declutter($uri);
Line 3057  sub allowed { Line 3058  sub allowed {
   
    if ($thisallowed=~/X/) {     if ($thisallowed=~/X/) {
       if ($ENV{'acc.randomout'}) {        if ($ENV{'acc.randomout'}) {
          my $symb=&symbread($uri,1);   if (!$symb) { $symb=&symbread($uri,1); }
          if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) {            if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) { 
             return '';               return ''; 
          }           }
Line 3818  sub save_selected_files { Line 3819  sub save_selected_files {
     my ($user, $path, @files) = @_;      my ($user, $path, @files) = @_;
     my $filename = $user."savedfiles";      my $filename = $user."savedfiles";
     my @other_files = &files_not_in_path($user, $path);      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) {      foreach my $file (@files) {
         print (OUT $ENV{'form.currentpath'}.$file."\n");          print (OUT $ENV{'form.currentpath'}.$file."\n");
Line 3906  sub get_marked_as_readonly { Line 3901  sub get_marked_as_readonly {
     }      }
     return @readonly_files;      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  # ------------------------------------------------------------ Unmark as Read Only
   
 sub unmark_as_readonly {  sub unmark_as_readonly {
Line 4699  sub gettitle { Line 4712  sub gettitle {
     my $symb=&symbread($urlsymb);      my $symb=&symbread($urlsymb);
     if ($symb) {      if ($symb) {
  my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600);   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 ($map,$resid,$url)=&decode_symb($symb);
  my $title='';   my $title='';
  my %bighash;   my %bighash;
Line 4971  sub numval2 { Line 4986  sub numval2 {
     return int($total);      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 {  sub latest_rnd_algorithm_id {
     return '64bit3';      return '64bit4';
 }  }
   
 sub get_rand_alg {  sub get_rand_alg {
Line 5011  sub rndseed { Line 5043  sub rndseed {
     if (!$username) { $username=$wusername }      if (!$username) { $username=$wusername }
     my $which=&get_rand_alg();      my $which=&get_rand_alg();
     if (defined(&getCODE())) {      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') {      } elsif ($which eq '64bit3') {
  return &rndseed_64bit3($symb,$courseid,$domain,$username);   return &rndseed_64bit3($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit2') {      } elsif ($which eq '64bit2') {
Line 5108  sub rndseed_64bit3 { Line 5146  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 {  sub rndseed_CODE_64bit {
     my ($symb,$courseid,$domain,$username)=@_;      my ($symb,$courseid,$domain,$username)=@_;
     {      {
Line 5119  sub rndseed_CODE_64bit { Line 5181  sub rndseed_CODE_64bit {
  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;
    #&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 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("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck");
  #&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");   #&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
  if ($_64bit) { $num1=(($num1<<32)>>32); }   if ($_64bit) { $num1=(($num1<<32)>>32); }
Removed from v.1.574  
changed lines
  Added in v.1.579

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