[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.545 and 1.549

version 1.545, 2004/09/21 22:38:10 version 1.549, 2004/10/05 11:24:34
Line 116  sub logperm { Line 116  sub logperm {
 sub subreply {  sub subreply {
     my ($cmd,$server)=@_;      my ($cmd,$server)=@_;
     my $peerfile="$perlvar{'lonSockDir'}/$server";      my $peerfile="$perlvar{'lonSockDir'}/$server";
       #
       #  With loncnew process trimming, there's a timing hole between lonc server
       #  process exit and the master server picking up the listen on the AF_UNIX
       #  socket.  In that time interval, a lock file will exist:
   
       my $lockfile=$peerfile.".lock";
       while (-e $lockfile) { # Need to wait for the lockfile to disappear.
    sleep(1);
       }
       # At this point, either a loncnew parent is listening or an old lonc
       # or loncnew child is listening so we can connect.
       #
     my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",      my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                      Type    => SOCK_STREAM,                                       Type    => SOCK_STREAM,
                                      Timeout => 10)                                       Timeout => 10)
Line 795  sub getsection { Line 807  sub getsection {
         if ($key eq $courseid.'_st') { $section=''; }          if ($key eq $courseid.'_st') { $section=''; }
         my ($dummy,$end,$start)=split(/\_/,&unescape($value));          my ($dummy,$end,$start)=split(/\_/,&unescape($value));
         my $now=time;          my $now=time;
         if (defined($end) && ($now > $end)) {          if (defined($end) && $end && ($now > $end)) {
             $Expired{$end}=$section;              $Expired{$end}=$section;
             next;              next;
         }          }
         if (defined($start) && ($now < $start)) {          if (defined($start) && $start && ($now < $start)) {
             $Pending{$start}=$section;              $Pending{$start}=$section;
             next;              next;
         }          }
Line 2785  sub allowed { Line 2797  sub allowed {
     }      }
   
 # Free bre access to user's own portfolio contents  # Free bre access to user's own portfolio contents
     $uri=~m:([^/]+)/([^/]+)/([^/]+)/([^/]+)/:;      my ($space,$domain,$name,$dir)=split('/',$uri);
     if (('uploaded' eq $1)&&($ENV{'user.name'} eq $3) && ($ENV{'user.domain'} eq $2) && ('portfolio' eq $4)) {      if (('uploaded' eq $space) && ($ENV{'user.name'} eq $name) && 
    ($ENV{'user.domain'} eq $domain) && ('portfolio' eq $dir)) {
         return 'F';          return 'F';
     }      }
   
Line 3191  sub log_query { Line 3204  sub log_query {
 sub fetch_enrollment_query {  sub fetch_enrollment_query {
     my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_;      my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_;
     my $homeserver;      my $homeserver;
       my $maxtries = 1;
     if ($context eq 'automated') {      if ($context eq 'automated') {
         $homeserver = $perlvar{'lonHostID'};          $homeserver = $perlvar{'lonHostID'};
           $maxtries = 10; # will wait for up to 2000s for retrieval of classlist data before timeout
     } else {      } else {
         $homeserver = &homeserver($cnum,$dom);          $homeserver = &homeserver($cnum,$dom);
     }      }
Line 3210  sub fetch_enrollment_query { Line 3225  sub fetch_enrollment_query {
         return 'error: '.$queryid;          return 'error: '.$queryid;
     }      }
     my $reply = &get_query_reply($queryid);      my $reply = &get_query_reply($queryid);
       my $tries = 1;
       while (($reply=~/^timeout/) && ($tries < $maxtries)) {
           $reply = &get_query_reply($queryid);
           $tries ++;
       }
     if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {      if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
         &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$ENV{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum);          &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$ENV{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries);
     } else {      } else {
         my @responses = split/:/,$reply;          my @responses = split/:/,$reply;
         if ($homeserver eq $perlvar{'lonHostID'}) {          if ($homeserver eq $perlvar{'lonHostID'}) {
Removed from v.1.545  
changed lines
  Added in v.1.549

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