DIY web server

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


    Our “server” will listen to the local port 8080 and greet all who apply, or give the contents of the requested file if it exists (in the folder from which the script server was launched).

    For starters, a simple and short code. I think that at this stage nothing special is required to comment, so leave the comments for later.
    1. #! / usr / bin / perl
    2. use LWP :: Socket;
    3.  
    4. $ headers = "HTTP / 1.1 200 OK \ r \ nContent-Type: text / html \ r \ n \ r \ n";
    5. $ sock = new LWP :: Socket ();
    6. $ sock-> bind ('127.0.0.1', '8080');
    7. $ sock-> listen (10);
    8.  
    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 "", ; close FILE;
    15.     }
    16.     $ socket-> write ($ headers. $ content);
    17.     $ socket-> shutdown ();
    18. }

    This ugly code, so it's best not to IPR and be, this example is only to show that the desired functionality can be implemented fairly quickly and a small amount of code, if necessary.

    This code must be ennobled and supplemented. Let's make it a little more readable, add a check to see if it managed to bind to the specified port (otherwise it is already busy), we will check the file exists before trying to open it, well, strict and warnings pragmas will use it.
    1. #! / usr / bin / perl
    2.  
    3. use strict ;
    4. use warnings ;
    5.  
    6. use LWP :: Socket;
    7.  
    8. my $ headers = "HTTP / 1.1 200 OK \ r \ nContent-Type: text / html \ r \ n \ r \ n";
    9.  
    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);
    13.  
    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 "", ;
    21.         close FILE;
    22.     }
    23.     $ socket-> write ($ headers. $ content);
    24.     $ socket-> shutdown ();
    25. }
    26.  
    27. $ sock-> shutdown ();

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

    Here we connect the module we need. It is quite simple to use, so I chose it. create a socket, bindim socket on the local 8080 port and set the queue length, wait for connection when connecting to $ socket, return a new LWP :: Socket () read everything from the socket and extract the name of the requested file, write headers in the socket and close the received LWP “ response to the session”: : Socket () This could even be finished, but we want to better disguise ourselves as an http server, which means we need multithreading in order to withstand loads :)

    use LWP::Socket;


    my $sock = new LWP::Socket();


    $sock->bind('127.0.0.1', '8080');
    $sock->listen(10);



    while ( my $socket = $sock->accept(10) ) {



    $socket->read( \$file_name );
    $file_name =~ s/GET \/([^ ]*) HTTP.+/$1/s;



    $socket->write( $headers . $content );


    $socket->shutdown();



    To do this, we use the FCGI :: ProcManager module, as a result we will have one “head” process and five subsidiaries. To do this, add only four lines:
    1. # ...
    2.  
    3. use LWP :: Socket;
    4. use FCGI :: ProcManager qw / pm_manage pm_pre_dispatch pm_post_dispatch / ;
    5.  
    6. my $ headers = "HTTP / 1.1 200 OK \ r \ nContent-Type: text / html \ r \ n \ r \ n";
    7.  
    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);
    11.  
    12. pm_manage (n_processes => 5) ;
    13.  
    14. while (my $ socket = $ sock-> accept (10)) {
    15.     pm_pre_dispatch ( );
    16.     my $ content = "Hello from Habr";
    17.  
    18. # ...
    19.  
    20.     $ socket-> shutdown ();
    21.     pm_post_dispatch ( );
    22. }
    23.  
    24. $ sock-> shutdown ();

    And now our "server" is ready. You can use :). It remains to give the full code so that it can simply be copied to a file, run and make sure that everything works.
    This code with small additions:
    - headers are supplemented
    - a “greeting”
    is given as an index page - as the rest - what they ask
    - if the file is not found, we inform the browser about this 404 error
    - comments are added
    1. #! / usr / bin / perl
    2.  
    3. use strict;
    4. use warnings;
    5.  
    6. use LWP :: Socket;
    7. use FCGI :: ProcManager qw / pm_manage pm_pre_dispatch pm_post_dispatch /;
    8.  
    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";
    15.  
    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);
    20.  
    21. # Create 5 childs
    22. pm_manage (n_processes => 5);
    23.  
    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 = "

      Hello from Habr

      ";
    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;
    36.  
    37.     if ($ file_name) {
    38.         if (-f $ file_name and open FILE, '<', $ file_name) {
    39.             # Read from file
    40.             $ content = join "", ;
    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 ();
    52.  
    53.     # Child's work complete
    54.     pm_post_dispatch ();
    55. }
    56.  
    57. # Close socket
    58. $ sock-> shutdown ();


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

    I hope the last option will not scare anyone away :)

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

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

    Also popular now: