Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

CGI Directory Lister

by Ranna (Acolyte)
on Jul 25, 2001 at 05:24 UTC ( #99537=perlquestion: print w/replies, xml ) Need Help??

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;
Anyways...any ideas as to why it may be functioning as it is?

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*] }
    hope to help,
    snowcrash //////
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;
    And, not to forget, an example.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://99537]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (7)
As of 2021-04-11 11:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?