Rutinas de Soporte para un Servidor HTTP Simple

Cuando un navegador se conecta a un servidor envía una solicitud HTTP que consiste en:

El servidor lee la petición y traduce el URL en el camino en el sistema de archivos. Si el fichero existe y el cliente tiene permisos para accederlo el servidor envía una breve cabecera seguida de los contenidos del fichero.

Las solicitudes HEAD se tratan de manera análoga sólo que solo se retorna la información de cabecera.

El código del cliente desarrollado en la sección 13.6 y la ejecución en la página [*] ilustran el funcionamiento del protocolo.

Descripción del Módulo de Soporte

A continuación se describe un módulo que proporciona subrutinas para la construcción de un servidor HTTP muy simple.

El módulo comienza exportando las funciones handle_connection y docroot.

 1  package HTTPServer2;
 2  use strict;
 3  use IO::File;
 4  use MIME::Types;
 5  use HTTP::Status;
 6  use HTTP::Request;
 7  require Exporter;
 8
 9  our @ISA = 'Exporter';
10  our @EXPORT = qw(handle_connection docroot);
11
12  my $DOCUMENT_ROOT = '/var/www/';
13  my $CRLF = "\015\012";
La subrutina handle_connection maneja la petición. La subrutina docroot es un simple método de acceso a la raíz de la jerarquía web:
105  sub docroot {
106    $DOCUMENT_ROOT = shift if @_;
107    return $DOCUMENT_ROOT;
108  }

La variable $DOCUMENT_ROOT ha sido inicializada a /var/www/. Sin embargo no todos los ficheros servidos residen bajo este directorio. Para darle mayor generalidad serviremos ficheros en directorios de usuarios.

Como otros muchos protocolos orientados a la línea14.2 HTTP termina sus campos con una secuencia CRLF . Para mejorar la legibilidad definimos la variable $CRLF = "\015\012" que insertaremos en el texto dondequiera que sea necesario.

La Subrutina handle_connection

