--- loncom/lond	2002/07/26 19:35:20	1.84
+++ loncom/lond	2002/08/09 10:05:00	1.87
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.84 2002/07/26 19:35:20 albertel Exp $
+# $Id: lond,v 1.87 2002/08/09 10:05:00 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -947,6 +947,50 @@ sub make_new_child {
 		       } else {
 			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
                    } elsif ($userinput =~ /^unsub/) {
                        my ($cmd,$fname)=split(/:/,$userinput);
@@ -1258,6 +1302,20 @@ sub make_new_child {
                        } else {
                            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
                    } elsif ($userinput =~ /^querysend/) {
                        my ($cmd,$query,
@@ -1510,6 +1568,51 @@ sub addline {
     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 {
     my ($fname,$clientip)=@_;
     my $result;