Diff for /loncom/lond between versions 1.446.2.1 and 1.469

version 1.446.2.1, 2010/11/13 02:21:06 version 1.469, 2011/01/20 10:55:02
Line 15 Line 15
 #  #
 # LON-CAPA is distributed in the hope that it will be useful,  # LON-CAPA is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of  # but WITHOUT ANY WARRANTY; without even the implied warranty of
   
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.  # GNU General Public License for more details.
 #  #
Line 66  my $currentdomainid; Line 67  my $currentdomainid;
 my $client;  my $client;
 my $clientip; # IP address of client.  my $clientip; # IP address of client.
 my $clientname; # LonCAPA name of client.  my $clientname; # LonCAPA name of client.
 my $clientversion;              # LonCAPA version running on client  my $clientversion;              # LonCAPA version running on client.
   my $clienthomedom;              # LonCAPA domain of homeID for client. 
                                   # primary library server. 
   
 my $server;  my $server;
   
Line 1071  sub pong_handler { Line 1074  sub pong_handler {
 #  Implicit Inputs:  #  Implicit Inputs:
 #      $currenthostid - Global variable that carries the name of the host  #      $currenthostid - Global variable that carries the name of the host
 #                       known as.  #                       known as.
 #      $clientname    - Global variable that carries the name of the hsot we're connected to.  #      $clientname    - Global variable that carries the name of the host we're connected to.
 #  Returns:  #  Returns:
 #      1       - Ok to continue processing.  #      1       - Ok to continue processing.
 #      0       - Program should exit.  #      0       - Program should exit.
Line 1110  sub establish_key_handler { Line 1113  sub establish_key_handler {
 #  Implicit Inputs:  #  Implicit Inputs:
 #      $currenthostid - Global variable that carries the name of the host  #      $currenthostid - Global variable that carries the name of the host
 #                       known as.  #                       known as.
 #      $clientname    - Global variable that carries the name of the hsot we're connected to.  #      $clientname    - Global variable that carries the name of the host we're connected to.
 #  Returns:  #  Returns:
 #      1       - Ok to continue processing.  #      1       - Ok to continue processing.
 #      0       - Program should exit.  #      0       - Program should exit.
Line 1119  sub establish_key_handler { Line 1122  sub establish_key_handler {
 sub load_handler {  sub load_handler {
     my ($cmd, $tail, $replyfd) = @_;      my ($cmd, $tail, $replyfd) = @_;
   
   
   
    # Get the load average from /proc/loadavg and calculate it as a percentage of     # Get the load average from /proc/loadavg and calculate it as a percentage of
    # the allowed load limit as set by the perl global variable lonLoadLim     # the allowed load limit as set by the perl global variable lonLoadLim
   
Line 1147  sub load_handler { Line 1152  sub load_handler {
 #  Implicit Inputs:  #  Implicit Inputs:
 #      $currenthostid - Global variable that carries the name of the host  #      $currenthostid - Global variable that carries the name of the host
 #                       known as.  #                       known as.
 #      $clientname    - Global variable that carries the name of the hsot we're connected to.  #      $clientname    - Global variable that carries the name of the host we're connected to.
 #  Returns:  #  Returns:
 #      1       - Ok to continue processing.  #      1       - Ok to continue processing.
 #      0       - Program should exit  #      0       - Program should exit
Line 1656  sub server_loncaparev_handler { Line 1661  sub server_loncaparev_handler {
 }  }
 &register_handler("serverloncaparev", \&server_loncaparev_handler, 0, 1, 0);  &register_handler("serverloncaparev", \&server_loncaparev_handler, 0, 1, 0);
   
   sub server_homeID_handler {
       my ($cmd,$tail,$client) = @_;
       my $userinput = "$cmd:$tail";
       &Reply($client,\$perlvar{'lonHostID'},$userinput);
       return 1;
   }
   &register_handler("serverhomeID", \&server_homeID_handler, 0, 1, 0);
   
 #   Process a reinit request.  Reinit requests that either  #   Process a reinit request.  Reinit requests that either
 #   lonc or lond be reinitialized so that an updated   #   lonc or lond be reinitialized so that an updated 
 #   host.tab or domain.tab can be processed.  #   host.tab or domain.tab can be processed.
Line 1765  sub authenticate_handler { Line 1778  sub authenticate_handler {
     #  upass   - User's password.      #  upass   - User's password.
     #  checkdefauth - Pass to validate_user() to try authentication      #  checkdefauth - Pass to validate_user() to try authentication
     #                 with default auth type(s) if no user account.      #                 with default auth type(s) if no user account.
       #  clientcancheckhost - Passed by clients with functionality in lonauth.pm
       #                       to check if session can be hosted.
           
     my ($udom, $uname, $upass, $checkdefauth)=split(/:/,$tail);      my ($udom, $uname, $upass, $checkdefauth, $clientcancheckhost)=split(/:/,$tail);
     &Debug(" Authenticate domain = $udom, user = $uname, password = $upass,  checkdefauth = $checkdefauth");      &Debug(" Authenticate domain = $udom, user = $uname, password = $upass,  checkdefauth = $checkdefauth");
     chomp($upass);      chomp($upass);
     $upass=&unescape($upass);      $upass=&unescape($upass);
   
     my $pwdcorrect = &validate_user($udom,$uname,$upass,$checkdefauth);      my $pwdcorrect = &validate_user($udom,$uname,$upass,$checkdefauth);
     if($pwdcorrect) {      if($pwdcorrect) {
  &Reply( $client, "authorized\n", $userinput);          my $canhost = 1;
           unless ($clientcancheckhost) {
               my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
               my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
               my @intdoms;
               my $internet_names = &Apache::lonnet::get_internet_names($clientname);
               if (ref($internet_names) eq 'ARRAY') {
                   @intdoms = @{$internet_names};
               }
               unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
                   my ($remote,$hosted);
                   my $remotesession = &get_usersession_config($udom,'remotesession');
                   if (ref($remotesession) eq 'HASH') {
                       $remote = $remotesession->{'remote'}
                   }
                   my $hostedsession = &get_usersession_config($clienthomedom,'hostedsession');
                   if (ref($hostedsession) eq 'HASH') {
                       $hosted = $hostedsession->{'hosted'};
                   }
                   my $loncaparev = $clientversion;
                   if ($loncaparev eq '') {
                       $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
                   }
                   $canhost = &Apache::lonnet::can_host_session($udom,$clientname,
                                                                $loncaparev,
                                                                $remote,$hosted);
               }
           }
           if ($canhost) {               
               &Reply( $client, "authorized\n", $userinput);
           } else {
               &Reply( $client, "not_allowed_to_host\n", $userinput);
           }
  #   #
  #  Bad credentials: Failed to authorize   #  Bad credentials: Failed to authorize
  #   #
Line 2111  sub update_resource_handler { Line 2158  sub update_resource_handler {
  my $transname="$fname.in.transfer";   my $transname="$fname.in.transfer";
  my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname");   my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname");
  my $response;   my $response;
  alarm(120);  # FIXME: cannot replicate files that take more than two minutes to transfer?
   # alarm(120);
   # FIXME: this should use the LWP mechanism, not internal alarms.
                   alarm(1200);
  {   {
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request('GET',"$remoteurl");      my $request=new HTTP::Request('GET',"$remoteurl");
Line 2119  sub update_resource_handler { Line 2169  sub update_resource_handler {
  }   }
  alarm(0);   alarm(0);
  if ($response->is_error()) {   if ($response->is_error()) {
   # FIXME: we should probably clean up here instead of just whine
     unlink($transname);      unlink($transname);
     my $message=$response->status_line;      my $message=$response->status_line;
     &logthis("LWP GET: $message for $fname ($remoteurl)");      &logthis("LWP GET: $message for $fname ($remoteurl)");
  } else {   } else {
     if ($remoteurl!~/\.meta$/) {      if ($remoteurl!~/\.meta$/) {
   # FIXME: isn't there an internal LWP mechanism for this?
  alarm(120);   alarm(120);
  {   {
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
Line 2373  sub user_has_session_handler { Line 2425  sub user_has_session_handler {
   
     my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));      my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));
           
     &logthis("Looking for $udom $uname");  
     opendir(DIR,$perlvar{'lonIDsDir'});      opendir(DIR,$perlvar{'lonIDsDir'});
     my $filename;      my $filename;
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
Line 3104  sub dump_with_regexp { Line 3155  sub dump_with_regexp {
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);      my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);
     if (defined($regexp)) {      if (defined($regexp)) {
  $regexp=&unescape($regexp);   $regexp=&unescape($regexp);
     } else {      } else {
Line 3122  sub dump_with_regexp { Line 3173  sub dump_with_regexp {
     }      }
     my $hashref = &tie_user_hash($udom, $uname, $namespace,      my $hashref = &tie_user_hash($udom, $uname, $namespace,
  &GDBM_READER());   &GDBM_READER());
       my $skipcheck;
     if ($hashref) {      if ($hashref) {
         my $qresult='';          my $qresult='';
  my $count=0;   my $count=0;
           if ($extra ne '') {
               $extra = &Apache::lonnet::thaw_unescape($extra);
               $skipcheck = $extra->{'skipcheck'};
           }
           my @ids = &Apache::lonnet::current_machine_ids();
           my (%homecourses,$major,$minor,$now);
           if (($namespace eq 'roles') && (!$skipcheck)) {
               my $loncaparev = $clientversion;
               if ($loncaparev eq '') {
                   $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
               }
               if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
                   $major = $1;
                   $minor = $2;
               }
               $now = time;
           }
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
             if ($namespace eq 'roles') {              if ($namespace eq 'roles') {
                 if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(cc|co|in|ta|ep|ad|st|cr)}) {                  if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
                     my $cdom = $1;                      my $cdom = $1;
                     my $cnum = $2;                      my $cnum = $2;
                     if ($clientversion =~ /^['"]?(\d+)\.(\d+)[.\d\-]+['"]?$/) {                      unless ($skipcheck) {
                         my $major = $1;                          my ($role,$end,$start) = split(/\_/,$value);
                         my $minor = $2;                          if (!$end || $end > $now) {
                         next if (($major < 2) || (($major == 2) && ($minor < 9)));                              next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
                     } else {                                                              $minor,\%homecourses,\@ids));
                         my $homeserver = &Apache::lonnet::homeserver($cnum,$cdom);                          }
                         next unless ($currenthostid eq $homeserver);  
                     }                      }
                 }                  }
             }              }
Line 3156  sub dump_with_regexp { Line 3224  sub dump_with_regexp {
     }      }
  }   }
  if (&untie_user_hash($hashref)) {   if (&untie_user_hash($hashref)) {
               if (($namespace eq 'roles') && (!$skipcheck)) {
                   if (keys(%homecourses) > 0) {
                       $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count,
                                                      $range,$start,$end,$major,$minor);
                   }
               }
     chop($qresult);      chop($qresult);
     &Reply($client, \$qresult, $userinput);      &Reply($client, \$qresult, $userinput);
  } else {   } else {
Line 4206  sub put_domain_handler { Line 4280  sub put_domain_handler {
 sub get_domain_handler {  sub get_domain_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
   
     my $userinput = "$client:$tail";      my $userinput = "$client:$tail";
   
     my ($udom,$namespace,$what)=split(/:/,$tail,3);      my ($udom,$namespace,$what)=split(/:/,$tail,3);
Line 4350  sub get_id_handler { Line 4425  sub get_id_handler {
 sub put_dcmail_handler {  sub put_dcmail_handler {
     my ($cmd,$tail,$client) = @_;      my ($cmd,$tail,$client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
                                                                                   
   
     my ($udom,$what)=split(/:/,$tail);      my ($udom,$what)=split(/:/,$tail);
     chomp($what);      chomp($what);
     my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());      my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());
Line 4614  sub tmp_put_handler { Line 4690  sub tmp_put_handler {
     }      }
     my ($id,$store);      my ($id,$store);
     $tmpsnum++;      $tmpsnum++;
     if ($context eq 'resetpw') {      if (($context eq 'resetpw') || ($context eq 'createaccount')) {
         $id = &md5_hex(&md5_hex(time.{}.rand().$$));          $id = &md5_hex(&md5_hex(time.{}.rand().$$));
     } else {      } else {
         $id = $$.'_'.$clientip.'_'.$tmpsnum;          $id = $$.'_'.$clientip.'_'.$tmpsnum;
Line 5923  if (-e $pidfile) { Line 5999  if (-e $pidfile) {
 $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},  $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},
                                 Type      => SOCK_STREAM,                                  Type      => SOCK_STREAM,
                                 Proto     => 'tcp',                                  Proto     => 'tcp',
                                 Reuse     => 1,                                  ReuseAddr     => 1,
                                 Listen    => 10 )                                  Listen    => 10 )
   or die "making socket: $@\n";    or die "making socket: $@\n";
   
Line 6161  sub logstatus { Line 6237  sub logstatus {
 sub initnewstatus {  sub initnewstatus {
     my $docdir=$perlvar{'lonDocRoot'};      my $docdir=$perlvar{'lonDocRoot'};
     my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");      my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");
     my $now=time;      my $now=time();
     my $local=localtime($now);      my $local=localtime($now);
     print $fh "LOND status $local - parent $$\n\n";      print $fh "LOND status $local - parent $$\n\n";
     opendir(DIR,"$docdir/lon-status/londchld");      opendir(DIR,"$docdir/lon-status/londchld");
Line 6250  $SIG{USR2} = \&UpdateHosts; Line 6326  $SIG{USR2} = \&UpdateHosts;
   
 #  Read the host hashes:  #  Read the host hashes:
 &Apache::lonnet::load_hosts_tab();  &Apache::lonnet::load_hosts_tab();
   my %iphost = &Apache::lonnet::get_iphost(1);
   
 my $dist=`$perlvar{'lonDaemons'}/distprobe`;  my $dist=`$perlvar{'lonDaemons'}/distprobe`;
   
Line 6310  sub make_new_child { Line 6387  sub make_new_child {
             or die "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = $clientip;          $children{$pid} = $clientip;
         &status('Started child '.$pid);          &status('Started child '.$pid);
         close($client);   close($client);
         return;          return;
     } else {      } else {
         # Child can *not* return from this subroutine.          # Child can *not* return from this subroutine.
Line 6319  sub make_new_child { Line 6396  sub make_new_child {
                                 #don't get intercepted                                  #don't get intercepted
         $SIG{USR1}= \&logstatus;          $SIG{USR1}= \&logstatus;
         $SIG{ALRM}= \&timeout;          $SIG{ALRM}= \&timeout;
    #
    # Block sigpipe as it gets thrownon socket disconnect and we want to 
    # deal with that as a read faiure instead.
    #
    my $blockset = POSIX::SigSet->new(SIGPIPE);
    sigprocmask(SIG_BLOCK, $blockset);
   
         $lastlog='Forked ';          $lastlog='Forked ';
         $status='Forked';          $status='Forked';
   
Line 6467  sub make_new_child { Line 6551  sub make_new_child {
 # ------------------------------------------------------------ Process requests  # ------------------------------------------------------------ Process requests
     my $keep_going = 1;      my $keep_going = 1;
     my $user_input;      my $user_input;
               my $clienthost = &Apache::lonnet::hostname($clientname);
               my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);
               $clienthomedom = &Apache::lonnet::host_domain($clientserverhomeID);
     while(($user_input = get_request) && $keep_going) {      while(($user_input = get_request) && $keep_going) {
  alarm(120);   alarm(120);
  Debug("Main: Got $user_input\n");   Debug("Main: Got $user_input\n");
Line 7212  sub version { Line 7299  sub version {
     return "version:$VERSION";      return "version:$VERSION";
 }  }
   
   sub get_usersession_config {
       my ($dom,$name) = @_;
       my ($usersessionconf,$cached)=&Apache::lonnet::is_cached_new($name,$dom);
       if (defined($cached)) {
           return $usersessionconf;
       } else {
           my %domconfig = &Apache::lonnet::get_dom('configuration',['usersessions'],$dom);
           if (ref($domconfig{'usersessions'}) eq 'HASH') {
               &Apache::lonnet::do_cache_new($name,$dom,$domconfig{'usersessions'},3600);
               return $domconfig{'usersessions'};
           }
       }
       return;
   }
   
   sub releasereqd_check {
       my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
       my $home = &Apache::lonnet::homeserver($cnum,$cdom);
       return if ($home eq 'no_host');
       my ($reqdmajor,$reqdminor,$displayrole);
       if ($cnum =~ /$LONCAPA::match_community/) {
           if ($major eq '' && $minor eq '') {
               return unless ((ref($ids) eq 'ARRAY') && 
                              (grep(/^\Q$home\E$/,@{$ids})));
           } else {
               $reqdmajor = 2;
               $reqdminor = 9;
               return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
           }
       }
       my $hashid = $cdom.':'.$cnum;
       my ($courseinfo,$cached) =
           &Apache::lonnet::is_cached_new('courseinfo',$hashid);
       if (defined($cached)) {
           if (ref($courseinfo) eq 'HASH') {
               if (exists($courseinfo->{'releaserequired'})) {
                   my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                   return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
               }
           }
       } else {
           if (ref($ids) eq 'ARRAY') {
               if (grep(/^\Q$home\E$/,@{$ids})) {
                   if (ref($homecourses) eq 'HASH') {
                       if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                           push(@{$homecourses->{$hashid}},{$key=>$value});
                       } else {
                           $homecourses->{$hashid} = [{$key=>$value}];
                       }
                   }
                   return;
               }
           }
           my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
           if (ref($courseinfo) eq 'HASH') {
               if (exists($courseinfo->{'releaserequired'})) {
                   my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                   return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
               }
           } else {
               return;
           }
       }
       return 1;
   }
   
   sub get_courseinfo_hash {
       my ($cnum,$cdom,$home) = @_;
       my %info;
       eval {
           local($SIG{ALRM}) = sub { die "timeout\n"; };
           local($SIG{__DIE__})='DEFAULT';
           alarm(3);
           %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
           alarm(0);
       };
       if ($@) {
           if ($@ eq "timeout\n") {
               &logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");
           } else {
               &logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>");
           }
       } else {
           if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
               my $hashid = $cdom.':'.$cnum;
               return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
           }
       }
       return;
   }
   
   sub check_homecourses {
       my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
       my ($result,%addtocache);
       my $yesterday = time - 24*3600; 
       if (ref($homecourses) eq 'HASH') {
           my (%okcourses,%courseinfo,%recent);
           my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
           if ($hashref) {
               while (my ($key,$value) = each(%$hashref)) {
                   my $unesc_key = &unescape($key);
                   if ($unesc_key =~ /^lasttime:(\w+)$/) {
                       my $cid = $1;
                       $cid =~ s/_/:/;
                       if ($value > $yesterday ) {
                           $recent{$cid} = 1;
                       }
                       next;
                   }
                   my $items = &Apache::lonnet::thaw_unescape($value);
                   if (ref($items) eq 'HASH') {
                       my $hashid = $unesc_key;
                       $hashid =~ s/_/:/;
                       $courseinfo{$hashid} = $items;
                       if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                           my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
                           if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
                               $okcourses{$hashid} = 1;
                           }
                       }
                   }
               }
               unless (&untie_domain_hash($hashref)) {
                   &logthis('Failed to untie tied hash for nohist_courseids.db');
               }
           } else {
               &logthis('Failed to tie hash for nohist_courseids.db');
               return;
           }
           foreach my $hashid (keys(%recent)) {
               my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
               unless ($cached) {
                   &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
               }
           }
           foreach my $hashid (keys(%{$homecourses})) {
               next if ($recent{$hashid});
               &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
           }
           foreach my $hashid (keys(%okcourses)) {
               if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                   foreach my $role (@{$homecourses->{$hashid}}) {
                       if (ref($role) eq 'HASH') {
                           while (my ($key,$value) = each(%{$role})) {
                               if ($regexp eq '.') {
                                   $count++;
                                   if (defined($range) && $count >= $end)   { last; }
                                   if (defined($range) && $count <  $start) { next; }
                                   $result.=$key.'='.$value.'&';
                               } else {
                                   my $unescapeKey = &unescape($key);
                                   if (eval('$unescapeKey=~/$regexp/')) {
                                       $count++;
                                       if (defined($range) && $count >= $end)   { last; }
                                       if (defined($range) && $count <  $start) { next; }
                                       $result.="$key=$value&";
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
       return $result;
   }
   
   sub useable_role {
       my ($reqdmajor,$reqdminor,$major,$minor) = @_; 
       if ($reqdmajor ne '' && $reqdminor ne '') {
           return if (($major eq '' && $minor eq '') ||
                      ($major < $reqdmajor) ||
                      (($major == $reqdmajor) && ($minor < $reqdminor)));
       }
       return 1;
   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   

Removed from v.1.446.2.1  
changed lines
  Added in v.1.469


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.