[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.446 and 1.451

version 1.446, 2010/07/17 19:14:35 version 1.451, 2010/08/17 20:06:25
Line 66  my $currentdomainid; Line 66  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 1073  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 1112  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 1147  sub load_handler { Line 1149  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 1658  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 1775  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 = &Apache::lonnet::get_internet_names($clientname);  
               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 3104  sub dump_with_regexp { Line 3144  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 3162  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 $clientcheckrole;
     if ($hashref) {      if ($hashref) {
         my $qresult='';          my $qresult='';
  my $count=0;   my $count=0;
           if ($extra ne '') {
               $extra = &Apache::lonnet::thaw_unescape($extra);
               $clientcheckrole = $extra->{'clientcheckrole'};
           }
           my @ids = &Apache::lonnet::current_machine_ids();
  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 ($clientcheckrole) {
                         my $major = $1;                          my $home = &Apache::lonnet::homeserver($cnum,$cdom);
                         my $minor = $2;                          my $loncaparev = $clientversion;
                         next if (($major < 2) || (($major == 2) && ($minor < 9)));                          if ($loncaparev eq '') {
                     } else {                              $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
                         my $homeserver = &Apache::lonnet::homeserver($cnum,$cdom);                          }
                         next unless ($currenthostid eq $homeserver);                          my ($major,$minor);
                           if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
                               $major = $1;
                               $minor = $2;
                           }
                           if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(co|in|ta|ep|ad|st|cr)}) {
                               if ($major eq '' && $minor eq '') {
                                   next unless (($home ne 'no_host') && grep(/^\Q$home\E$/,@ids));
                               }
                           }
                           unless ($home eq 'no_host') {
                               my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
                               if (ref($courseinfo) eq 'HASH') {
                                   if (exists($courseinfo->{'releaserequired'})) {
                                       my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                                       if ($reqdmajor ne '' && $reqdminor ne '') {
                                           next if (($major eq '' && $minor eq '') ||
                                                    ($major < $reqdmajor) || 
                                                    (($major == $reqdmajor) && ($minor < $reqdminor)));
                                       }
                                   }
                               }
                           }
                     }                      }
                 }                  }
             }              }
Line 6250  $SIG{USR2} = \&UpdateHosts; Line 6318  $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 6466  sub make_new_child { Line 6535  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 7211  sub version { Line 7283  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 get_courseinfo_hash {
       my ($cnum,$cdom,$home) = @_;
       my $hashid = $cdom.':'.$cnum;
       my ($courseinfo,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
       if (defined($cached)) {
           return $courseinfo;
       } else {
           my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
           if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
               return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
           }
       }
       return;
   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
Removed from v.1.446  
changed lines
  Added in v.1.451

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