El programa propone una solución al problema de ejecutar CGI's de larga duración y evitar que el servidor apache corte la conexión.
El módulo CGI fué durante mucho tiempo el módulo mas usado en la elaboración de CGIs.
Las líneas 5 y 11-14 hacen que los mensajes de warning sean redirigidos a un fichero:
1 #!/usr/local/bin/perl -w -T 2 use strict; 3 use Template; 4 use CGI qw(:all delete_all); 5 use CGI::Carp qw(carpout fatalsToBrowser); . ..................... 10 11 BEGIN { 12 open (my $LOG,'>>/tmp/watchcommand.errors') || die "couldn't open file: $!"; 13 carpout($LOG); 14 }
La opción -T
permite controlar si los datos proceden o no del exterior
(taint). La función tainted de Scalar::Util
permite
saber si una expresión es tainted:
$taint = tainted("constant"); # false $taint = tainted($ENV{PWD}); # true if running under -T
\parrafo{El Programa Principal} El programa principal considera tres casos: \begin{itemize} \item Es una nueva sesión: se ejecuta \verb|new_session($host)| \item Es continuación de una sesión anterior: \verb|continue_session($session)| \item Si no es ninguno de esos dos casos se muestra el formulario: \verb|show_form($form_tt, $form_val)| \end{itemize} \begin{verbatim} 16 # Templates 17 my $result_tt = 'results.html'; # For results 18 my $form_tt = 'form'; # For the form 19 my $wrapper = 'page'; # General wrapper 20 21 $|++; 22 23 # To avoid the message 'Insecure $ENV{PATH} while running with -T' 24 $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin"; 25 26 my $seconds = 6; 27 my $refreshseconds = 3; 28 29 my $form_val = { 30 title => 'Traceroute', 31 head => 'Traceroute', 32 action => script_name(), 33 question => '', 34 submit => 'traceroute to this host', 35 name => 'host', 36 }; 37 38 if (my $session = param('session')) { 39 continue_session($session) 40 } 41 elsif (my $host = param('host')) { 42 new_session($host); 43 } 44 else { 45 show_form($form_tt, $form_val); 46 } 47 exit 0;
La solución utilizada se basa en client pull o meta refresh. Client/Pull se puede implantar mediante una directiva meta en la página HTML:
<HEAD> <META HTTP-EQUIV="Refresh" CONTENT="2"> <TITLE>Page</TITLE> </HEAD>
en este ejemplo la página a recargar es la propia página ya no se ha especificado atributo URL.
La petición inicial crea un proceso mediante fork
y redirije al
cliente a la nueva URL:
98 sub new_session { # returning to select host 99 my $host = shift; 100 101 if ($host =~ /\A([\w.-]{1,100})\Z/) { # create a session 102 $host = $1; # untainted now 103 my $session = get_session_id(); 104 my $cache = get_cache_handle(); 105 $cache->set($session, [0, ""]); # no data yet 106 107 if (my $pid = fork) { # parent does 108 delete_all(); # clear parameters 109 param('session', $session); 110 print redirect(self_url()); 111 } elsif (defined $pid) { # child does ... ....... 126 } else { 127 die "Cannot fork: $!"; 128 } ... ....
La subrutina
new_session
crea una única clave de sesión:
103 my $session = get_session_id();Para ello usa el módulo Digest::MD5:
http://machine/~user/cgi-bin/watchcommand?session=4981bd99d82e5f12fd1b8a23c9f0874bLa dirección resultante queda de la forma:
68 sub get_session_id { 69 Digest::MD5::md5_hex(Digest::MD5::md5_hex(time().{}.rand().$$)); 70 }
MD5 (Message-Digest algoritmo 5) es una función hash coun valor de 128 bits. Entro otras aplicaciones se ha usado para comprobar la integridad de ficheros. icomo se muestra en el ejemplo es habitual que un hash MD5 se exprese como una cadena de 32 dígitos hexadecimales.
Es necesario crear una asociación entre la sesión y el estado (las variables y parámetros) que caracterizan a la sesión. Una forma de hacerlo es mediante Cache::Cache:
98 sub new_session { # returning to select host 99 my $host = shift; 100 101 if ($host =~ /\A([\w.-]{1,100})\Z/) { # create a session 102 $host = $1; # untainted now 103 my $session = get_session_id(); 104 my $cache = get_cache_handle(); 105 $cache->set($session, [0, ""]); # no data yet
El primer valor almacenado en la llamada $cache->set($session, [0, ""])
es el valor lógico que indica si la aplicación ha terminado o no. El segundo
es la salida del programa (en este caso traceroute
).
57 sub get_cache_handle { 58 59 Cache::FileCache->new 60 ({ 61 namespace => 'tracerouter', 62 username => 'nobody', 63 default_expires_in => '30 minutes', 64 auto_purge_interval => '4 hours', 65 }); 66 }
El proceso hijo/servidor usa client pull para mantener actualizados los datos. Si el programa siendo ejecutado aún no ha terminado se inserta la cabecera que instruye al navegador para que refresque los datos despues de un cierto número de segundos:
72 sub continue_session { # returning to pick up session data 73 my $session = shift; 74 75 my $cache = get_cache_handle(); 76 my $data = $cache->get($session); 77 unless ($data and ref $data eq "ARRAY") { # something is wrong 78 show_form($form_tt, $form_val); 79 exit 0; 80 } 81 82 my $template = Template->new(); 83 84 my $finished = $data->[0]; 85 print header(-charset => 'utf-8' ); 86 my $vars = { 87 finished => $finished, 88 title => "Traceroute Results", 89 refresh => ($finished ? "" : "<meta http-equiv=refresh content=$refreshseconds>"), 90 header => 'Traceroute Results', 91 continue => ($finished ? "FINISHED" : "... CONTINUING ..."), 92 message => $data->[1], 93 %$form_val, # Insert form parameters 94 }; 95 $template->process($result_tt, $vars); 96 }
Creamos un objeto Template
con Template->new()
y lo rellenamos
con $template->process($result_tt, $vars)
. Este es el template utilizado:
$ cat -n results.html 1 <!DOCTYPE html 2 PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" 3 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> 4 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US"> 5 <head> 6 <title>[% title %]</title> 7 [% refresh %] 8 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /> 9 </head> 10 <body> 11 <h1>[% header %]</h1> 12 <pre> 13 [% message | html %] 14 </pre> 15 <p><i>[% continue %]</i></p> 16 </body> 17 [% 18 IF finished 19 %] 20 <hr> 21 [% 22 PROCESS form; 23 END 24 %] 25 </html>
Obsérvese el uso del filtro html
en la línea [% message
html
El padre elimina los parámetros del CGI mediante la llamada
a delete_all
y redirige al browser a la página de esta sesión.
El proceso hijo creado para la nueva sesión
es el que se encargará de ejecutar /usr/sbin/traceroute
.
Primero cierra STDOUT
: de otro modo Apache permanecería a
la espera. Después se lanza un nieto con
open $F, "-|"
cuya salida es redirijida al hijo.
El nieto es quien realmente ejecuta la aplicación mediante
exec
. En vez de ejecutarla directamente usamos
timed-process
. Este guión viene
con Proc::Background
para limitar el tiempo de ejecución.
La línea open STDERR, ">&=1"
es equivalente
a open STDERR, ">&STDOUT"
y redirige STDERR
a
STDOUT
.
98 sub new_session { # returning to select host 99 my $host = shift; 100 101 if ($host =~ /\A([\w.-]{1,100})\Z/) { # create a session ... ........................................... 107 if (my $pid = fork) { # parent does 108 delete_all(); # clear parameters 109 param('session', $session); 110 print redirect(self_url()); 111 } elsif (defined $pid) { # child does 112 close STDOUT; # so parent can go on 113 my $F; 114 unless (open $F, "-|") { 115 open STDERR, ">&=1"; 116 exec "timed-process", $seconds, "/usr/sbin/traceroute", $host; 117 die "Cannot execute traceroute: $!"; 118 } 119 my $buf = ""; 120 while (<$F>) { 121 $buf .= $_; 122 $cache->set($session, [0, $buf]); 123 } 124 $cache->set($session, [1, $buf]); 125 exit 0; 126 } else { 127 die "Cannot fork: $!"; 128 } ... ...........................................
El hijo queda a la espera de la salida de la aplicación,
leyendo mediante el manejador $F
. Cada vez que lee algo nuevo
lo vuelca en la cache con $cache->set($session, [0, $buf])
.
Cuando recibe el EOF desde la aplicación
vuelca
de nuevo el buffer indicando la finalización del proceso
$cache->set($session, [1, $buf])
1 #!/usr/local/bin/perl -w -T 2 use strict; 3 use Template; 4 use CGI qw(:all delete_all); 5 use CGI::Carp qw(carpout fatalsToBrowser); 6 use Proc::Background; 7 use Cache::FileCache; 8 use Digest::MD5; 9 10 11 BEGIN { 12 open (my $LOG,'>>/tmp/cgisearch.errors') || die "couldn't open file: $!"; 13 carpout($LOG); 14 } 15 16 # Templates 17 my $result_tt = 'results.html'; # For results 18 my $form_tt = 'form'; # For the form 19 my $wrapper = 'page'; # General wrapper 20 21 $|++; 22 23 # To avoid the message 'Insecure $ENV{PATH} while running with -T' 24 $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin"; 25 26 my $seconds = 6; 27 my $refreshseconds = 3; 28 29 my $form_val = { 30 title => 'Traceroute', 31 head => 'Traceroute', 32 action => script_name(), 33 question => '', 34 submit => 'traceroute to this host', 35 name => 'host', 36 }; 37 38 if (my $session = param('session')) { 39 continue_session($session) 40 } 41 elsif (my $host = param('host')) { 42 new_session($host); 43 } 44 else { 45 show_form($form_tt, $form_val); 46 } 47 exit 0; 48 49 sub show_form { 50 my ($form_tt, $vars) = @_; 51 52 my $template = Template->new( WRAPPER => $wrapper ); 53 print header(-charset => 'utf-8' ); 54 $template->process($form_tt, $vars); 55 } 56 57 sub get_cache_handle { 58 59 Cache::FileCache->new 60 ({ 61 namespace => 'tracerouter', 62 username => 'nobody', 63 default_expires_in => '30 minutes', 64 auto_purge_interval => '4 hours', 65 }); 66 } 67 68 sub get_session_id { 69 Digest::MD5::md5_hex(Digest::MD5::md5_hex(time().{}.rand().$$)); 70 } 71 72 sub continue_session { # returning to pick up session data 73 my $session = shift; 74 75 my $cache = get_cache_handle(); 76 my $data = $cache->get($session); 77 unless ($data and ref $data eq "ARRAY") { # something is wrong 78 show_form($form_tt, $form_val); 79 exit 0; 80 } 81 82 my $template = Template->new(); 83 84 my $finished = $data->[0]; 85 print header(-charset => 'utf-8' ); 86 my $vars = { 87 finished => $finished, 88 title => "Traceroute Results", 89 refresh => ($finished ? "" : "<meta http-equiv=refresh content=$refreshseconds>"), 90 header => 'Traceroute Results', 91 continue => ($finished ? "FINISHED" : "... CONTINUING ..."), 92 message => $data->[1], 93 %$form_val, # Insert form parameters 94 }; 95 $template->process($result_tt, $vars); 96 } 97 98 sub new_session { # returning to select host 99 my $host = shift; 100 101 if ($host =~ /\A([\w.-]{1,100})\Z/) { # create a session 102 $host = $1; # untainted now 103 my $session = get_session_id(); 104 my $cache = get_cache_handle(); 105 $cache->set($session, [0, ""]); # no data yet 106 107 if (my $pid = fork) { # parent does 108 delete_all(); # clear parameters 109 param('session', $session); 110 print redirect(self_url()); 111 } elsif (defined $pid) { # child does 112 close STDOUT; # so parent can go on 113 my $F; 114 unless (open $F, "-|") { 115 open STDERR, ">&=1"; 116 exec "timed-process", $seconds, "/usr/sbin/traceroute", $host; 117 die "Cannot execute traceroute: $!"; 118 } 119 my $buf = ""; 120 while (<$F>) { 121 $buf .= $_; 122 $cache->set($session, [0, $buf]); 123 } 124 $cache->set($session, [1, $buf]); 125 exit 0; 126 } else { 127 die "Cannot fork: $!"; 128 } 129 } else { 130 show_form($form_tt, $form_val); 131 } 132 }
$ cat -n form 1 <h1>[% head %]</h1> 2 <form method="post" action="[% action %]" enctype="multipart/form-data"> 3 [% question %] <input type="text" name="[% name %]" /> 4 <input type="submit" value="[% submit %]"> 5 </form>
$ cat -n page 1 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US"> 2 <head> 3 <title>[% title %]</title> 4 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> 5 </head> 6 <body bgcolor = [% bgcol %]> 7 [% content %] 8 <hr> 9 </body> 10 </html>