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 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 $CRLF
s:
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).