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

Diff for /loncom/auth/lonauth.pm between versions 1.82.2.1 and 1.83

version 1.82.2.1, 2006/10/06 14:29:44 version 1.83, 2006/09/19 21:36:24
Line 40  use Apache::lonnet; Line 40  use Apache::lonnet;
 use Apache::lonmenu();  use Apache::lonmenu();
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Apache::lonlocal;  use Apache::lonlocal;
   use GDBM_File;
 my %FORM;  my %FORM;
   
 # ------------------------------------------------------------ Successful login  # ------------------------------------------------------------ Successful login
Line 171  sub success { Line 171  sub success {
  }   }
   
  $env{'user.environment'} = "$lonids/$cookie.id";   $env{'user.environment'} = "$lonids/$cookie.id";
  open(my $idf,">$lonids/$cookie.id");  
  unless (flock($idf,LOCK_EX)) {   if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
    &GDBM_WRCREAT(),0640)) {
       &add_to_env(\%disk_env,\%initial_env);
       &add_to_env(\%disk_env,\%userenv,'environment.');
       &add_to_env(\%disk_env,$userroles);
       &add_to_env(\%disk_env,$extra_env);
       untie(%disk_env);
    } else {
     &Apache::lonnet::logthis("<font color=blue>WARNING: ".      &Apache::lonnet::logthis("<font color=blue>WARNING: ".
    'Could not obtain exclusive lock in lonauth: '.$!);     'Could not create environment storage in lonauth: '.$!);
     close($idf);  
     return 'error: '.$!;      return 'error: '.$!;
  }   }
   
  &add_to_env($idf,\%initial_env);  
  &add_to_env($idf,\%userenv,'environment.');  
  &add_to_env($idf,$userroles);  
  &add_to_env($idf,$extra_env);  
  close($idf);  
     }      }
     $env{'request.role'}='cm';      $env{'request.role'}='cm';
     $env{'request.role.adv'}=$env{'user.adv'};      $env{'request.role.adv'}=$env{'user.adv'};
Line 252  ENDSUCCESS Line 252  ENDSUCCESS
 sub add_to_env {  sub add_to_env {
     my ($idf,$env_data,$prefix) = @_;      my ($idf,$env_data,$prefix) = @_;
     while (my ($key,$value) = each(%$env_data)) {      while (my ($key,$value) = each(%$env_data)) {
  print $idf (&escape($prefix.$key).'='.&escape($value)."\n");   $idf->{$prefix.$key} = $value;
  $env{$prefix.$key} = $value;   $env{$prefix.$key}   = $value;
     }      }
 }  }
   
Line 344  ENDFAILED Line 344  ENDFAILED
   
   
     my $buffer;      my $buffer;
     if ($r->header_in('Content-length') > 0) {      $r->read($buffer,$r->header_in('Content-length'),0);
  $r->read($buffer,$r->header_in('Content-length'),0);  
     }  
     my @pairs=split(/&/,$buffer);      my @pairs=split(/&/,$buffer);
     my $pair; my $name; my $value;      my $pair; my $name; my $value;
     undef %FORM;      undef %FORM;
Removed from v.1.82.2.1  
changed lines
  Added in v.1.83

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