Sig: Práctica: Control de Procesos Sup: CGI Ant: Depuración con ptkdb y
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>
