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

Diff for /loncom/lond between versions 1.272 and 1.278

version 1.272, 2005/01/01 02:31:05 version 1.278, 2005/02/08 17:58:42
Line 65  my $currentdomainid; Line 65  my $currentdomainid;
   
 my $client;  my $client;
 my $clientip; # IP address of client.  my $clientip; # IP address of client.
 my $clientdns; # DNS name of client.  
 my $clientname; # LonCAPA name of client.  my $clientname; # LonCAPA name of client.
   
 my $server;  my $server;
Line 178  sub ResetStatistics { Line 177  sub ResetStatistics {
 #   $initcmd     - The full text of the init command.  #   $initcmd     - The full text of the init command.
 #  #
 # Implicit inputs:  # Implicit inputs:
 #    $clientdns  - The DNS name of the remote client.  
 #    $thisserver - Our DNS name.  #    $thisserver - Our DNS name.
 #  #
 # Returns:  # Returns:
Line 187  sub ResetStatistics { Line 185  sub ResetStatistics {
 #  #
 sub LocalConnection {  sub LocalConnection {
     my ($Socket, $initcmd) = @_;      my ($Socket, $initcmd) = @_;
     Debug("Attempting local connection: $initcmd client: $clientdns me: $thisserver");      Debug("Attempting local connection: $initcmd client: $clientip me: $thisserver");
     if($clientdns ne $thisserver) {      if($clientip ne "127.0.0.1") {
  &logthis('<font color="red"> LocalConnection rejecting non local: '   &logthis('<font color="red"> LocalConnection rejecting non local: '
  ."$clientdns ne $thisserver </font>");   ."$clientip ne $thisserver </font>");
  close $Socket;   close $Socket;
  return undef;   return undef;
     }  else {      }  else {
Line 1799  sub change_authentication_handler { Line 1797  sub change_authentication_handler {
     #  to take ownership of the construction space back to www:www      #  to take ownership of the construction space back to www:www
     #      #
   
     if( ($oldauth =~ /^unix/) && ($umode eq "internal")) { # unix -> internal      if( (($oldauth =~ /^unix/) && ($umode eq "internal")) ||
    (($oldauth =~ /^internal/) && ($umode eq "unix")) ) { 
  if(&is_author($udom, $uname)) {   if(&is_author($udom, $uname)) {
     &Debug(" Need to manage author permissions...");      &Debug(" Need to manage author permissions...");
     &manage_permissions("/$udom/_au", $udom, $uname, "internal:");      &manage_permissions("/$udom/_au", $udom, $uname, "$umode:");
  }   }
     }      }
                 
Line 3140  sub put_course_id_handler { Line 3139  sub put_course_id_handler {
             my ($key,$courseinfo) = split(/=/,$pair,2);              my ($key,$courseinfo) = split(/=/,$pair,2);
             $courseinfo =~ s/=/:/g;              $courseinfo =~ s/=/:/g;
   
             my @current_items = split/:/,$hashref->{$key};              my @current_items = split(/:/,$hashref->{$key});
             shift @current_items; # remove description              shift(@current_items); # remove description
             pop @current_items;   # remove last access              pop(@current_items);   # remove last access
             my $numcurrent = scalar(@current_items);              my $numcurrent = scalar(@current_items);
   
             my @new_items = split/:/,$courseinfo;              my @new_items = split(/:/,$courseinfo);
             my $numnew = scalar(@new_items);              my $numnew = scalar(@new_items);
             if ($numcurrent > 0) {              if ($numcurrent > 0) {
                 if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier                  if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier
Line 3198  sub put_course_id_handler { Line 3197  sub put_course_id_handler {
 #                 owner    - optional supplied username of owner to filter  #                 owner    - optional supplied username of owner to filter
 #                            the dump.  Only courses for which the course   #                            the dump.  Only courses for which the course 
 #                            owner matches the supplied username will be  #                            owner matches the supplied username will be
 #                            returned. Implicit assumption that owner is a user  #                            returned. Implicit assumption that owner
 #                            in the domain in which the course database is defined.          #                            is a user in the domain in which the
   #                            course database is defined.
 #     $client  - The socket open on the client.  #     $client  - The socket open on the client.
 # Returns:  # Returns:
 #    1     - Continue processing.  #    1     - Continue processing.
Line 3233  sub dump_course_id_handler { Line 3233  sub dump_course_id_handler {
     if ($hashref) {      if ($hashref) {
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
     my ($descr,$lasttime,$inst_code,$owner);      my ($descr,$lasttime,$inst_code,$owner);
             my @courseitems = split/:/,$value;              my @courseitems = split(/:/,$value);
             $descr = shift @courseitems;              $lasttime = pop(@courseitems);
             $lasttime = pop @courseitems;      ($descr,$inst_code,$owner)=@courseitems;
             if (@courseitems > 0) {  
                 $inst_code = shift @courseitems;  
             }  
             if (@courseitems > 0) {  
                 $owner = shift @courseitems;  
             }  
     if ($lasttime<$since) { next; }      if ($lasttime<$since) { next; }
             my $match = 1;              my $match = 1;
     unless ($description eq '.') {      unless ($description eq '.') {
Line 4285  sub ReadHostTable { Line 4279  sub ReadHostTable {
     my $myloncapaname = $perlvar{'lonHostID'};      my $myloncapaname = $perlvar{'lonHostID'};
     Debug("My loncapa name is : $myloncapaname");      Debug("My loncapa name is : $myloncapaname");
     while (my $configline=<CONFIG>) {      while (my $configline=<CONFIG>) {
  if (!($configline =~ /^\s*\#/)) {   if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) {
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);      my ($id,$domain,$role,$name)=split(/:/,$configline);
     chomp($ip); $ip=~s/\D+$//;      $name=~s/\s//g;
       my (undef,undef,undef,undef,$ip) = gethostbyname($name);
       if (length($ip) ne 4) {
    &logthis("Skipping host $id name $name no IP $ip found\n");
    next;
       }
       $ip=inet_ntoa($ip);
     $hostid{$ip}=$id;         # LonCAPA name of host by IP.      $hostid{$ip}=$id;         # LonCAPA name of host by IP.
     $hostdom{$id}=$domain;    # LonCAPA domain name of host.       $hostdom{$id}=$domain;    # LonCAPA domain name of host. 
     $hostip{$id}=$ip;      # IP address of host.      $hostip{$id}=$ip;         # IP address of host.
     $hostdns{$name} = $id;    # LonCAPA name of host by DNS.      $hostdns{$name} = $id;    # LonCAPA name of host by DNS.
   
     if ($id eq $perlvar{'lonHostID'}) {       if ($id eq $perlvar{'lonHostID'}) { 
Line 4471  sub logstatus { Line 4471  sub logstatus {
  flock(LOG,LOCK_EX);   flock(LOG,LOCK_EX);
  print LOG $$."\t".$clientname."\t".$currenthostid."\t"   print LOG $$."\t".$clientname."\t".$currenthostid."\t"
     .$status."\t".$lastlog."\t $keymode\n";      .$status."\t".$lastlog."\t $keymode\n";
  flock(DB,LOCK_UN);   flock(LOG,LOCK_UN);
  close(LOG);   close(LOG);
     }      }
     &status("Finished logging");      &status("Finished logging");
Line 4702  sub make_new_child { Line 4702  sub make_new_child {
     if (defined($iaddr)) {      if (defined($iaddr)) {
  $clientip  = inet_ntoa($iaddr);   $clientip  = inet_ntoa($iaddr);
  Debug("Connected with $clientip");   Debug("Connected with $clientip");
  $clientdns = gethostbyaddr($iaddr, AF_INET);  
  Debug("Connected with $clientdns by name");  
     } else {      } else {
  &logthis("Unable to determine clientip");   &logthis("Unable to determine clientip");
  $clientip='Unavailable';   $clientip='Unavailable';
Line 4743  sub make_new_child { Line 4741  sub make_new_child {
   
  ReadManagerTable; # May also be a manager!!   ReadManagerTable; # May also be a manager!!
   
  my $clientrec=($hostid{$clientip}     ne undef);   my $outsideip=$clientip;
  my $ismanager=($managers{$clientip}    ne undef);   if ($clientip eq '127.0.0.1') {
       $outsideip=$hostip{$perlvar{'lonHostID'}};
    }
   
    my $clientrec=($hostid{$outsideip}     ne undef);
    my $ismanager=($managers{$outsideip}    ne undef);
  $clientname  = "[unknonwn]";   $clientname  = "[unknonwn]";
  if($clientrec) { # Establish client type.   if($clientrec) { # Establish client type.
     $ConnectionType = "client";      $ConnectionType = "client";
     $clientname = $hostid{$clientip};      $clientname = $hostid{$outsideip};
     if($ismanager) {      if($ismanager) {
  $ConnectionType = "both";   $ConnectionType = "both";
     }      }
  } else {   } else {
     $ConnectionType = "manager";      $ConnectionType = "manager";
     $clientname = $managers{$clientip};      $clientname = $managers{$outsideip};
  }   }
  my $clientok;   my $clientok;
   
Removed from v.1.272  
changed lines
  Added in v.1.278

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