Almost a web-server with your own hands

Recently, there have been several posts on attracting attention to certain programming languages ​​using the example of writing some simple “web-server”. Since this perl booze has not yet been touched, I’ll add my five kopecks :)
We will write a simple server application masquerading as an http-server.


Our "server" will listen to the local port 8080 and greet all those who applied, or give the contents of the requested file if available (in the folder from which the script server was launched).

For a start, simple and short code. I think at this stage, especially comment does not require anything, so leave commenting for later.

1. #! / usr / bin / perl
2. use LWP :: Socket ;
4. $ headers = "HTTP / 1.1 200 OK \ r \ n Content-Type: text / html \ r \ n \ r \ n " ;
5. $ sock = new LWP :: Socket ( ) ;
6. $ sock -> bind ( '127.0.0.1' , '8080' ) ;
7. $ sock -> listen ( 10 ) ;
9. while ( $ socket = $ sock -> accept ( 10 ) ) {
10. $ content = "Hello from Habr" ;
11. $ file_name ; $ socket -> read ( \ $ file_name ) ;
12. $ file_name = ~ s / GET \ / ([^] *) HTTP. + / $ 1 / s ;
13. if ( open FILE , '<' , $ file_name ) {
14. $ content = join "" , <FILE> ; close FILE ;
15. }
16. $ socket -> write ( $ headers . $ content ) ;
17. $ socket -> shutdown ( ) ;
18. }

This is an ugly code, so it’s better not to write it, this example is only to show that the required functionality, if necessary, can be implemented fairly quickly and with a small amount of code.
')
This code should be refined and supplemented. Let's make it a bit more readable, add a check whether it was possible to bind to the specified port (otherwise it is already busy), we will check the existence of the file before trying to open it, well, it will use the strict and warnings pragmas.

1. #! / usr / bin / perl
3. use strict ;
4. use warnings ;
6. use LWP :: Socket ;
8. my $ headers = "HTTP / 1.1 200 OK \ r \ n Content-Type: text / html \ r \ n \ r \ n " ;
10. my $ sock = new LWP :: Socket ( ) ;
11. die "Can't bind a socket" unless $ sock -> bind ( '127.0.0.1' , '8080' ) ;
12. $ sock -> listen ( 10 ) ;
14. while ( my $ socket = $ sock -> accept ( 10 ) ) {
15. my $ content = "Hello from Habr" ;
16. my $ file_name ;
17. $ socket -> read ( \ $ file_name ) ;
18. $ file_name = ~ s / GET \ / ([^] *) HTTP. + / $ 1 / s ;
19. if ( - f $ file_name and open FILE , '<' , $ file_name ) {
20. $ content = join "" , <FILE> ;
21. close FILE ;
22. }
23. $ socket -> write ( $ headers . $ content ) ;
24. $ socket -> shutdown ( ) ;
25. }
27. $ sock -> shutdown ( ) ;

Just a few lines more, but the script has become a bit more cultured.

Here we have

use LWP::Socket;
we connect the module we need. It is quite simple to use, so I chose it.

my $sock = new LWP::Socket();
create a socket

$sock->bind('127.0.0.1', '8080');
$sock->listen(10);
bind the socket on the local port 8080 and set the queue length

while ( my $socket = $sock->accept(10) ) {
waiting for connection
when connected to $ socket, the new LWP :: Socket () will return

$socket->read( \$file_name );
$file_name =~ s/GET \/([^ ]*) HTTP.+/$1/s;
read everything from the socket and fetch the name of the requested file

$socket->write( $headers . $content );
write the headers and the answer to the socket

$socket->shutdown();
close the received “per session” LWP :: Socket ()

This could even be finished, but we want to better disguise as an http-server, which means we need multi-threading in order to withstand the load :)
To do this, we use the FCGI :: ProcManager module, as a result we will have one “head” process and five children. To do this, add four lines:

1. # ...
3. use LWP :: Socket ;
4. use FCGI :: ProcManager qw / pm_manage pm_pre_dispatch pm_post_dispatch / ;
6. my $ headers = "HTTP / 1.1 200 OK \ r \ n Content-Type: text / html \ r \ n \ r \ n " ;
8. my $ sock = new LWP :: Socket ( ) ;
9. die "Can't bind a socket" unless $ sock -> bind ( '127.0.0.1' , '8080' ) ;
10. $ sock -> listen ( 10 ) ;
12. pm_manage ( n_processes => 5 ) ;
14. while ( my $ socket = $ sock -> accept ( 10 ) ) {
15. pm_pre_dispatch ( ) ;
16. my $ content = "Hello from Habr" ;
18. # ...
20. $ socket -> shutdown ( ) ;
21. pm_post_dispatch ( ) ;
22. }
24. $ sock -> shutdown ( ) ;

And our “server” is ready. You can use :). It remains to give the complete code so that it can be copied into the file, run and make sure that everything works.
This code with a few additions:
- added headlines
- “greeting” is given as an index page
- as the rest - what will be asked
- if the file is not found we inform the browser about this 404 error
- added comments

1. #! / usr / bin / perl
3. use strict ;
4. use warnings ;
6. use LWP :: Socket ;
7. use FCGI :: ProcManager qw / pm_manage pm_pre_dispatch pm_post_dispatch / ;
9. # Prepare headers
10. my $ headers = "HTTP / 1.1% d OK \ r \ n "
11. . "Server: FakeServer / 2009-09-12 \ r \ n "
12. . "Content-Type: text / html \ r \ n "
13. . "Content-Length:% d \ r \ n "
14. . "Connection: close \ r \ n \ r \ n " ;
16. # Prepare and open socket
17. my $ sock = new LWP :: Socket ( ) ;
18. die "Can't bind a socket" unless $ sock -> bind ( '127.0.0.1' , '8080' ) ;
19. $ sock -> listen ( 10 ) ;
21. # Create 5 childs
22. pm_manage ( n_processes => 5 ) ;
24. # Accepts a new connection
25. while ( my $ socket = $ sock -> accept ( 10 ) ) {
26. # Passing direction to child
27. pm_pre_dispatch ( ) ;
28. # Default content
29. my $ content = "<html> <body> <h1> Hello from Habr </ h1> </ body> </ html>" ;
30. my $ stat = 200 ;
31. my $ file_name ;
32. # Read from socket
33. $ socket -> read ( \ $ file_name ) ;
34. # Get wanted file name
35. $ file_name = ~ s / GET \ / ([^] *) HTTP. + / $ 1 / s ;
37. if ( $ file_name ) {
38. if ( - f $ file_name and open FILE , '<' , $ file_name ) {
39. # Read from file
40. $ content = join "" , <FILE> ;
41. close FILE ;
42. }
43. else {
44. $ content = "File not found" ;
45. $ stat = 404 ;
46. }
47. }
48. # Puts headers and content into the socket
49. $ socket -> write ( sprintf ( $ headers , $ stat , length $ content ) ) ;
50. $ socket -> write ( $ content ) ;
51. $ socket -> shutdown ( ) ;
53. # Child's work complete
54. pm_post_dispatch ( ) ;
55. }
57. # Close socket
58. $ sock -> shutdown ( ) ;

Instructions for use:
- copy code and paste into file
- run (perl file.pl)
- in the browser open https: //127.0.0.1: 8080 /

I hope the last option will not scare anyone :)

PS If anyone is interested, then this case with 10 children ate 15 meters of RAM, while testing with requests in 30 threads, it managed to process about 2000 requests per second (10 threads requested existing files). Launched on the local machine, on the test, both cores were loaded to the ceiling.

---------
Backlight from here