Sig: Un Servidor HTTP Simple:Códigos Sup: Preforking Ant: Preforking
Cuando un navegador se conecta a un servidor envía una solicitud HTTP que consiste en:
CRLF
El código del cliente desarrollado en la sección
13.6 y la ejecución en la página
![[*]](crossref.png)
ilustran el funcionamiento del protocolo.
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 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
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 }
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).
