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

Diff for /loncom/lond between versions 1.472 and 1.485

version 1.472, 2011/05/13 02:58:02 version 1.485, 2011/11/17 18:22:36
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 421  sub ReadManagerTable { Line 423  sub ReadManagerTable {
   
    my $tablename = $perlvar{'lonTabDir'}."/managers.tab";     my $tablename = $perlvar{'lonTabDir'}."/managers.tab";
    if (!open (MANAGERS, $tablename)) {     if (!open (MANAGERS, $tablename)) {
        if (&loncapa_dns_server()) {         my $hostname = &Apache::lonnet::hostname($perlvar{'lonHostID'});
          if (&Apache::lonnet::is_LC_dns($hostname)) {
            &logthis('<font color="red">No manager table.  Nobody can manage!!</font>');             &logthis('<font color="red">No manager table.  Nobody can manage!!</font>');
        }         }
        return;         return;
Line 677  sub PushFile { Line 680  sub PushFile {
  return "error:$!";   return "error:$!";
     } else {      } else {
  &logthis('<font color="green"> Installed new '.$tablefile   &logthis('<font color="green"> Installed new '.$tablefile
  ."</font>");   ." - transaction by: $clientname ($clientip)</font>");
         my $adminmail = $perlvar{'lonAdmEMail'};          my $adminmail = $perlvar{'lonAdmEMail'};
         my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});          my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
         if ($admindom ne '') {          if ($admindom ne '') {
Line 691  sub PushFile { Line 694  sub PushFile {
         }          }
         if ($adminmail =~ /^[^\@]+\@[^\@]+$/) {          if ($adminmail =~ /^[^\@]+\@[^\@]+$/) {
             my $msg = new Mail::Send;              my $msg = new Mail::Send;
             my $senderaddress =  $perlvar{'lonSysEMail'};  
             $msg->to($adminmail);              $msg->to($adminmail);
             $msg->subject('LON-CAPA DNS update on '.$perlvar{'lonHostID'});              $msg->subject('LON-CAPA DNS update on '.$perlvar{'lonHostID'});
             if ($senderaddress) {  
                  $msg->add('From',$senderaddress);  
             }  
             $msg->add('Content-type','text/plain; charset=UTF-8');              $msg->add('Content-type','text/plain; charset=UTF-8');
             if (my $fh = $msg->open()) {              if (my $fh = $msg->open()) {
                 print $fh 'Update to '.$tablefile.' from Cluster Manager '.                  print $fh 'Update to '.$tablefile.' from Cluster Manager '.
                           $client."\n";                            "$clientname ($clientip)\n";
                 $fh->close;                  $fh->close;
             }              }
         }          }
Line 712  sub PushFile { Line 711  sub PushFile {
   
 }  }
   
 sub loncapa_dns_server {  
     my $lonhost = &Apache::lonnet::get_host_ip($perlvar{'lonHostID'});  
     my $hoststable = "$perlvar{'lonTabDir'}/hosts.tab";  
     my $is_dns_server;  
     if (!open(HOSTS,"<$hoststable")) {  
         &logthis('<font color="yellow">Could not open hosts.tab to check for LON-CAPA DNS servers.</font>');  
         while (my $host = <HOSTS>) {  
             chomp($host);  
             $host =~ s/(^\s+|\s+$)//g;  
             if ($host =~ /^\Q^$lonhost\E/) {  
                 $is_dns_server = 1;  
                 last;  
             }  
         }  
         close(HOSTS);  
     }  
     return $is_dns_server;  
 }  
   
 #  #
 #  Called to re-init either lonc or lond.  #  Called to re-init either lonc or lond.
 #  #
Line 1663  sub ls3_handler { Line 1643  sub ls3_handler {
 }  }
 &register_handler("ls3", \&ls3_handler, 0, 1, 0);  &register_handler("ls3", \&ls3_handler, 0, 1, 0);
   
   sub read_lonnet_global {
       my ($cmd,$tail,$client) = @_;
       my $userinput = "$cmd:$tail";
       my $requested = &Apache::lonnet::thaw_unescape($tail);
       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') {
           foreach my $what (keys(%{$requested})) {
               my $response;
               my $items = {};
               if (exists($packagevars{$what})) {
                   if (ref($limit_to{$what}) eq 'HASH') {
                       foreach my $varname (keys(%{$packagevars{$what}})) {
                           if ($limit_to{$what}{$varname}) {
                               $items->{$varname} = $packagevars{$what}{$varname};
                           }
                       }
                   } else {
                       $items = $packagevars{$what};
                   }
                   if ($what eq 'perlvar') {
                       if (!exists($packagevars{$what}{'lonBalancer'})) {
                           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 =~ s/\&$//;
       &Reply($client,\$result,$userinput);
       return 1;
   }
   &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 2025  sub add_user_handler { Line 2073  sub add_user_handler {
     ."makeuser";      ."makeuser";
     }      }
     unless ($fperror) {      unless ($fperror) {
  my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);   my $result=&make_passwd_file($uname,$udom,$umode,$npass, $passfilename);
  &Reply($client,\$result, $userinput);     #BUGBUG - could be fail   &Reply($client,\$result, $userinput);     #BUGBUG - could be fail
     } else {      } else {
  &Failure($client, \$fperror, $userinput);   &Failure($client, \$fperror, $userinput);
Line 2100  sub change_authentication_handler { Line 2148  sub change_authentication_handler {
     &Failure($client, \$result);      &Failure($client, \$result);
  }   }
     } else {      } else {
  my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);   my $result=&make_passwd_file($uname,$udom,$umode,$npass,$passfilename);
  #   #
  #  If the current auth mode is internal, and the old auth mode was   #  If the current auth mode is internal, and the old auth mode was
  #  unix, or krb*,  and the user is an author for this domain,   #  unix, or krb*,  and the user is an author for this domain,
Line 2300  sub fetch_user_file_handler { Line 2348  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 $remoteurl='http://'.$clientip.'/userfiles/'.$fname;          my $clientprotocol=$Apache::lonnet::protocol{$clientname};
           $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 3947  sub dump_course_id_handler { Line 3997  sub dump_course_id_handler {
         $creationcontext = '.';          $creationcontext = '.';
     }      }
     my $unpack = 1;      my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' &&       if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && 
         $typefilter eq '.') {          $typefilter eq '.') {
         $unpack = 0;          $unpack = 0;
     }      }
Line 6114  sub HUPSMAN {                      # sig Line 6164  sub HUPSMAN {                      # sig
 #  a setuid perl script that can be root for us to do this job.  #  a setuid perl script that can be root for us to do this job.
 #  #
 sub ReloadApache {  sub ReloadApache {
     my $execdir = $perlvar{'lonDaemons'};  # --------------------------- Handle case of another apachereload process (locking)
     my $script  = $execdir."/apachereload";      if (&LONCAPA::try_to_lock('/tmp/lock_apachereload')) {
     system($script);          my $execdir = $perlvar{'lonDaemons'};
           my $script  = $execdir."/apachereload";
           system($script);
           unlink('/tmp/lock_apachereload'); #  Remove the lock file.
       }
 }  }
   
 #  #
Line 6380  $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);
 if ($arch eq 'unknown') {  if ($arch eq 'unknown') {
     $arch = `uname -m`;      $arch = `uname -m`;
       chomp($arch);
 }  }
   
 # --------------------------------------------------------------  # --------------------------------------------------------------
Line 6674  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 6685  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=$perlvar{'lonDocRoot'}."/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);
           }
     }      }
 }  }
   
Line 7183  sub subscribe { Line 7237  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/;
  $fname="http://".&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;                  my $protocol = $Apache::lonnet::protocol{$perlvar{'lonHostID'}};
                   $protocol = 'http' if ($protocol ne 'https');
    $fname=$protocol.'://'.&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;
  $result="$fname\n";   $result="$fname\n";
     }      }
  } else {   } else {
Line 7225  sub change_unix_password { Line 7281  sub change_unix_password {
   
   
 sub make_passwd_file {  sub make_passwd_file {
     my ($uname, $umode,$npass,$passfilename)=@_;      my ($uname,$udom,$umode,$npass,$passfilename)=@_;
     my $result="ok";      my $result="ok";
     if ($umode eq 'krb4' or $umode eq 'krb5') {      if ($umode eq 'krb4' or $umode eq 'krb5') {
  {   {
Line 7266  sub make_passwd_file { Line 7322  sub make_passwd_file {
     #      #
     my $uid = getpwnam($uname);      my $uid = getpwnam($uname);
     if((defined $uid) && ($uid == 0)) {      if((defined $uid) && ($uid == 0)) {
  &logthis(">>>Attempted to create privilged account blocked");   &logthis(">>>Attempt to create privileged account blocked");
  return "no_priv_account_error\n";   return "no_priv_account_error\n";
     }      }
   
Line 7278  sub make_passwd_file { Line 7334  sub make_passwd_file {
  &Debug("user  = ".$uname.", Password =". $npass);   &Debug("user  = ".$uname.", Password =". $npass);
  my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");   my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");
  print $se "$uname\n";   print $se "$uname\n";
                   print $se "$udom\n";
  print $se "$npass\n";   print $se "$npass\n";
  print $se "$npass\n";   print $se "$npass\n";
  print $se "$lc_error_file\n"; # Status -> unique file.   print $se "$lc_error_file\n"; # Status -> unique file.
Removed from v.1.472  
changed lines
  Added in v.1.485

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