Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
Keep It Simple, Stupid
 
PerlMonks  

Re: how to improve my script

by agn (Initiate)
on Jun 15, 2009 at 18:32 UTC ( #771751=note: print w/ replies, xml ) Need Help??


in reply to how to improve my script

Thanks for the suggestions. Directory traversals with .. don't work. I checked it when I wrote the code. Patched up the code while keeping the other suggestions in mind. Pasting the updated code:

#!/usr/local/bin/perl -w #Caution: Big mess ahead #TODO: # get .. working in dir listing # implement Getopt::Long # usage() function # log to syslog # fork() children # daemonize # persistent connections use strict; use IO::Socket; my ($socket, @files, $req, $client); my $DOCROOT = '/home/arun/docs/'; my %error_page = ( 403 => $DOCROOT.'403.html', # forbidden 404 => $DOCROOT.'404.html', # not found 406 => $DOCROOT.'406.html', # not acceptable 501 => $DOCROOT.'501.html' # not implemented ); #$SIG{'INT'} = \&cleanup; $socket = new IO::Socket::INET ( LocalAddr => '127.0.0.1', LocalPort => (shift || 4321), Proto => 'tcp', Listen => 5, ReuseAddr => 1 ) or die "$! \n"; $socket->listen(); &log("Listening on ".$socket->sockhost().":".$socket->sockport."\n"); while ($client = $socket->accept()) { &log("Connection from ".$client->peerhost().":".$client->peerport( +)."\n"); # get http request - first line $req = <$client>; &log($client->peerhost()." ".$req); &respond_to( &handle_req($req) ); close $client; } sub cleanup { close $socket; die "Interrupted. Exiting...\n"; } sub log { my $msg = shift; print scalar localtime," ", $msg; } sub getfiles { my $dir = shift; opendir DIR, $dir or die "open:$!\n"; # remove . and .. from list of files @files = grep { !/^\.(\.)?$/ } readdir DIR; closedir DIR; return \@files; } sub handle_req { my ($method, $uri) = split / +/, shift; if ($method !~ /^GET/) { &log("501 Not Implemented\nr"); return 501; } $uri =~ s/\/(.*)/$1/; # strip the fi +rst slash if (-e $DOCROOT.$uri) { if (-f $DOCROOT.$uri) { &log("200 HTTP OK\n"); return 200; } elsif (-d $DOCROOT.$uri) { &log("200 HTTP OK\n"); return 200; } else { &log("406 Not Acceptable\n"); return 406; } } &log("404 Not Found\n"); return 404; } sub respond_to { my $status_code = shift; unless ($status_code == 200) { &display($error_page{$status_code}) if (-f $error_page{$status +_code}); return; } my $uri = (split / +/, $req)[1]; $uri =~ s/\/(.*)/$1/; chomp($uri); my $path = $DOCROOT.$uri; if (-f $path) { &display($path) ; return; } if (-d $path) { if (-f $path.'index.html') { &display($path.'index.html'); } else { &gen_dir_list($uri, &getfiles($path)); } } return; } sub display { my $file = shift; open RES, $file or die "open: $file: $!"; &log("Sending $file\n"); print $client $_ while (<RES>); close RES; } sub gen_dir_list { my ($uri, $files) = @_; &log("[info] dir listing request\n"); # print html header print $client <<HEADER; <html> <head><title>dir listing for: /$uri</title></head> <body> <table cellpadding=5> HEADER my $count; foreach my $f (@$files) { printf $client "%s<td><a href=\"%s\">%s</a></td><td>%s</td></t +r>", # different colours for alternate rows (++$count % 2 ? '<tr bgcolor="#e0ffd6">' : '<tr bgcolo +r="#ffdcd6">'), # genereate href links (-d $DOCROOT.$uri.'/'.$f ? '/'.$uri.$f.'/' : '/'.$uri +.$f), # append a '/' to the end of dirs (-d $DOCROOT.$uri.'/'.$f ? $f.'/' : $f), scalar localtime((stat $DOCROOT.$uri.'/'.$f)[9]); } #print html footer print $client <<FOOTER; </table> <p>-- httpserv v0.1 --</p> </body> </html> FOOTER }

Thanks for the percritic link. It did find many things. Am still working on it. I will also remove & from function calls.


Comment on Re: how to improve my script
Download Code
Re^2: how to improve my script
by afoken (Parson) on Jun 15, 2009 at 19:23 UTC

    Some notes:

    • Enable taint mode (perlsec). This will generate a lot of new errors, everywhere you pass unverified data to critical functions. Add data verification, don't disable the taint mode.
    • Get rid of the Perl4-style function calls. The ampersand is not only not needed, but it DISABLES prototype checks. You don't want that.
    • Escape all HTML and URI output. You are opening your server for cross-site scripting attacks.
    • Don't stat a file more than once. Learn about the _ (last stat result) argument for the file test operators (-d, -f, -s, -e, and so on).
    • handle_req does not handle requests, it just tests for file or directory and returns a HTTP status code. The real request handler is respond_to. Think about the function names, think about merging both functions.
    • display displays nothing, it sends a file to the client. Think about the function name. It lacks binmode, this will damage binary files on Win32, DOS, OS/2, and perhaps other systems.
    • gen_dir_list not only generates the directory list, but also sends it to the client. Think about the function name.
    • $req and $client are globals, so your code will not be able to handle more than one request at a time. Pass them as parameters to the request handler and your code can handle more than one request when you later change the server part of your code.
    • Your code aborts reading the request after the first line, this may confuse clients. You are expected to read the entire request before responding.

    Alexander

    --
    Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
Re^2: how to improve my script
by skx (Parson) on Jun 15, 2009 at 19:50 UTC

    I downloaded and ran your code, and traversals with ".." definitely work:

    skx@gold:~$ telnet 127.0.0.1 4321 Trying 127.0.0.1... Connected to 127.0.0.1. Escape character is '^]'. GET /../../../../../../etc/passwd HTTP/1.0 root:x:0:0:root:/root:/bin/bash ..

    I notice too that you never return a content-type in your response which is surprising to say the least! (I was surprised that firefox displayed the resulting pages correctly.)

    Steve
    --

Log In?
Username:
Password:

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

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

    April first is:







    Results (565 votes), past polls