[LON-CAPA-cvs] cvs: loncom / lond

foxr lon-capa-cvs@mail.lon-capa.org
Tue, 24 Aug 2004 10:59:50 -0000


This is a MIME encoded message

--foxr1093345190
Content-Type: text/plain

foxr		Tue Aug 24 06:59:50 2004 EDT

  Modified files:              
    /loncom	lond 
  Log:
  - Turn off DEBUG so others won't get annoyed.
  - Merge in changes to the Josh-ls request processing to a new
    handlerized ls request processor.
  - Remove all the old code that used to do the
    idput, idget, tmpput, tmpget, tmpdel, and ls request
    processing since those have been handlerized.
  
  
  
--foxr1093345190
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20040824065950.txt"

Index: loncom/lond
diff -u loncom/lond:1.238 loncom/lond:1.239
--- loncom/lond:1.238	Tue Aug 24 06:40:08 2004
+++ loncom/lond	Tue Aug 24 06:59:50 2004
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.238 2004/08/24 10:40:08 foxr Exp $
+# $Id: lond,v 1.239 2004/08/24 10:59:50 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -52,12 +52,12 @@
 use LONCAPA::lonssl;
 use Fcntl qw(:flock);
 
-my $DEBUG = 1;		       # Non zero to enable debug log entries.
+my $DEBUG = 0;		       # Non zero to enable debug log entries.
 
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.238 $'; #' stupid emacs
+my $VERSION='$Revision: 1.239 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1285,6 +1285,69 @@
 
 
 
+#
+#   ls  - 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 ls_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; }
+			}
+		    }
+		    $ulsout.=$ulsfn.'&'.join('&',@ulsstats);
+		    if($obs eq '1') { $ulsout.="&1"; }
+		    else { $ulsout.="&0"; }
+		    if($rights eq '1') { $ulsout.="&1:"; }
+		    else { $ulsout.="&0:"; }
+		}
+		closedir(LSDIR);
+	    }
+	} else {
+	    my @ulsstats=stat($ulsdir);
+	    $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
+	}
+    } else {
+	$ulsout='no_such_dir';
+    }
+    if ($ulsout eq '') { $ulsout='empty'; }
+    print $client "$ulsout\n";
+    
+    return 1;
+
+}
+&register_handler("ls", \&ls_handler, 0, 1, 0);
+
 
 #   Process a reinit request.  Reinit requests that either
 #   lonc or lond be reinitialized so that an updated 
@@ -3388,185 +3451,9 @@
 #------------------- Commands not yet in spearate handlers. --------------
 
 
-# ----------------------------------------------------------------------- idput
-    if ($userinput =~ /^idput/) {
-	if(isClient) {
-	    my ($cmd,$udom,$what)=split(/:/,$userinput);
-	    chomp($what);
-	    $udom=~s/\W//g;
-	    my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
-	    my $now=time;
-	    my @pairs=split(/\&/,$what);
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
-		{
-		    my $hfh;
-		    if ($hfh=IO::File->new(">>$proname.hist")) {
-			print $hfh "P:$now:$what\n";
-		    }
-		}
-		foreach my $pair (@pairs) {
-		    my ($key,$value)=split(/=/,$pair);
-		    $hash{$key}=$value;
-		}
-		if (untie(%hash)) {
-		    print $client "ok\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting idput\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting idput\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ----------------------------------------------------------------------- idget
-    } elsif ($userinput =~ /^idget/) {
-	if(isClient) {
-	    my ($cmd,$udom,$what)=split(/:/,$userinput);
-	    chomp($what);
-	    $udom=~s/\W//g;
-	    my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
-	    my @queries=split(/\&/,$what);
-	    my $qresult='';
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
-		for (my $i=0;$i<=$#queries;$i++) {
-		    $qresult.="$hash{$queries[$i]}&";
-		}
-		if (untie(%hash)) {
-		    $qresult=~s/\&$//;
-		    print $client "$qresult\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting idget\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting idget\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ---------------------------------------------------------------------- tmpput
-    } elsif ($userinput =~ /^tmpput/) {
-	if(isClient) {
-	    my ($cmd,$what)=split(/:/,$userinput);
-	    my $store;
-	    $tmpsnum++;
-	    my $id=$$.'_'.$clientip.'_'.$tmpsnum;
-	    $id=~s/\W/\_/g;
-	    $what=~s/\n//g;
-	    my $execdir=$perlvar{'lonDaemons'};
-	    if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
-		print $store $what;
-		close $store;
-		print $client "$id\n";
-	    }
-	    else {
-		print $client "error: ".($!+0)
-		    ."IO::File->new Failed ".
-		    "while attempting tmpput\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-	
-# ---------------------------------------------------------------------- tmpget
-    } elsif ($userinput =~ /^tmpget/) {
-	if(isClient) {
-	    my ($cmd,$id)=split(/:/,$userinput);
-	    chomp($id);
-	    $id=~s/\W/\_/g;
-	    my $store;
-	    my $execdir=$perlvar{'lonDaemons'};
-	    if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
-		my $reply=<$store>;
-			    print $client "$reply\n";
-		close $store;
-	    }
-	    else {
-		print $client "error: ".($!+0)
-		    ."IO::File->new Failed ".
-		    "while attempting tmpget\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ---------------------------------------------------------------------- tmpdel
-    } elsif ($userinput =~ /^tmpdel/) {
-	if(isClient) {
-	    my ($cmd,$id)=split(/:/,$userinput);
-	    chomp($id);
-	    $id=~s/\W/\_/g;
-	    my $execdir=$perlvar{'lonDaemons'};
-	    if (unlink("$execdir/tmp/$id.tmp")) {
-		print $client "ok\n";
-	    } else {
-		print $client "error: ".($!+0)
-		    ."Unlink tmp Failed ".
-		    "while attempting tmpdel\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# -------------------------------------------------------------------------- ls
-    } elsif ($userinput =~ /^ls/) {
-	if(isClient) {
-	    my $obs;
-	    my $rights;
-	    my ($cmd,$ulsdir)=split(/:/,$userinput);
-	    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; }
-				}
-			    }
-			    $ulsout.=$ulsfn.'&'.join('&',@ulsstats);
-			    if($obs eq '1') { $ulsout.="&1"; }
-			    else { $ulsout.="&0"; }
-			    if($rights eq '1') { $ulsout.="&1:"; }
-			    else { $ulsout.="&0:"; }
-			}
-			closedir(LSDIR);
-		    }
-		} else {
-		    my @ulsstats=stat($ulsdir);
-		    $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
-		}
-	    } else {
-		$ulsout='no_such_dir';
-	    }
-	    if ($ulsout eq '') { $ulsout='empty'; }
-	    print $client "$ulsout\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
+
 # ----------------------------------------------------------------- setannounce
-    } elsif ($userinput =~ /^setannounce/) {
+    if ($userinput =~ /^setannounce/) {
 	if (isClient) {
 	    my ($cmd,$announcement)=split(/:/,$userinput);
 	    chomp($announcement);

--foxr1093345190--