http-server.pl 1.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263
  1. # This is by no means any where close to a real web server but a rather quick
  2. # solution for testing purposes.
  3. use warnings;
  4. use strict;
  5. use IO::Socket;
  6. use FindBin;
  7. use File::stat;
  8. use File::Basename;
  9. my $server = IO::Socket::INET->new(
  10. Proto => 'tcp',
  11. Listen => SOMAXCONN,
  12. LocalPort => 63636,
  13. ReuseAddr => 1
  14. );
  15. my $server_root = $FindBin::Bin . '/';
  16. die "Server failed.\n" unless $server;
  17. while ( my $client = $server->accept() ) {
  18. $client->autoflush(1);
  19. my $request = <$client>;
  20. my $filename;
  21. my $filesize;
  22. my $content_type;
  23. my $success = 1;
  24. if ( $request =~ m|^GET /(.+) HTTP/1.| || $request =~ m|^GET / HTTP/1.| ) {
  25. if ( $1 && -e $server_root . 'www/' . $1 ) {
  26. $filename = $server_root . 'www/' . $1;
  27. }
  28. else {
  29. $success = 0;
  30. $filename = $server_root . 'www/404.html';
  31. }
  32. my ( undef, undef, $ftype ) = fileparse( $filename, qr/\.[^.]*/ );
  33. $filesize = stat($filename)->size;
  34. $content_type = "text/html";
  35. if ($success) {
  36. print $client
  37. "HTTP/1.1 200 OK\nContent-Type: $content_type; charset=utf-8\nContent-Length: $filesize\nServer: \n\n";
  38. }
  39. else {
  40. print $client
  41. "HTTP/1.1 404 Not Found\nContent-Type: $content_type; charset=utf-8\nContent-Length: $filesize\nServer: Perl Test Server\n\n";
  42. }
  43. open( my $f, "<$filename" );
  44. while (<$f>) { print $client $_ }
  45. }
  46. else {
  47. print $client 'HTTP/1.1 400 Bad Request\n';
  48. }
  49. close $client;
  50. }