CGI Directory Lister

Ranna has asked for the wisdom of the Perl Monks concerning the following question:

Well, I figured if I was going to let the public view my code, I should show it off using a peice of said code (I'm currently using someone else's script, a php thing that I'm not entirely satisfied with: Here)

So, I figured I'd try it out in perl. I read up on directories (hooray for Perl Cookbook ^.^). I read about the File::Find module, but decided to try it on my own. I know I may get accused of re-inventing the wheel, but I'm not sure I really care; this is perl, after all, why -not- code it? ^.~

Anyways, here's what I came up with. And...well, it doesn't work :o) Instead of printing the directory list with the links next to the files (as it should), it just prints the name of the first directory parsed (example: The available code directory).

#!/usr/bin/perl
# RedFox! Productions: DirList
# All coding done by one Ranna Fox

use rfp;
use strict;
my $r = new rfp;

my $file = $ENV{'QUERY_STRING'} || "prefix/";
$r->print_start("RF!P::DL->($file);");
if ($file =~ /^\//) {
  print "<b>Ahem...you may not list files with absolute paths.  Especi
+ally not <em>that</em> absolute path</b>\n";
  $r->print_end;
  exit;
} elsif ($file =~ /\.\./) {
  print "<b>'Scuse me, I won't list directories with .. in their path.
+  Better fix that.</b>\n";
  $r->print_end;
  exit;
} elsif (not $file =~ /^prefix\//) {
  print "<b>See, the way things work is that if you're gonna list a di
+rectory, you gotta put a 'prefix/' before it, which means it has to b
+e in my directory.<b>\n";
  $r->print_end;
  exit;
}

my $filen;
($filen = $file) =~ s{^prefix/}{/home/admin/ranna/public_html/};
if (not -d $filen) {
  print "<b>That...uh...doesn't appear to exist... o.O</b>\n";
  $r->print_end;
  exit;
}

&parse_dir($filen, $file);

sub parse_dir {
  my $dir = $_[0];
  my $req = $_[1];
  opendir(PARSEDIR, "$dir") || die "Couldn't open directory $dir: $!\n
+";
  my $currdir;
  ($currdir = $dir) =~ s{.*/([^/]*)$}{$1}; 
  print "<li><b>$currdir/</b>\n";
  while (defined($file = readdir(PARSEDIR))) {
    next if $file == "." || ".." || ! -r $dir;
    if (-d $file) {
      my $to_read = $dir . "/" . $file;
      $req = $req . "/" . $file;
      &parse_dir($to_read, $req);
    } else {
      my @fparts = split (/./, $file);
      my $fext = $fparts[$#fparts];
      (my($dirn) = $dir) =~ s{/home/admin/ranna/public_html}{};
      print "<li>[<a href=$dirn/$file>Bare link</a>]";
      if (-T $file) {
        if ($fext =~ /php/i) {
          print "[<a href=/viewsource.php?filename=$req/$file>Online</
+a>]";
        } elsif ($fext =~ /pl/i || /cgi/i || /pm/i || /conf/i) {
          print "[<a href=/cgi-bin/pss?file=$req/$file>Online</a>]";
        } else {
          print "[<a href=/showtext.php?file=$req/$file>Online</a>]";
        }
      } else {
        print "[<a href=/$dirn/$file>Download</a>]";
      }
      print " - $file</li>\n";
    }
  }
  closedir(PARSEDIR);
}
$r->print_end;
[download]

Anyways...any ideas as to why it may be functioning as it is?

Comment on CGI Directory Lister Download Code

Replies are listed 'Best First'.
Re: CGI Directory Lister by snowcrash (Friar) on Jul 25, 2001 at 09:36 UTC
hi! your main problem seems to be that the code in the while loop doesn't get executed: `($file == "." \|\| "..")` is not the same as `($file eq "." \|\| $file eq "..")`, as the string constant </code>".."</code> evaluates true all the time and the whole expression is true. you have to use `eq` if you compare strings, `==` is the operator to compare numerical values! always use the -w option in the shebang line (`/path/to/perl -w`) or `use warnings;` to to enable warnings, to notice nasty litte bugs! Change that line in your code to something like this: `while (defined($file = readdir(PARSEDIR))) { next if ($file eq "." \|\| $file eq ".." \|\| !-r $dir); ### [snip] }` [download] hope to help, snowcrash //////	[reply] [d/l] [select]
Re: CGI Directory Lister by Ranna (Acolyte) on Jul 25, 2001 at 10:17 UTC
Ahah, well, thanks to you and Some Random Fox (thanks, E), I think I pretty much got it working :o) I got rid of the file-extensions part 'cause the pss and viewsourse.php scripts were stupid, so now it's all in showtext.php (which I'll fix later) Aaaannd...here's the code ^.^: #!/usr/bin/perl # RedFox! Productions: DirList # All coding done by one Ranna Fox use rfp; use strict; use CGI qw( :standard ); my $r = new rfp; my $file = param('d') \|\| "prefix/"; $r->print_start("RF!P::DL->($file);"); if ($file =~ /^\//) { print "<b>Ahem...you may not list files with absolute paths. Especi +ally not <em>that</em> absolute path</b>\n"; $r->print_end; exit; } elsif ($file =~ /\.\./) { print "<b>'Scuse me, I won't list directories with .. in their path. + Better fix that.</b>\n"; $r->print_end; exit; } elsif (not $file =~ /^prefix\//) { print "<b>See, the way things work is that if you're gonna list a di +rectory, you gotta put a 'prefix/' before it, which means it has to b +e in my directory.<b>\n"; $r->print_end; exit; } my $filen; ($filen = $file) =~ s{^prefix/}{/home/admin/ranna/public_html/}; if (not -d $filen) { print "<b>That...uh...doesn't appear to exist... o.O</b>\n"; $r->print_end; exit; } &parse_dir($filen, $file); sub parse_dir { my $dir = $_[0]; my $req = $_[1]; opendir(PARSEDIR, "$dir") \|\| die "Couldn't open directory $dir: $!\n +"; my $currdir; $dir =~ s/(.)\/$/$1/; ($currdir = $dir) =~ s{./([^/])$}{$1}; print "<li><b>$currdir/</b>\n<ul>\n"; foreach my $file (readdir(PARSEDIR)) { my $fullname = $dir . "/" . $file; next if ($file =~ /^\../ \|\| ! -r $fullname); if (-d $fullname) { $req = $req . "/" . $file; &parse_dir($fullname, $req); } else { my $dirn; ($dirn = $dir) =~ s{/home/admin/ranna/public_html}{}; print "<li>[<a href=$dirn/$file>Bare link</a>]"; if (-T $fullname) { print "[<a href=/showtext.php?file=prefix$dirn/$file>Online</a +>]"; } else { print "[<a href=$dirn/$file>Download</a>]"; } print " - $file</li>\n"; } } closedir(PARSEDIR); print "</ul>\n"; } $r->print_end; [download] And, not to forget, an example.	[reply] [d/l]


Perl-Sensitive Sunglasses
	PerlMonks