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

Diff for /loncom/lond between versions 1.446.2.2 and 1.447

version 1.446.2.2, 2011/09/02 13:10:38 version 1.447, 2010/07/17 20:01:56
Line 67  my $client; Line 67  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 @clientdoms;                 # Array of domains on $clientip
   
 my $server;  my $server;
   
Line 1765  sub authenticate_handler { Line 1766  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) {
               unless (grep(/^\Q$udom\E$/,@clientdoms)) {
                   my ($remote,$hosted);
                   my $remotesession = &get_usersession_config($udom,'remotesession');
                   if (ref($remotesession) eq 'HASH') {
                       $remote = $remotesession->{'remote'}
                   }
                   my $hostedsession = &get_usersession_config($clientdoms[0],'hostedsession');
                   if (ref($hostedsession) eq 'HASH') {
                       $hosted = $hostedsession->{'hosted'};
                   }
                   $canhost = &Apache::lonnet::can_host_session($udom,$currentdomainid,$clientversion,
                                                                $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 2197  sub fetch_user_file_handler { Line 2220  sub fetch_user_file_handler {
   
  my $destname=$udir.'/'.$ufile;   my $destname=$udir.'/'.$ufile;
  my $transname=$udir.'/'.$ufile.'.in.transit';   my $transname=$udir.'/'.$ufile.'.in.transit';
         my $clientprotocol=$Apache::lonnet::protocol{$clientname};   my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
         $clientprotocol = 'http' if ($clientprotocol ne 'https');  
         my $remoteurl=$clientprotocol.'://'.$clientip.'/userfiles/'.$fname;  
  my $response;   my $response;
  Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");   Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");
  alarm(120);   alarm(120);
Line 3132  sub dump_with_regexp { Line 3153  sub dump_with_regexp {
                 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_community)_(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\-]+['"]?$/) {                      if ($clientversion =~ /^\'?(\d+)\.(\d+)/) {
                         my $major = $1;                          my $major = $1;
                         my $minor = $2;                          my $minor = $2;
                         next if (($major < 2) || (($major == 2) && ($minor < 9)));                          next if (($major < 2) || (($major == 2) && ($minor < 9)));
Line 6252  $SIG{USR2} = \&UpdateHosts; Line 6273  $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 6312  sub make_new_child { Line 6334  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);  
         return;          return;
     } else {      } else {
         # Child can *not* return from this subroutine.          # Child can *not* return from this subroutine.
Line 6469  sub make_new_child { Line 6490  sub make_new_child {
 # ------------------------------------------------------------ Process requests  # ------------------------------------------------------------ Process requests
     my $keep_going = 1;      my $keep_going = 1;
     my $user_input;      my $user_input;
               @clientdoms = ();
               if (ref($iphost{$clientip}) eq 'ARRAY') {
                   foreach my $id (@{$iphost{$clientip}}) {
                       my $clientdom = &Apache::lonnet::host_domain($id);
                       unless (grep(/^\Q$clientdom\E/,@clientdoms)) {
                           push(@clientdoms,$clientdom);
                       }
                   }
               }
     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 7041  sub subscribe { Line 7071  sub subscribe {
                 # the metadata                  # the metadata
  unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); }   unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); }
  $fname=~s/\/home\/httpd\/html\/res/raw/;   $fname=~s/\/home\/httpd\/html\/res/raw/;
                 my $protocol = $Apache::lonnet::protocol{$perlvar{'lonHostID'}};   $fname="http://".&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;
                 $protocol = 'http' if ($protocol ne 'https');  
                 $fname=$protocol.'://'.&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;  
  $result="$fname\n";   $result="$fname\n";
     }      }
  } else {   } else {
Line 7216  sub version { Line 7244  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;
   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
Removed from v.1.446.2.2  
changed lines
  Added in v.1.447

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