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

Diff for /loncom/lond between versions 1.443 and 1.447

version 1.443, 2010/06/10 19:21:32 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 3127  sub dump_with_regexp { Line 3150  sub dump_with_regexp {
  my $count=0;   my $count=0;
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
             if ($namespace eq 'roles') {              if ($namespace eq 'roles') {
                 if ($key =~ /^($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)}) {
                     if ($clientversion =~ /^(\d+)\.(\d+)$/) {                      my $cdom = $1;
                       my $cnum = $2;
                       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)));
                       } else {
                           my $homeserver = &Apache::lonnet::homeserver($cnum,$cdom);
                           next unless ($currenthostid eq $homeserver);
                     }                      }
                 }                  }
             }              }
Line 3728  sub put_course_id_hash_handler { Line 3756  sub put_course_id_hash_handler {
 #                 createdafter - include courses for which creation date followed this date.  #                 createdafter - include courses for which creation date followed this date.
 #                 creationcontext - include courses created in specified context   #                 creationcontext - include courses created in specified context 
 #  #
   #                 domcloner - flag to indicate if user can create CCs in course's domain.
   #                             If so, ability to clone course is automatic. 
   #
 #     $client  - The socket open on the client.  #     $client  - The socket open on the client.
 # Returns:  # Returns:
 #    1     - Continue processing.  #    1     - Continue processing.
Line 3740  sub dump_course_id_handler { Line 3771  sub dump_course_id_handler {
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,      my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,          $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
         $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,          $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
         $creationcontext) =split(/:/,$tail);          $creationcontext,$domcloner) =split(/:/,$tail);
     my $now = time;      my $now = time;
     my ($cloneruname,$clonerudom,%cc_clone);      my ($cloneruname,$clonerudom,%cc_clone);
     if (defined($description)) {      if (defined($description)) {
Line 3813  sub dump_course_id_handler { Line 3844  sub dump_course_id_handler {
     } else {      } else {
         $creationcontext = '.';          $creationcontext = '.';
     }      }
       
     my $unpack = 1;      my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' &&       if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && 
         $typefilter eq '.') {          $typefilter eq '.') {
Line 3844  sub dump_course_id_handler { Line 3874  sub dump_course_id_handler {
                     next if ($since > 1);                      next if ($since > 1);
                 }                  }
                 $is_hash =  1;                  $is_hash =  1;
                 if (defined($clonerudom)) {                  if ($domcloner) {
                       $canclone = 1;
                   } elsif (defined($clonerudom)) {
                     if ($items->{'cloners'}) {                      if ($items->{'cloners'}) {
                         my @cloneable = split(',',$items->{'cloners'});                          my @cloneable = split(',',$items->{'cloners'});
                         if (@cloneable) {                          if (@cloneable) {
Line 3877  sub dump_course_id_handler { Line 3909  sub dump_course_id_handler {
                                 if ($items->{'owner'} eq $cloner) {                                  if ($items->{'owner'} eq $cloner) {
                                     $canclone = 1;                                      $canclone = 1;
                                 }                                  }
                             } elsif ($cloner eq $udom.':'.$items->{'owner'}) {                              } elsif ($cloner eq $items->{'owner'}.':'.$udom) {
                                 $canclone = 1;                                  $canclone = 1;
                             }                              }
                             if ($canclone) {                              if ($canclone) {
Line 6241  $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 6457  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 7202  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.443  
changed lines
  Added in v.1.447

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