Procesos de Larga Duración desde un CGI

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.

Depuración y Control de Errores

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;

Client Pull

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.

Un Proceso por Sesión

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      }
...   ....

Creando un Identificador de Sesión

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=4981bd99d82e5f12fd1b8a23c9f0874b
La 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.

Cache::Cache

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  }

Usando Templates

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:

El Template para los Resultados

$ 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

Ejecución de la Aplicación y Captura de la Salida

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])

El Programa Completo

 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  }

El Template con el Formulario

$ 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>

Wrapper

$ 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>

Véase También

Véase Watching long processes through CGI de Randall Schwartz (Merlin). Este ejemplo es una modificación.



Subsecciones
Casiano Rodríguez León
2012-02-29