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

Diff for /loncom/lond between versions 1.85 and 1.86

version 1.85, 2002/08/01 18:44:19 version 1.86, 2002/08/08 13:45:21
Line 949  sub make_new_child { Line 949  sub make_new_child {
                        }                         }
 # -------------------------------------- fetch a user file from a remote server  # -------------------------------------- fetch a user file from a remote server
                    } elsif ($userinput =~ /^fetchuserfile/) {                     } elsif ($userinput =~ /^fetchuserfile/) {
                        my ($cmd,$fname)=split(/:/,$userinput);                        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  # ------------------------------------------ authenticate access to a user file
                    } elsif ($userinput =~ /^authuserfile/) {                     } elsif ($userinput =~ /^tokenauthuserfile/) {
                        my ($cmd,$fname,$session)=split(/:/,$userinput);                         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 1264  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 1516  sub addline { Line 1568  sub addline {
     return $found;      return $found;
 }  }
   
   sub getchat {
       my ($cdom,$cname)=@_;
       my @entries;
       if (open(CHATIN,&propath($cdom,$cname).'/chatroom.txt')) {
    while ($line=<CHATIN>) { push(@entries,$line); }
           close(CHATIN);
           return @entries;
       }
       return ();
   }
   
   sub chatadd {
       my ($cdom,$cname,$newchat)=@_;
       my @entries=&getchat($cdom,$cname);
       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;
       }
       push (@entries,$newid.':'.$newchat."\n");
       my $expired=$time-3600;
       open(CHATOUT,'>'.&propath($cdom,$cname).'/chatroom.txt');
       foreach (@entries) {
           my ($thistime)=($_=~/(\d+)\_/);
           if ($thistime>$expired) {
       print CHATOUT $_;
           }
       }
       close(CHATOUT);
   }
   
 sub unsub {  sub unsub {
     my ($fname,$clientip)=@_;      my ($fname,$clientip)=@_;
     my $result;      my $result;
Removed from v.1.85  
changed lines
  Added in v.1.86

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