http-server.pl 1.5 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162
  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 File::stat;
  7. use File::Basename;
  8. my $server = IO::Socket::INET->new(
  9. Proto => 'tcp',
  10. Listen => SOMAXCONN,
  11. LocalPort => 63636,
  12. ReuseAddr => 1
  13. );
  14. my $server_root = "t/";
  15. die "Server failed.\n" unless $server;
  16. while ( my $client = $server->accept() ) {
  17. $client->autoflush(1);
  18. my $request = <$client>;
  19. my $filename;
  20. my $filesize;
  21. my $content_type;
  22. my $success = 1;
  23. if ( $request =~ m|^GET /(.+) HTTP/1.| || $request =~ m|^GET / HTTP/1.| ) {
  24. if ( $1 && -e $server_root . 'www/' . $1 ) {
  25. $filename = $server_root . 'www/' . $1;
  26. }
  27. else {
  28. $success = 0;
  29. $filename = $server_root . 'www/404.html';
  30. }
  31. my ( undef, undef, $ftype ) = fileparse( $filename, qr/\.[^.]*/ );
  32. $filesize = stat($filename)->size;
  33. $content_type = "text/html";
  34. if ($success) {
  35. print $client
  36. "HTTP/1.1 200 OK\nContent-Type: $content_type; charset=utf-8\nContent-Length: $filesize\nServer: \n\n";
  37. }
  38. else {
  39. print $client
  40. "HTTP/1.1 404 Not Found\nContent-Type: $content_type; charset=utf-8\nContent-Length: $filesize\nServer: Perl Test Server\n\n";
  41. }
  42. open( my $f, "<$filename" );
  43. while (<$f>) { print $client $_ }
  44. }
  45. else {
  46. print $client 'HTTP/1.1 400 Bad Request\n';
  47. }
  48. close $client;
  49. }