La subrutina handle_connection recibe un socket (ya abierto) y se encarga de completar la transacción.

 15  sub handle_connection {
 16    my $c = shift;   # socket
 17    my ($fh,$type,$length,$url,$method);
 18    local $/ = "$CRLF$CRLF";   # set end-of-line character
 19    my $request = <$c>;        # read the request header

Al establecer local $/ = "$CRLF$CRLF" hacemos que la siguiente lectura $request = <$c> deje en $request la cabecera. Lo que se recibe para un request como http://nereida.deioc.ull.es:8080/~pl/ será algo parecido a esto:

GET /~pl/ HTTP/1.1
Host: nereida.deioc.ull.es:8080
User-Agent: Mozilla/5.0 (X11; U; Linux i686; es-ES; rv:1.8.1.14) \
  Gecko/20080404 Iceweasel/2.0.0.14 (Debian-2.0.0.14-0etch1)
Accept: text/xml,application/xml,application/xhtml+xml,text/html; \
        q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5
Accept-Language: es-es,es;q=0.8,en-us;q=0.5,en;q=0.3
Accept-Encoding: gzip,deflate
Accept-Charset: UTF-8,*
Keep-Alive: 300
Connection: keep-alive
Cookie: __utma=115080643.2041926032.1207909839.1209722569.1209729445.4; \
        __utmz=115080643.1207909839.1.1.utmccn=(direct)|utmcsr=(direct)|\
        utmcmd=(none); __utmc=115080643

Con la llamada al método HTTP::Request::parse construimos un objeto HTTP::Request a partir de la cabecera. Este es el aspecto que ofrece el objeto creado (descrito con Data::Dumper) a partir de la cabecera anterior:

$VAR1 = bless( {
 '_protocol' => 'HTTP/1.1',
 '_content' => '',
 '_uri' => bless( do{\(my $o = '/~pl/')}, 'URI::_generic' ),
 '_headers' => bless( {
   'user-agent' => 'Mozilla/5.0 (X11; U; Linux i686; es-ES; rv:1.8.1.14) \
                    Gecko/20080404 Iceweasel/2.0.0.14 (Debian-2.0.0.14-0etch1)',
   'connection' => 'keep-alive',
   'keep-alive' => '300',
   'accept' => 'text/xml,application/xml,application/xhtml+xml,text/html;\
                q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
   'accept-language' => 'es-es,es;q=0.8,en-us;q=0.5,en;q=0.3',
   'cookie' => '__utma=115080643.2041926032.1207909839.1209722569.1209729445.4;\
                __utmz=115080643.1207909839.1.1.utmccn=(direct)|utmcsr=(direct)|\
                utmcmd=(none); __utmc=115080643',
   'accept-encoding' => 'gzip,deflate',
   'host' => 'nereida.deioc.ull.es:8080',
   'accept-charset' => 'UTF-8,*'
 }, 'HTTP::Headers' ),
 '_method' => 'GET'
}, 'HTTP::Request' );
Los objetos HTTP::Request disponen de métodos para acceder a cada uno de los atributos.

 21    my $r = HTTP::Request->parse( $request );
 22    $method = $r->method; # GET | HEAD | ...
 23      return error($c, RC_BAD_REQUEST(), 
           'Your browser sent a request that this server does not support.')
 24    unless $method =~ m!^(GET|HEAD)$!;

Si el método no es GET o HEAD envíamos una página conteniendo el mensaje de error. El módulo HTTP::Status proporciona un conjunto de nemónicos (como RC_BAD_REQUEST ) que codifican las constantes usadas en el protocolo (como aparecen en el RFC 2616).

100  sub error {
101    my ($c, $code, $message) = @_;
102    my $status_message = status_message($code);
103
104    print $c "HTTP/1.0 $code Bad request$CRLF";
105    print $c "Content-type: text/html$CRLF$CRLF";
106    print $c <<"END";
107  <HTML>
108  <HEAD><TITLE>$code Bad Request</TITLE></HEAD>
109  <BODY><H1>$status_message</H1>
110  <P>$message</P>
111  </BODY>
112  </HTML>
113  END
114  }
La función status_message (en HTTP::Status) provee la cadena asociada con el código correspondiente.

Retornemos al código de handle_connection:

 26    $url = $r->uri;
 27
 28      return error($c, RC_NOT_FOUND, 
           'The requested document was not found on this server')
 29    unless ($fh,$type,$length) = lookup_file($url);
El método uri de un objeto HTTP::Request es un getter-setter para el atributo _uri. La función lookup_file retorna - en caso de éxito - una lista con tres elementos en otro caso retorna una lista vacía. En tal caso llamamos a error con los argumentos apropiados.

Volvamos a handle_connection:

 31    warn "URL: $url\n";
 32    return redirect($c,"$url/") if $type eq 'directory';
Una situación especial es cuando la petición especifica un directorio pero no se añadió la barra final a la solicitud. En tal caso la función lookp_file retorna el tipo directory. En ese caso enviámos una página de redirección con el formato corregido: "$url/". El objeto $url tiene el operador "" sobrecargado de manera que en un contexto de cadena se interpola como la cadena adecuada. Veamos el código de la función redirect:

 80  sub redirect {
 81    my ($c,$url) = @_;
 82    my $host = $c->sockhost;
 83    my $port = $c->sockport;
 84    my $moved_to = "http://$host:$port$url";
 85    my $moved_code = RC_MOVED_PERMANTLY();
 86    print $c "HTTP/1.0 $moved_code Moved permanently$CRLF";
 87    print $c "Location: $moved_to$CRLF";
 88    print $c "Content-type: text/html$CRLF$CRLF";
 89    print $c <<"END";
 90  <HTML>
 91  <HEAD><TITLE>$moved_code Moved</TITLE></HEAD>
 92  <BODY><H1>Moved</H1>
 93  <P>The requested document has moved
 94  <A HREF="$moved_to">here</A>.</P>
 95  </BODY>
 96  </HTML>
 97  END
 98  }

Retornemos a handle_connection. Devolvemos el código RC_OK (200) seguido de las cabeceras indicando la longitud, el tipo MIME del documento y la codificación, terminado por el par de $CRLFs:

 35    print $c "HTTP/1.0 ".RC_OK." OK$CRLF";
 36    print $c "Content-length: $length$CRLF";
 37    print $c "Content-type: $type; charset=utf-8$CRLF";
 38    print $c $CRLF;

Un servidor HTTP como Apache devuelve una cabecera mas completa indicando el nombre del servidor, fecha y hora de modificación del fichero, etc. Véase un ejemplo de cabecera devuelta por Apache:

HTTP/1.1 200 OK
Date: Mon, 12 May 2008 12:33:09 GMT
Server: Apache/1.3.34 (Debian) PHP/5.2.0-8+etch10 \
        mod_ssl/2.8.25 OpenSSL/0.9.8c mod_perl/1.29
Last-Modified: Tue, 19 Feb 2008 11:17:24 GMT
ETag: "16ec3a-d9-47babac4"
Accept-Ranges: bytes
Content-Length: 217
Connection: close
Content-Type: text/html; charset=utf-8

Ya estamos llegando al final de handle_connection. Si a solicitud fue HEAD hemos terminado. Si no volcamos los contenidos del fichero en el socket y cerramos el fichero y retornamos.

 41    return unless $method eq 'GET';
 42
 43    # print the content
 44    my $buffer;
 45    while ( read($fh,$buffer,1024) ) {
 46      print $c $buffer;
 47    }
 48    close $fh;
 49  }

