Diff for /loncom/lond between versions 1.477 and 1.482

version 1.477, 2011/07/31 22:55:48 version 1.482, 2011/10/24 20:43:51
Line 92  my %managers;   # Ip -> manager names Line 92  my %managers;   # Ip -> manager names
   
 my %perlvar; # Will have the apache conf defined perl vars.  my %perlvar; # Will have the apache conf defined perl vars.
   
   my $dist;
   
 #  #
 #   The hash below is used for command dispatching, and is therefore keyed on the request keyword.  #   The hash below is used for command dispatching, and is therefore keyed on the request keyword.
 #    Each element of the hash contains a reference to an array that contains:  #    Each element of the hash contains a reference to an array that contains:
Line 1646  sub read_lonnet_global { Line 1648  sub read_lonnet_global {
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my $requested = &Apache::lonnet::thaw_unescape($tail);      my $requested = &Apache::lonnet::thaw_unescape($tail);
     my $result;      my $result;
       my %packagevars = (
                           spareid => \%Apache::lonnet::spareid,
                           perlvar => \%Apache::lonnet::perlvar,
                         );
       my %limit_to = (
                       perlvar => {
                                    lonOtherAuthen => 1,
                                    lonBalancer    => 1,
                                    lonVersion     => 1,
                                    lonSysEMail    => 1,
                                    lonHostID      => 1,
                                    lonRole        => 1,
                                    lonDefDomain   => 1,
                                    lonLoadLim     => 1,
                                    lonUserLoadLim => 1,
                                  }
                     );
     if (ref($requested) eq 'HASH') {      if (ref($requested) eq 'HASH') {
         foreach my $what (keys(%{$requested})) {          foreach my $what (keys(%{$requested})) {
             my $type = $requested->{$what};  
             my $lonnetglobal = 'Apache::lonnet::'.$what;  
             my $response;              my $response;
             if ($type eq 'HASH') {              my $items = {};
                 if (defined(%{$lonnetglobal})) {              if (exists($packagevars{$what})) {
                     my $hashref = \%{$lonnetglobal};                  if (ref($limit_to{$what}) eq 'HASH') {
                     $response = &Apache::lonnet::freeze_escape($hashref);                      foreach my $varname (keys(%{$packagevars{$what}})) {
                           if ($limit_to{$what}{$varname}) {
                               $items->{$varname} = $packagevars{$what}{$varname};
                           }
                       }
                   } else {
                       $items = $packagevars{$what};
                 }                  }
             } else {                  if ($what eq 'perlvar') {
                 if (defined(${$lonnetglobal})) {                      if (!exists($packagevars{$what}{'lonBalancer'})) {
                     $response = &escape(${$item});                          if ($dist =~ /^(centos|rhes|fedora|scientific)/) {
                               my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf');
                               if (ref($othervarref) eq 'HASH') {
                                   $items->{'lonBalancer'} = $othervarref->{'lonBalancer'};
                               }
                           }
                       }
                 }                  }
                   $response = &Apache::lonnet::freeze_escape($items);
             }              }
               $result .= &escape($what).'='.$response.'&';
         }          }
         $result .= &escape($what).'='.$response.'&';  
     }      }
     $result =~ s/\&$//;      $result =~ s/\&$//;
     &Reply($client,\$result,$userinput);      &Reply($client,\$result,$userinput);
Line 1670  sub read_lonnet_global { Line 1700  sub read_lonnet_global {
 }  }
 &register_handler("readlonnetglobal", \&read_lonnet_global, 0, 1, 0);  &register_handler("readlonnetglobal", \&read_lonnet_global, 0, 1, 0);
   
   sub server_devalidatecache_handler {
       my ($cmd,$tail,$client) = @_;
       my $userinput = "$cmd:$tail";
       my ($name,$id) = map { &unescape($_); } split(/:/,$tail);
       &Apache::lonnet::devalidate_cache_new($name,$id);
       my $result = 'ok';
       &Reply($client,\$result,$userinput);
       return 1;
   }
   &register_handler("devalidatecache", \&server_devalidatecache_handler, 0, 1, 0);
   
 sub server_timezone_handler {  sub server_timezone_handler {
     my ($cmd,$tail,$client) = @_;      my ($cmd,$tail,$client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
Line 6393  $SIG{USR2} = \&UpdateHosts; Line 6434  $SIG{USR2} = \&UpdateHosts;
 &Apache::lonnet::load_hosts_tab();  &Apache::lonnet::load_hosts_tab();
 my %iphost = &Apache::lonnet::get_iphost(1);  my %iphost = &Apache::lonnet::get_iphost(1);
   
 my $dist=`$perlvar{'lonDaemons'}/distprobe`;  $dist=`$perlvar{'lonDaemons'}/distprobe`;
   
 my $arch = `uname -i`;  my $arch = `uname -i`;
 chomp($arch);  chomp($arch);
Line 6689  sub is_author { Line 6730  sub is_author {
 }  }
 #  #
 #   Checks to see if the input roleput request was to set  #   Checks to see if the input roleput request was to set
 # an author role.  If so, invokes the lchtmldir script to set  # an author role.  If so, creates construction space 
 # up a correct public_html   
 # Parameters:  # Parameters:
 #    request   - The request sent to the rolesput subchunk.  #    request   - The request sent to the rolesput subchunk.
 #                We're looking for  /domain/_au  #                We're looking for  /domain/_au
Line 6700  sub is_author { Line 6740  sub is_author {
 #  #
 sub manage_permissions {  sub manage_permissions {
     my ($request, $domain, $user, $authtype) = @_;      my ($request, $domain, $user, $authtype) = @_;
   
     &Debug("manage_permissions: $request $domain $user $authtype");  
   
     # See if the request is of the form /$domain/_au      # See if the request is of the form /$domain/_au
     if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput...      if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput...
  my $execdir = $perlvar{'lonDaemons'};          my $path="/home/httpd/html/priv/".$domain;
  my $userhome= "/home/$user" ;          unless (-e $path) {        
  &logthis("system $execdir/lchtmldir $userhome $user $authtype");             mkdir($path);
  &Debug("Setting homedir permissions for $userhome");          }
  system("$execdir/lchtmldir $userhome $user $authtype");          unless (-e $path.'/'.$user) {
              mkdir($path.'/'.$user);
           }
     }      }
 }  }
   

Removed from v.1.477  
changed lines
  Added in v.1.482


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