[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.910.2.4 and 1.911

version 1.910.2.4, 2007/10/01 23:54:54 version 1.911, 2007/09/12 03:40:35
Line 320  sub convert_and_load_session_env { Line 320  sub convert_and_load_session_env {
     my ($lonidsdir,$handle)=@_;      my ($lonidsdir,$handle)=@_;
     my @profile;      my @profile;
     {      {
  my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");   open(my $idf,"$lonidsdir/$handle.id");
  if (!$opened) {  
     return 0;  
  }  
  flock($idf,LOCK_SH);   flock($idf,LOCK_SH);
  @profile=<$idf>;   @profile=<$idf>;
  close($idf);   close($idf);
Line 362  sub transfer_profile_to_env { Line 359  sub transfer_profile_to_env {
   
     my $convert;      my $convert;
     {      {
     my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");      open(my $idf,"$lonidsdir/$handle.id");
  if (!$opened) {  
     return;  
  }  
  flock($idf,LOCK_SH);   flock($idf,LOCK_SH);
  if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",   if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",
  &GDBM_READER(),0640)) {   &GDBM_READER(),0640)) {
Line 431  sub appenv { Line 425  sub appenv {
             $env{$key}=$newenv{$key};              $env{$key}=$newenv{$key};
         }          }
     }      }
     my $opened = open(my $env_file,'+<',$env{'user.environment'});      open(my $env_file,$env{'user.environment'});
     if ($opened      if (&timed_flock($env_file,LOCK_EX)
  && &timed_flock($env_file,LOCK_EX)  
  &&   &&
  tie(my %disk_env,'GDBM_File',$env{'user.environment'},   tie(my %disk_env,'GDBM_File',$env{'user.environment'},
     (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {      (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
Line 453  sub delenv { Line 446  sub delenv {
                 "Attempt to delete from environment ".$delthis);                  "Attempt to delete from environment ".$delthis);
         return 'error';          return 'error';
     }      }
     my $opened = open(my $env_file,'+<',$env{'user.environment'});      open(my $env_file,$env{'user.environment'});
     if ($opened      if (&timed_flock($env_file,LOCK_EX)
  && &timed_flock($env_file,LOCK_EX)  
  &&   &&
  tie(my %disk_env,'GDBM_File',$env{'user.environment'},   tie(my %disk_env,'GDBM_File',$env{'user.environment'},
     (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {      (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
  foreach my $key (keys(%disk_env)) {   foreach my $key (keys(%disk_env)) {
     if ($key=~/^$delthis/) {       if ($key=~/^$delthis/) { 
  delete($env{$key});                  delete($env{$key});
  delete($disk_env{$key});                  delete($disk_env{$key});
     }              }
  }   }
  untie(%disk_env);   untie(%disk_env);
     }      }
Line 590  sub compare_server_load { Line 582  sub compare_server_load {
     }      }
     return ($spare_server,$lowest_load);      return ($spare_server,$lowest_load);
 }  }
   
 # --------------------------- ask offload servers if user already has a session  
 sub find_existing_session {  
     my ($udom,$uname) = @_;  
     foreach my $try_server (@{ $spareid{'primary'} },  
     @{ $spareid{'default'} }) {  
  return $try_server if (&has_user_session($try_server, $udom, $uname));  
     }  
     return;  
 }  
   
 # -------------------------------- ask if server already has a session for user  
 sub has_user_session {  
     my ($lonid,$udom,$uname) = @_;  
     my $result = &reply(join(':','userhassession',  
      map {&escape($_)} ($udom,$uname)),$lonid);  
     return 1 if ($result eq 'ok');  
   
     return 0;  
 }  
   
 # --------------------------------------------- Try to change a user's password  # --------------------------------------------- Try to change a user's password
   
 sub changepass {  sub changepass {
Line 935  sub usersearch { Line 906  sub usersearch {
         if (&host_domain($tryserver) eq $dom) {          if (&host_domain($tryserver) eq $dom) {
             my $host=&hostname($tryserver);              my $host=&hostname($tryserver);
             my $queryid=              my $queryid=
                 &reply("querysend:".&escape($query).':'.&escape($dom).':'.                  &reply("querysend:".&escape($query).':'.
                        &escape($srch->{'srchby'}).'%%'.                         &escape($srch->{'srchby'}).':'.
                        &escape($srch->{'srchtype'}).':'.                         &escape($srch->{'srchtype'}).':'.
                        &escape($srch->{'srchterm'}),$tryserver);                         &escape($srch->{'srchterm'}),$tryserver);
             if ($queryid !~/^\Q$host\E\_/) {              if ($queryid !~/^\Q$host\E\_/) {
Line 953  sub usersearch { Line 924  sub usersearch {
             if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {              if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
                 &logthis('usersrch error: '.$reply.' for '.$dom.' - searching for : '.$srch->{'srchterm'}.' by '.$srch->{'srchby'}.' ('.$srch->{'srchtype'}.') -  maxtries: '.$maxtries.' tries: '.$tries);                  &logthis('usersrch error: '.$reply.' for '.$dom.' - searching for : '.$srch->{'srchterm'}.' by '.$srch->{'srchby'}.' ('.$srch->{'srchtype'}.') -  maxtries: '.$maxtries.' tries: '.$tries);
             } else {              } else {
                 my @matches = split(/&/,$reply);                  my @matches;
                   if ($reply =~ /\n/) {
                       @matches = split(/\n/,$reply);
                   } else {
                       @matches = split(/\&/,$reply);
                   }
                 foreach my $match (@matches) {                  foreach my $match (@matches) {
                     my @items = split(/:/,$match);  
                     my ($uname,$udom,%userhash);                      my ($uname,$udom,%userhash);
                     foreach my $entry (@items) {                      foreach my $entry (split(/:/,$match)) {
                         my ($key,$value) = split(/=/,$entry);                          my ($key,$value) =
                         $key = &unescape($key);                              map {&unescape($_);} split(/=/,$entry);
                         $value = &unescape($value);  
                         $userhash{$key} = $value;                          $userhash{$key} = $value;
                         if ($key eq 'username') {                          if ($key eq 'username') {
                             $uname = $value;                              $uname = $value;
                         } elsif ($key eq 'domain') {                          } elsif ($key eq 'domain') {
                             $udom = $value;                              $udom = $value;
                         }                           }
                     }                      }
                     $results{$uname.':'.$udom} = \%userhash;                      $results{$uname.':'.$udom} = \%userhash;
                 }                  }
Line 7764  sub hreflocation { Line 7738  sub hreflocation {
  $file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/   $file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/
     -/uploaded/$1/$2/-x;      -/uploaded/$1/$2/-x;
     }      }
     if ($file=~ m{^/userfiles/}) {  
  $file =~ s{^/userfiles/}{/uploaded/};  
     }  
     return $file;      return $file;
 }  }
   
Removed from v.1.910.2.4  
changed lines
  Added in v.1.911

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