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

Diff for /loncom/lond between versions 1.119 and 1.124

version 1.119, 2003/03/26 00:17:04 version 1.124, 2003/03/28 23:16:25
Line 73  my $DEBUG = 0;         # Non zero to ena Line 73  my $DEBUG = 0;         # Non zero to ena
 my $status='';  my $status='';
 my $lastlog='';  my $lastlog='';
   
   my $VERSION='$Revision$'; #' stupid emacs
   my $remoteVERSION;
 my $currenthostid;  my $currenthostid;
 my $currentdomainid;  my $currentdomainid;
 #  #
Line 515  while (1) { Line 517  while (1) {
     make_new_child($client);      make_new_child($client);
 }  }
   
 sub init_host_and_domain {  
     my ($remotereq) = @_;  
     my (undef,$hostid)=split(/:/,$remotereq);  
     if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }  
     if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {  
  $currenthostid=$hostid;  
  $currentdomainid=$hostdom{$hostid};  
  &logthis("Setting hostid to $hostid, and domain to $currentdomainid");  
     } else {  
  &logthis("Requested host id $hostid not an alias of ".  
  $perlvar{'lonHostID'}." refusing connection");  
  return 0;  
     }  
     return 1;  
 }  
   
 sub make_new_child {  sub make_new_child {
     my $client;      my $client;
     my $pid;      my $pid;
Line 592  sub make_new_child { Line 578  sub make_new_child {
       my $remotereq=<$client>;        my $remotereq=<$client>;
               $remotereq=~s/[^\w:]//g;                $remotereq=~s/[^\w:]//g;
               if ($remotereq =~ /^init/) {                if ($remotereq =~ /^init/) {
   if (!&init_host_and_domain($remotereq)) {    &sethost("sethost:$perlvar{'lonHostID'}");
       &status("Got bad init message, exiting");  
       print $client "refused\n";  
       $client->close();  
       &logthis("<font color=blue>WARNING: "  
        ."Bad init message $remotereq, closing connection</font>");  
       exit;  
   }  
   my $challenge="$$".time;    my $challenge="$$".time;
                   print $client "$challenge\n";                    print $client "$challenge\n";
                   &status(                    &status(
Line 1500  sub make_new_child { Line 1479  sub make_new_child {
                        print $client "ok\n";                         print $client "ok\n";
 # -------------------------------------------------------------------- chatretr  # -------------------------------------------------------------------- chatretr
                    } elsif ($userinput =~ /^chatretr/) {                     } elsif ($userinput =~ /^chatretr/) {
                        my ($cmd,$cdom,$cnum)=split(/\:/,$userinput);                         my 
                           ($cmd,$cdom,$cnum,$udom,$uname)=split(/\:/,$userinput);
                        my $reply='';                         my $reply='';
                        foreach (&getchat($cdom,$cnum)) {                         foreach (&getchat($cdom,$cnum,$udom,$uname)) {
    $reply.=&escape($_).':';     $reply.=&escape($_).':';
                        }                         }
                        $reply=~s/\:$//;                         $reply=~s/\:$//;
Line 1581  sub make_new_child { Line 1561  sub make_new_child {
                                    $qresult.=$key.'='.$descr.'&';                                     $qresult.=$key.'='.$descr.'&';
                                } else {                                 } else {
                                    my $unescapeVal = &unescape($descr);                                     my $unescapeVal = &unescape($descr);
                                    if (eval('$unescapeVal=~/$description/')) {                                     if (eval('$unescapeVal=~/$description/i')) {
                                        $qresult.="$key=$descr&";                                         $qresult.="$key=$descr&";
                                    }                                     }
                                }                                 }
Line 1739  sub make_new_child { Line 1719  sub make_new_child {
                        $client->close();                         $client->close();
        last;         last;
 # ------------------------------------------------------------- unknown command  # ------------------------------------------------------------- unknown command
      } elsif ($userinput =~ /^sethost:/) {
          print $client &sethost($userinput)."\n";
      } elsif ($userinput =~/^version:/) {
          print $client &version($userinput)."\n";
                    } else {                     } else {
                        # unknown command                         # unknown command
                        print $client "unknown_cmd\n";                         print $client "unknown_cmd\n";
Line 1850  sub addline { Line 1834  sub addline {
 }  }
   
 sub getchat {  sub getchat {
     my ($cdom,$cname)=@_;      my ($cdom,$cname,$udom,$uname)=@_;
     my %hash;      my %hash;
     my $proname=&propath($cdom,$cname);      my $proname=&propath($cdom,$cname);
     my @entries=();      my @entries=();
Line 1859  sub getchat { Line 1843  sub getchat {
  @entries=map { $_.':'.$hash{$_} } sort keys %hash;   @entries=map { $_.':'.$hash{$_} } sort keys %hash;
  untie %hash;   untie %hash;
     }      }
     return @entries;      my @participants=();
       $cutoff=time-60;
       if (tie(%hash,'GDBM_File',"$proname/nohist_inchatroom.db",
       &GDBM_WRCREAT(),0640)) {
           $hash{$uname.':'.$udom}=time;
           foreach (sort keys %hash) {
       if ($hash{$_}>$cutoff) {
    $participants[$#participants+1]='active_participant:'.$_;
               }
           }
           untie %hash;
       }
       return (@participants,@entries);
 }  }
   
 sub chatadd {  sub chatadd {
Line 2054  sub make_passwd_file { Line 2050  sub make_passwd_file {
     return $result;      return $result;
 }  }
   
   sub sethost {
       my ($remotereq) = @_;
       my (undef,$hostid)=split(/:/,$remotereq);
       if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
       if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
    $currenthostid=$hostid;
    $currentdomainid=$hostdom{$hostid};
    &logthis("Setting hostid to $hostid, and domain to $currentdomainid");
       } else {
    &logthis("Requested host id $hostid not an alias of ".
    $perlvar{'lonHostID'}." refusing connection");
    return 'unable_to_set';
       }
       return 'ok';
   }
   
   sub version {
       my ($userinput)=@_;
       $remoteVERSION=(split(/:/,$userinput))[1];
       return "version:$VERSION";
   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
 =head1 NAME  =head1 NAME
Removed from v.1.119  
changed lines
  Added in v.1.124

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