[LON-CAPA-cvs] cvs: loncom / lond /lonnet/perl lonnet.pm

matthew lon-capa-cvs@mail.lon-capa.org
Thu, 03 Mar 2005 23:21:55 -0000


matthew		Thu Mar  3 18:21:55 2005 EDT

  Modified files:              
    /loncom	lond 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Bug 3964: Use of ':' in directory name prevented resource browsing
  lond: added ls2_handler which encodes its results prior to concatenating
      them with ':'s.
  lonnet::dirlist: modified to call 'ls2' and fall back to 'ls' on failure.
      unescapes values from 'ls2' before sending them back.
  
  
Index: loncom/lond
diff -u loncom/lond:1.279 loncom/lond:1.280
--- loncom/lond:1.279	Thu Feb 17 03:57:51 2005
+++ loncom/lond	Thu Mar  3 18:21:51 2005
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.279 2005/02/17 08:57:51 albertel Exp $
+# $Id: lond,v 1.280 2005/03/03 23:21:51 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -58,7 +58,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.279 $'; #' stupid emacs
+my $VERSION='$Revision: 1.280 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1409,6 +1409,9 @@
 &register_handler("du", \&du_handler, 0, 1, 0);
 
 #
+# The ls_handler routine should be considered obosolete and is retained
+# for communication with legacy servers.  Please see the ls2_handler.
+#
 #   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
@@ -1425,6 +1428,7 @@
 #   The reply is written to  $client.
 #
 sub ls_handler {
+    # obsoleted by ls2_handler
     my ($cmd, $ulsdir, $client) = @_;
 
     my $userinput = "$cmd:$ulsdir";
@@ -1471,6 +1475,72 @@
 }
 &register_handler("ls", \&ls_handler, 0, 1, 0);
 
+#
+# Please also see the ls_handler, which this routine obosolets.
+# ls2_handler differs from ls_handler in that it escapes its return 
+# values before concatenating them together with ':'s.
+#
+#   ls2  - 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 ls2_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;
+                            }
+                        }
+                    }
+                    my $tmp = $ulsfn.'&'.join('&',@ulsstats);
+                    if ($obs    eq '1') { $tmp.="&1"; } else { $tmp.="&0"; }
+                    if ($rights eq '1') { $tmp.="&1"; } else { $tmp.="&0"; }
+                    $ulsout.= &escape($tmp).':';
+                }
+                closedir(LSDIR);
+            }
+        } else {
+            my @ulsstats=stat($ulsdir);
+            $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
+        }
+    } else {
+        $ulsout='no_such_dir';
+   }
+   if ($ulsout eq '') { $ulsout='empty'; }
+   &Reply($client, "$ulsout\n", $userinput); # This supports debug logging.
+   return 1;
+}
+&register_handler("ls2", \&ls2_handler, 0, 1, 0);
+
 #   Process a reinit request.  Reinit requests that either
 #   lonc or lond be reinitialized so that an updated 
 #   host.tab or domain.tab can be processed.
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.604 loncom/lonnet/perl/lonnet.pm:1.605
--- loncom/lonnet/perl/lonnet.pm:1.604	Thu Mar  3 02:45:01 2005
+++ loncom/lonnet/perl/lonnet.pm	Thu Mar  3 18:21:54 2005
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.604 2005/03/03 07:45:01 albertel Exp $
+# $Id: lonnet.pm,v 1.605 2005/03/03 23:21:54 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3895,19 +3895,37 @@
 
     if($udom) {
         if($uname) {
-            my $listing=reply('ls:'.$dirRoot.'/'.$uri,
+            my $listing=reply('ls2:'.$dirRoot.'/'.$uri,
                               homeserver($uname,$udom));
-            return split(/:/,$listing);
+            my @listing_results;
+            if ($listing eq 'unknown_cmd') {
+                $listing=reply('ls:'.$dirRoot.'/'.$uri,
+                               homeserver($uname,$udom));
+                @listing_results = split(/:/,$listing);
+            } else {
+                @listing_results = map { &unescape($_); } split(/:/,$listing);
+            }
+            return @listing_results;
         } elsif(!defined($alternateDirectoryRoot)) {
             my $tryserver;
             my %allusers=();
             foreach $tryserver (keys %libserv) {
                 if($hostdom{$tryserver} eq $udom) {
-                    my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
+                    my $listing=reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
                                       $udom, $tryserver);
-                    if (($listing ne 'no_such_dir') && ($listing ne 'empty')
-                        && ($listing ne 'con_lost')) {
-                        foreach (split(/:/,$listing)) {
+                    my @listing_results;
+                    if ($listing eq 'unknown_cmd') {
+                        $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
+                                       $udom, $tryserver);
+                        @listing_results = split(/:/,$listing);
+                    } else {
+                        @listing_results =
+                            map { &unescape($_); } split(/:/,$listing);
+                    }
+                    if ($listing_results[0] ne 'no_such_dir' && 
+                        $listing_results[0] ne 'empty'       &&
+                        $listing_results[0] ne 'con_lost') {
+                        foreach (@listing_results) {
                             my ($entry,@stat)=split(/&/,$_);
                             $allusers{$entry}=1;
                         }