Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
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 (Prior) 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 cooling their heels in the Monastery: (5)
As of 2015-07-04 10:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (59 votes), past polls