Ver Tema

roy · 2009-02-21 11:17 @512

Saludos a todos... recién comienzo con esto del Perl y me gusta mucho ya que me da cierto control...

Aquí detallo mi consulta

Escenario:

Yo envío un archivo mediante formulario a un script CGI. Éste lo graba en el servidor mediante este fragmento de código :

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

open (OUTFILE, ">$tmp_dir/$archivo") || die "No Open";

binmode(OUTFILE); 

while ( read(STDIN, $buffer, 1024) ) 

{ print OUTFILE $buffer; }

Resultado del envío (solo fragmento del comienzo y final)

[code]-----------------------------41184676334
Content-Disposition: form-data; name="archivo"; filename="dimension.ppt"
Content-Type: application/octet-stream

{žø×šß=óõ.¯

explorer · 2009-02-21 12:43 @571

Bienvenido a los foros de Perl en Español, roy.

Yo creo que te convendría usar el módulo CGI. Tiene una forma muy cómoda de leer los parámetros enviados por un CGI, ocupándose de si es binario o no, y de quitar la información superflua.

En concreto, necesitas ver la parte de "upload" de ficheros.

Aquí tienes un ejemplo y un tutorial (que lo hace de otra manera).

Hay algún hilo más que habla del asunto.

roy · 2009-02-21 15:13 @676

Efectivamente uso un módulo CGI.

Ya he probado el tutorial que me envía mucho antes de inscribirme al foro y no funcionó en mi servidor.

Así que opté por usar un [i]script[/i] donde utilizan STDIN y logré enviar el archivo pero lo envía con esas cabeceras.

Por eso deduje que si de esta manera funciona, el problema se resumiría en eliminar esas cabeceras y esa línea al final del archivo.

kidd · 2009-02-21 15:33 @689

Básicamente el script que necesitas sería así:

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

use CGI;

my $query = new CGI;

my $ARCHIVO = $query->param("archivo");

open my $FILE, ">", "rutal/al/archivo"  or die "Unable to create file: $!";

binmode($FILE);

while (my $bytesread = read($ARCHIVO, my $buffer, 1024)) {

    print {$FILE} $buffer;

}

close ($FILE);

Si tu archivo es muy grande puede ser que el módulo CGI lo esté bloqueando. Tiene una opción donde puedes modificar el tamaño máximo de un POST, esto para evitar ese tipo de ataques, para modificarlo simplemente pon:

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

$CGI::POST_MAX = NÚMERO DE BYTES;

roy · 2009-02-21 15:44 @697

Muchas gracias...

El script falla en la línea

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

my $query = new CGI;

no la reconoce.

Por eso el fragmento de script que envié si funciona graba el archivo pero lo envía con todo y cabeceras.

kidd · 2009-02-21 15:47 @699

roy escribió:

el script falla en la línea

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

my $query = new CGI;

¿Y estás cargando el módulo CGI? Eso lo haces con:

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

use CGI;

Se me haría muy raro que tu versión de Perl no cuente con el módulo CGI, a menos de que sea viejísima.

roy · 2009-02-21 15:58 @707

Esto es lo que puse...

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

use CGI;

my $query = new CGI;

my $ARCHIVO = $query->param("Archivo");

open my $FILE, ">", "/home/www/rcdasoft"  or die "Unable to create file: $!";

binmode($FILE);

while (my $bytesread = read($ARCHIVO, my $buffer, 1024)) {

    print {$FILE} $buffer;

}

close ($FILE);

print "Content-type: text/html\n\n";

print "Archivo subido con &eacute;xito<br/>";

y no funciona

Éste sí funciona; graba el archivo.

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

#!/usr/bin/perl -W

use CGI;

use CGI::Carp qw(fatalsToBrowser);

use Fcntl qw(:DEFAULT :flock);

use File::Temp qw/ tempfile tempdir /;

use LWP::UserAgent;

use HTTP::Request;

$tmp_dir="/home/www/rcdasoft/";

$max_upload = 500000;  

$archivo = "ejemplo.jpg";

$datos_archivo = "$tmp_dir/$archivo"; 

$tam_archivo = "$tmp_dir/$archivo"."tam"; 

$content_type = $ENV{'CONTENT_TYPE'};

$content_length = $ENV{'CONTENT_LENGTH'};

open (OUTFILE, ">$tmp_dir/$archivo") || die "No se puedo crear el archivo";

binmode(OUTFILE); 

while ( read(STDIN, $buffer, 1024) ) {

print OUTFILE $buffer;

}

close (OUTFILE);

print "Content-type: text/html\n\n";

print "Archivo subido con &eacute;xito<br/>";

Pero graba el archivo con las cabeceras que menciono al inicio y que quiero eliminar pero no sé cómo.

explorer · 2009-02-21 17:20 @764

Prueba con este (no probado):

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

#!/usr/bin/perl

use warnings;

use CGI;

use CGI::Carp qw(fatalsToBrowser);

my $directorio = '/home/www/rcdasoft/';

my $cgi = CGI->new();

#my $nombre_fichero = $cgi->param('archivo');  # Algunos navegadores no devuelven correctamente el nombre

my $nombre_fichero = 'archivocualquiera';     # Ponemos un nombre de fichero cualquiera

my $fichero = $cgi->upload('archivo');  # Accedemos al campo upload del formulario

my $buffer;

open OUTFILE, ">$directorio/$nombre_fichero";

binmode OUTFILE;                          # Necesario si estamos en UNIX/Linux

while ( read($fichero, $buffer, 8192) ) { # Transferimos en bloques de 8Kb

    print OUTFILE $buffer;

}

close OUTFILE;

print $cgi->header(),

      $cgi->start_html('Fichero enviado'),

      $cgi->p('Fichero enviado'),

      $cgi->end_html;

Un par de detalles:

* Con el módulo CGI no es necesario sacar 'a mano' las cabeceras ('Content') del resultado. Con la función header() ya las tenemos

* No es necesario poner el binmode() a $fichero porque estamos usando read() para leer su contenido, así que ya estamos accediendo en formato binario a su contenido.

* En el programa, 'archivo' es el nombre del campo del formulario que el usuario utiliza para enviarnos su fichero. Debes cambiar en el programa ese nombre según el campo del formulario que estés usando en la página

* El acceder a ese campo, se puede hacer de dos maneras, como ves en el código. Con param() accedes al nombre del fichero (según el navegador que se use, será el nombre del fichero o el nombre junto con el path, local, en el lado del cliente). Y la otra forma es con upload(), que devuelve el filehandle del fichero enviado y a partir del cual lo leemos. No usamos STDIN porque en el flujo que recibimos van muchas cosas mezcladas (cabeceras, separadores de campo, los propios valores de campos, etc.); por eso usamos CGI, para que se ocupe de esas cosas. Nosotros solo usamos upload() y nos olvidamos de todo lo demás.

Otra opción más corta (no probado):

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

#!/usr/bin/perl

use CGI ':standard';

use CGI::Carp 'fatalsToBrowser';

$directorio = '/home/www/rcdasoft/';

$nombre_fichero = param ('archivo');

$fichero        = upload('archivo');

open OUTFILE, ">$directorio/$nombre_fichero";

while ( <$fichero> ) {

    print OUTFILE $_;

}

close OUTFILE;

print header,

      start_html('Fichero enviado'),

      p('Fichero enviado'),

      end_html;

roy · 2009-02-21 17:33 @772

No funciona.
No captura los datos del campo.

Como les decía, este servidor solo lo hace con STDIN.

Y la idea es buscar una opción que filtre eso datos demás.

explorer · 2009-02-21 17:39 @777

En el new() del CGI, lo cambias por

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

$query = new CGI(\*STDIN);

y asunto resuelto.

roy · 2009-02-21 21:26 @935

Muchas gracias por la respuesta...

La probaré dentro de un momento...
el servidor quedó bloqueado... no sé por qué... no funciona ni una página...
apenas se restablezca seguiré probando...
y les informo...

Gracias

roy · 2009-02-21 22:57 @998

Bien les mando el código para me den una manita.

Los ejemplos anteriores no funcionaron. Gracias por todo.

Syntax: [ Download ] [ Hide ]

Using perl Syntax Highlighting

#!/usr/bin/perl -W

#Definimos los módulos que vamos a utilizar

use CGI;

use CGI::Carp qw(fatalsToBrowser);

use Fcntl qw(:DEFAULT :flock);

use File::Temp qw/ tempfile tempdir /;

use LWP::UserAgent;

use HTTP::Request;

my $tmp_dir="/home/www/rcdasoft/";

my $max_upload = 500000; #Aproximadamente 0,5MB 

#si comento estas tres lineas y pongo stdin funciona y me lo envia con cabeceras 

my $query = new CGI(STDIN);

my $ARCHIVOO = $query->param("archivo");

my $ARCHIVOO = $query->upload('archivo');  # Accedemos al campo upload del formulario

my $archivo = "ejemplo1.jpg";

my $datos_archivo = "$tmp_dir/$archivo"; #Donde se guardará el archivo

my $tam_archivo = "$tmp_dir/$archivo"."tam"; #Donde se guardará el tamaño del archivo total

#my $content_type = $ENV{'CONTENT_TYPE'};

#my $content_length = $ENV{'CONTENT_LENGTH'};

 #Abrimos el nuevo archivo

open (OUTFILE, ">$tmp_dir/$archivo") || die "No se puedo crear el archivo";

#binmode(OUTFILE); #Para no tener problemas en Windows

#Transferimos byte por byte el archivo ahora solo obtengo un archivo vacio..

while ( read($ARCHIVOO, my $buffer, 1024) ) {

print OUTFILE $buffer;

}

#Cerramos el archivo

close (OUTFILE);

print "Content-type: text/html\n\n";

print "Archivo subido con &eacute;xito <br/>";

print "<a href='http://pruebas.quomusic.es/demo/descargar.php?id=>Descargar archivo</a>";

roy · 2009-02-23 15:46 @699

Hice las pruebas y no envía las variables... con STDIN sí sube... alguna de controlar el tiempo de ejecución ...

Publicidad

Socializa