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

Diff for /loncom/lond between versions 1.270 and 1.280

version 1.270, 2004/12/28 15:09:38 version 1.280, 2005/03/03 23:21:51
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 1411  sub du_handler { Line 1409  sub du_handler {
 &register_handler("du", \&du_handler, 0, 1, 0);  &register_handler("du", \&du_handler, 0, 1, 0);
   
 #  #
   # The ls_handler routine should be considered obosolete and is retained
   # for communication with legacy servers.  Please see the ls2_handler.
   #
 #   ls  - list the contents of a directory.  For each file in the  #   ls  - list the contents of a directory.  For each file in the
 #    selected directory the filename followed by the full output of  #    selected directory the filename followed by the full output of
 #    the stat function is returned.  The returned info for each  #    the stat function is returned.  The returned info for each
Line 1427  sub du_handler { Line 1428  sub du_handler {
 #   The reply is written to  $client.  #   The reply is written to  $client.
 #  #
 sub ls_handler {  sub ls_handler {
       # obsoleted by ls2_handler
     my ($cmd, $ulsdir, $client) = @_;      my ($cmd, $ulsdir, $client) = @_;
   
     my $userinput = "$cmd:$ulsdir";      my $userinput = "$cmd:$ulsdir";
Line 1473  sub ls_handler { Line 1475  sub ls_handler {
 }  }
 &register_handler("ls", \&ls_handler, 0, 1, 0);  &register_handler("ls", \&ls_handler, 0, 1, 0);
   
   #
   # Please also see the ls_handler, which this routine obosolets.
   # ls2_handler differs from ls_handler in that it escapes its return 
   # values before concatenating them together with ':'s.
   #
   #   ls2  - list the contents of a directory.  For each file in the
   #    selected directory the filename followed by the full output of
   #    the stat function is returned.  The returned info for each
   #    file are separated by ':'.  The stat fields are separated by &'s.
   # Parameters:
   #    $cmd        - The command that dispatched us (ls).
   #    $ulsdir     - The directory path to list... I'm not sure what this
   #                  is relative as things like ls:. return e.g.
   #                  no_such_dir.
   #    $client     - Socket open on the client.
   # Returns:
   #     1 - indicating that the daemon should not disconnect.
   # Side Effects:
   #   The reply is written to  $client.
   #
   sub ls2_handler {
       my ($cmd, $ulsdir, $client) = @_;
   
       my $userinput = "$cmd:$ulsdir";
   
       my $obs;
       my $rights;
       my $ulsout='';
       my $ulsfn;
       if (-e $ulsdir) {
           if(-d $ulsdir) {
               if (opendir(LSDIR,$ulsdir)) {
                   while ($ulsfn=readdir(LSDIR)) {
                       undef $obs, $rights; 
                       my @ulsstats=stat($ulsdir.'/'.$ulsfn);
                       #We do some obsolete checking here
                       if(-e $ulsdir.'/'.$ulsfn.".meta") { 
                           open(FILE, $ulsdir.'/'.$ulsfn.".meta");
                           my @obsolete=<FILE>;
                           foreach my $obsolete (@obsolete) {
                               if($obsolete =~ m|(<obsolete>)(on)|) { $obs = 1; } 
                               if($obsolete =~ m|(<copyright>)(default)|) {
                                   $rights = 1;
                               }
                           }
                       }
                       my $tmp = $ulsfn.'&'.join('&',@ulsstats);
                       if ($obs    eq '1') { $tmp.="&1"; } else { $tmp.="&0"; }
                       if ($rights eq '1') { $tmp.="&1"; } else { $tmp.="&0"; }
                       $ulsout.= &escape($tmp).':';
                   }
                   closedir(LSDIR);
               }
           } else {
               my @ulsstats=stat($ulsdir);
               $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
           }
       } else {
           $ulsout='no_such_dir';
      }
      if ($ulsout eq '') { $ulsout='empty'; }
      &Reply($client, "$ulsout\n", $userinput); # This supports debug logging.
      return 1;
   }
   &register_handler("ls2", \&ls2_handler, 0, 1, 0);
   
 #   Process a reinit request.  Reinit requests that either  #   Process a reinit request.  Reinit requests that either
 #   lonc or lond be reinitialized so that an updated   #   lonc or lond be reinitialized so that an updated 
 #   host.tab or domain.tab can be processed.  #   host.tab or domain.tab can be processed.
Line 1799  sub change_authentication_handler { Line 1867  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 3108  sub reply_query_handler { Line 3177  sub reply_query_handler {
 #   $tail     - Tail of the command.  In this case consists of a colon  #   $tail     - Tail of the command.  In this case consists of a colon
 #               separated list contaning the domain to apply this to and  #               separated list contaning the domain to apply this to and
 #               an ampersand separated list of keyword=value pairs.  #               an ampersand separated list of keyword=value pairs.
   #               Each value is a colon separated list that includes:  
   #               description, institutional code and course owner.
   #               For backward compatibility with versions included
   #               in LON-CAPA 1.1.X (and earlier) and 1.2.X, institutional
   #               code and/or course owner are preserved from the existing 
   #               record when writing a new record in response to 1.1 or 
   #               1.2 implementations of lonnet::flushcourselogs().   
   #                      
 #   $client   - Socket open on the client.  #   $client   - Socket open on the client.
 # Returns:  # Returns:
 #   1    - indicating that processing should continue  #   1    - indicating that processing should continue
Line 3129  sub put_course_id_handler { Line 3206  sub put_course_id_handler {
     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());      my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
     if ($hashref) {      if ($hashref) {
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
             my ($key,$courseinfo) = split(/=/,$pair);              my ($key,$courseinfo) = split(/=/,$pair,2);
               $courseinfo =~ s/=/:/g;
   
               my @current_items = split(/:/,$hashref->{$key});
               shift(@current_items); # remove description
               pop(@current_items);   # remove last access
               my $numcurrent = scalar(@current_items);
   
               my @new_items = split(/:/,$courseinfo);
               my $numnew = scalar(@new_items);
               if ($numcurrent > 0) {
                   if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier
                       $courseinfo .= ':'.join(':',@current_items);
                   } elsif ($numnew == 2) { # flushcourselogs() from 1.2.X
                       $courseinfo .= ':'.$current_items[$numcurrent-1];
                   }
               }
     $hashref->{$key}=$courseinfo.':'.$now;      $hashref->{$key}=$courseinfo.':'.$now;
  }   }
  if (untie(%$hashref)) {   if (untie(%$hashref)) {
Line 3168  sub put_course_id_handler { Line 3261  sub put_course_id_handler {
 #                 description - regular expression that is used to filter  #                 description - regular expression that is used to filter
 #                            the dump.  Only keywords matching this regexp  #                            the dump.  Only keywords matching this regexp
 #                            will be used.  #                            will be used.
   #                 institutional code - optional supplied code to filter 
   #                            the dump. Only courses with an institutional code 
   #                            that match the supplied code will be returned.
   #                 owner    - optional supplied username of owner to filter
   #                            the dump.  Only courses for which the course 
   #                            owner matches the supplied username will be
   #                            returned. Implicit assumption that owner
   #                            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 3201  sub dump_course_id_handler { Line 3303  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);
             if ($value =~  m/^([^\:]*):([^\:]*):([^\:]*):(\d+)$/) {              my @courseitems = split(/:/,$value);
                 ($descr,$inst_code,$owner,$lasttime)=($1,$2,$3,$4);              $lasttime = pop(@courseitems);
     } elsif ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) {      ($descr,$inst_code,$owner)=@courseitems;
  ($descr,$inst_code,$lasttime)=($1,$2,$3);  
     } else {  
  ($descr,$lasttime) = split(/\:/,$value);  
     }  
     if ($lasttime<$since) { next; }      if ($lasttime<$since) { next; }
             my $match = 1;              my $match = 1;
     unless ($description eq '.') {      unless ($description eq '.') {
Line 4251  sub ReadHostTable { Line 4349  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 $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 4437  sub logstatus { Line 4541  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 4668  sub make_new_child { Line 4772  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 4709  sub make_new_child { Line 4811  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.270  
changed lines
  Added in v.1.280

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