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

Diff for /loncom/lond between versions 1.84 and 1.87

version 1.84, 2002/07/26 19:35:20 version 1.87, 2002/08/09 10:05:00
Line 947  sub make_new_child { Line 947  sub make_new_child {
        } else {         } else {
  print $client "rejected\n";   print $client "rejected\n";
                        }                         }
   # -------------------------------------- fetch a user file from a remote server
                      } elsif ($userinput =~ /^fetchuserfile/) {
                         my ($cmd,$fname)=split(/:/,$userinput);
         my ($udom,$uname,$ufile)=split(/\//,$fname);
                         my $udir=propath($udom,$uname).'/userfiles';
                         unless (-e $udir) { mkdir($udir); }
                          if (-e $udir) {
                          $ufile=~s/^[\.\~]+//;
                          $ufile=~s/\///g;
                          my $transname=$udir.'/'.$ufile;
                          my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
                                my $response;
                                 {
                                my $ua=new LWP::UserAgent;
                                my $request=new HTTP::Request('GET',"$remoteurl");
                                $response=$ua->request($request,$transname);
         }
                                if ($response->is_error()) {
    unlink($transname);
                                    my $message=$response->status_line;
                                    &logthis(
                                     "LWP GET: $message for $fname ($remoteurl)");
    print $client "failed\n";
                                } else {
                                    print $client "ok\n";
                                }
                        } else {
                          print $client "not_home\n";
                        } 
   # ------------------------------------------ authenticate access to a user file
                      } elsif ($userinput =~ /^tokenauthuserfile/) {
                          my ($cmd,$fname,$session)=split(/:/,$userinput);
                          chomp($session);
                          $reply='non_auth';
                          if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
                                         $session.'.id')) {
                           while ($line=<ENVIN>) {
      if ($line=~/userfile\.$fname\=/) { $reply='ok'; }
                           }
                           close(ENVIN);
                           print $client $reply."\n";
          } else {
    print $client "invalid_token\n";
                          }
 # ----------------------------------------------------------------- unsubscribe  # ----------------------------------------------------------------- unsubscribe
                    } elsif ($userinput =~ /^unsub/) {                     } elsif ($userinput =~ /^unsub/) {
                        my ($cmd,$fname)=split(/:/,$userinput);                         my ($cmd,$fname)=split(/:/,$userinput);
Line 1258  sub make_new_child { Line 1302  sub make_new_child {
                        } else {                         } else {
                            print $client "error:$!\n";                             print $client "error:$!\n";
                        }                         }
   # -------------------------------------------------------------------- chatsend
                      } elsif ($userinput =~ /^chatsend/) {
                          my ($cmd,$cdom,$cnum,$newpost)=split(/\:/,$userinput);
                          &chatadd($cdom,$cnum,$newpost);
                          print $client "ok\n";
   # -------------------------------------------------------------------- chatretr
                      } elsif ($userinput =~ /^chatretr/) {
                          my ($cmd,$cdom,$cnum)=split(/\:/,$userinput);
                          my $reply='';
                          foreach (&getchat($cdom,$cnum)) {
      $reply.=&escape($_).':';
                          }
                          $reply=~s/\:$//;
                          print $client $reply."\n";
 # ------------------------------------------------------------------- querysend  # ------------------------------------------------------------------- querysend
                    } elsif ($userinput =~ /^querysend/) {                     } elsif ($userinput =~ /^querysend/) {
                        my ($cmd,$query,                         my ($cmd,$query,
Line 1510  sub addline { Line 1568  sub addline {
     return $found;      return $found;
 }  }
   
   sub getchat {
       my ($cdom,$cname)=@_;
       my %hash;
       my $proname=&propath($cdom,$cname);
       my @entries=();
       if 
        (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",&GDBM_READER(),0640))
       {
    @entries=map { $_.':'.$hash{$_} } sort keys %hash;
            untie %hash;
       }
       return @entries;
   }
   
   sub chatadd {
     my ($cdom,$cname,$newchat)=@_;
     my %hash;
     my $proname=&propath($cdom,$cname);
     my @entries=();
     if 
     (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",&GDBM_WRCREAT(),0640))
      {
       @entries=map { $_.':'.$hash{$_} } sort keys %hash;
       my $time=time;
       my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
       my ($thentime,$idnum)=split(/\_/,$lastid);
       my $newid=$time.'_000000';
       if ($thentime==$time) {
    $idnum=~s/^0+//;
           $idnum++;
           $idnum=substr('000000'.$idnum,-6,6);
           $newid=$time.'_'.$idnum;
       }
       $hash{$newid}=$newchat;
       my $expired=$time-3600;
       foreach (keys %hash) {
           my ($thistime)=($_=~/(\d+)\_/);
           if ($thistime<$expired) {
      undef $hash{$_};
           }
       }
       untie %hash;
      }
   }
   
 sub unsub {  sub unsub {
     my ($fname,$clientip)=@_;      my ($fname,$clientip)=@_;
     my $result;      my $result;
Removed from v.1.84  
changed lines
  Added in v.1.87

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