La Subrutina lookup_file

Esta subrutina se encarga de traducir la URL al camino al archivo en el sistema de archivos del servidor, determinar el tipo MIME (Multipurpose Internet Mail Extensions, véase la entrada en la MIME y la longitud del fichero.

 51  sub lookup_file {
 52    my $url = shift;
 53    my $path;
 54    if ($url =~ m{\~(\w+)/(.*)}) {
 55      $path = "/home/$1/public_html/$2"            # user pages
 56    }
 57    else {
 58      $path = $DOCUMENT_ROOT . $url;               # turn into a path
 59    }
 60    $path =~ s/\?.*$//;                            # ignore query
 61    $path =~ s/\#.*$//;                            # get rid of fragment
 62    $path .= 'index.html' if $path=~m!/$!;         # get index.html if path ends in /
 63    warn "path = $path\n";
 64
 65    return if $path =~ m!/\.\./!;                   # don't allow relative paths (..)
 66    return (undef,'directory',undef) if -d $path;   # oops! a directory
 67
 68    my $type = 'text/plain';                        # default MIME type
 69
 70    my $mimeobj = MIME::Types->new->mimeTypeOf($path);
 71    $type = $mimeobj->type if defined($mimeobj);
 72
 73    warn "Type = $type\n";
 74
 75    return unless my $length = (stat(_))[7];        # file size
 76    return unless my $fh = IO::File->new($path,"<");   # try to open file
 77    return ($fh,$type,$length);
 78  }

La variable $DOCUMENT_ROOT ha sido inicializada a /var/www/. Sin embargo no todos los ficheros servidos residen bajo este directorio. Para darle mayor generalidad serviremos ficheros en directorios de usuarios.

Se usa el método MIME::Types::new del módulo MIME::Types para crear un objeto MIME::Types. El método mimeTypeOf nos permite determinar el tipo MIME del fichero.

La función stat es usada para obtener la longitud del fichero (en bytes).



Subsecciones
Casiano Rodríguez León
Licencia de Creative Commons
Programación Distribuida y Mejora del Rendimiento
por Casiano Rodríguez León is licensed under a Creative Commons Reconocimiento 3.0 Unported License.

Permissions beyond the scope of this license may be available at http://campusvirtual.ull.es/ocw/course/view.php?id=44.
2012-06-19