Foro - Perl en Español

por **coltx** » 2017-06-15 11:23 @516

Estimados, necesito de su ayuda... leyendo acerca de cómo descargar adjuntos desde un buzón en Gmail he logrado construir el siguiente script el cual me descarga el archivo Excel en este caso, pero el Excel llega solo con el nombre del archivo escrito en su primera celda. La información real no viene... desde ya muchas gracias por su ayuda...

El script es el siguiente:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
 
use Net::IMAP::Client;
use Email::MIME::Attachment::Stripper;
use Data::Dumper;
 
$HOST     = "imap.gmail.com";
$USERNAME = "cuenta\@dominio.com";
$PASSWORD = "contraseña";
 
my $imap = Net::IMAP::Client->new(
    server => $HOST,
    user   => $USERNAME,
    pass   => $PASSWORD,
    ssl    => 1,
    port   => 993,
) or die "Could not connect to IMAP server";
 
$imap->login or die( 'Login failed: ' . $imap->last_error );
 
$imap->select('INBOX');
 
my $messages = $imap->search('ALL');
 
foreach $msg (@$messages) {
    my $data = $imap->get_rfc822_body($msg);
 
    my $parsed = Email::MIME->new($data);
 
    my $stripper = Email::MIME::Attachment::Stripper->new($parsed);
 
    for my $a ( $stripper->attachments() ) {
 
        next if $a->{'filename'} !~ /xls/i;
        my $tempdir = "EXCEL/IN/";
        my $tmpPath = $tempdir . $a->{'filename'};
 
        my $f = new IO::File $tmpPath, "w" or die "Cannot create file " . $tmpPath;
        print $f $a->{'filename'};
    }
}
 
$imap->logout();
Coloreado en 0.004 segundos,  usando GeSHi 1.0.8.4

Bueno, te guarda solo el nombre del archivo porque eso es justo lo que estás haciendo en la línea 39.

Según la documentación de Email::MIME::Attachment::Stripper, el método attachments() devuelve un array, en que cada elemento es un hash, con claves filename, content_type y payload.

Entonces, se supone que la "carga" está justo en el payload, así que es la clave que debes usar en la línea 39.

Pero, atención... ¿Seguro que IO::File ha abierto el archivo $tmpPath en modo binario? Si no lo haces, puede grabar mal el adjunto en el disco.

Debes ejecutar $f->binmode(); antes de escribir.

por **coltx** » 2017-06-15 17:23 @766

Listo, tienes toda la razón... funcionó perfecto.

Muchas gracias, explorer... El cambio fue este:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

$f->binmode();
print $f $a->{'payload'};
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **coltx** » 2017-06-16 10:43 @488

explorer, cuando pensé que se había acabado el problema... aparece otro. Me pasa algo extraño: cuando envío un adjunto desde mi correo a la casilla desde la cual estoy recuperando el adjunto, el script lo toma sin ningún problema.

Sin embargo cuando envío la información desde un sistema puedo ver que en la casilla llega el adjunto, pero el script no es capaz de reconocerlo y por ende no lo descarga...

Este es el mensaje original que recibo en Gmail:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

MIME-Version: 1.0

From: Tracking Reports <[email protected]>

To: <[email protected]>

Date: Fri, 16 Jun 2017 15:13:28 +0000

Subject:  Tracking report Last_20_Days 

Content-Type: multipart/mixed; boundary="--boundary_7400_9e59c35a-8018-4ae5-8d6f-0d659fbe8882"

Message-ID: <[email protected]>

X-SpamH-Filter: treports-out-s1.smtp25.com-v5GFDS9Y010627

X-SpamH-OriginatingIP: 85.239.10.130

----boundary_7400_9e59c35a-8018-4ae5-8d6f-0d659fbe8882

Content-Type: multipart/alternative; boundary="--boundary_7398_ba022b4d-4e63-4cbe-9168-3a6b35b8ac48"

----boundary_7398_ba022b4d-4e63-4cbe-9168-3a6b35b8ac48

Content-Type: multipart/related; boundary="--boundary_7399_602d20d3-69ee-4751-b53e-d32e4b607130"; type="text/html"

----boundary_7399_602d20d3-69ee-4751-b53e-d32e4b607130

Content-Type: text/html; charset="utf-8"

Content-Transfer-Encoding: base64

PGh0bWw+PGhlYWQ+DQoJPHN0eWxlIHR5cGU9InRleHQvY3NzIj4NCglib2R5LCB0YWJsZSwgdGQN

Cgl7DQoJCWZvbnQtZmFtaWx5OiBHZW5ldmEsIEFyaWFsLCBIZWx2ZXRpY2EsIHNhbnMtc2VyaWY7

DQoJCXBhZGRpbmc6IDVweCAxMHB4IDBweCA1cHg7DQoJCWZvbnQtc2l6ZTogMTJweDsNCgl9CQkN

Cgk8L3N0eWxlPg0KPC9oZWFkPjxib2R5PjxwPjxzdHJvbmc+UGxlYXNlIGNvbnRhY3QgeW91ciBB

Z2lsaXR5IHJlcHJlc2VudGF0aXZlIGlmIHlvdSBoYXZlIGFueSBxdWVzdGlvbnMuPC9zdHJvbmc+

PGJyIC8+PGJyIC8+UmVwb3J0IGF0dGFjaGVkLCByZXF1ZXN0ZWQgYnkgQWJuZXIgU2V2ZXJpbm8g

KGFzZXZlcmlub0BhZ2lsaXR5LmNvbSkgYXQgMTYgSnVuIDE3IDExOjEzIFBTQVNULjxiciAvPjxi

ciAvPjxzdHJvbmc+UGxlYXNlIGRvIG5vdCByZXBseSBkaXJlY3RseSB0byB0aGlzIGVtYWlsLjwv

c3Ryb25nPjwvYnI+PC9wPjxwPjxhIGhyZWY9Imh0dHA6Ly93d3cuYWdpbGl0eS5jb20vIj48aW1n

ICBoZWlnaHQ9Ijc2IiAgc3JjPSJjaWQ6aW1nTG9nbyIgYWx0PSJBZ2lsaXR5IiBib3JkZXI9IjAi

IC8+PC9hPjwvcD48YnI+PGJyPioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqTk9USUNF

KioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKiANPGJyPg08YnI+QWxsIGJ1c2lu

ZXNzIGhhbmRsZWQgaXMgc3ViamVjdCB0byBhbnkgY29tcHVsc29yeSBjb3VudHJ5IGxlZ2lzbGF0

aW9uIHdoZXJlIGFwcGxpY2FibGUgb3IgdW5sZXNzIHNwZWNpZmljYWxseSBhZ3JlZWQgd2lsbCBi

ZSBiYXNlZCBieSBkZWZhdWx0IG9uIG91ciBHZW5lcmFsIFRyYWRpbmcgQ29uZGl0aW9ucywgYSBj

b3B5IG9mIHdoaWNoIHdpbGwgYmUgbWFkZSBhdmFpbGFibGUgdXBvbiByZXF1ZXN0LiANPGJyPg08

YnI+VGhpcyB0cmFuc21pdHRhbCBhbmQvb3IgYXR0YWNobWVudHMgaGF2ZSBiZWVuIGlzc3VlZCBi

eSBBZ2lsaXR5LiBUaGUgaW5mb3JtYXRpb24gY29udGFpbmVkIGhlcmUgd2l0aGluIG1heSBiZSBw

cml2aWxlZ2VkIG9yIGNvbmZpZGVudGlhbC4gSWYgeW91IGFyZSBub3QgdGhlIGludGVuZGVkIHJl

Y2lwaWVudCwgeW91IGFyZSBoZXJlYnkgbm90aWZpZWQgdGhhdCB5b3UgaGF2ZSByZWNlaXZlZCB0

aGlzIHRyYW5zbWl0dGFsIGluIGVycm9yOyBhbnkgcmV2aWV3LCBkaXNzZW1pbmF0aW9uLCBkaXN0

cmlidXRpb24gb3IgY29weWluZyBvZiB0aGlzIHRyYW5zbWl0dGFsIGlzIHN0cmljdGx5IHByb2hp

Yml0ZWQuIElmIHlvdSBoYXZlIHJlY2VpdmVkIHRoaXMgdHJhbnNtaXR0YWwgYW5kL29yIGF0dGFj

aG1lbnRzIGluIGVycm9yLCBwbGVhc2Ugbm90aWZ5IHVzIGltbWVkaWF0ZWx5IGJ5IHJlcGx5IGFu

ZCBpbW1lZGlhdGVseSBkZWxldGUgdGhpcyBtZXNzYWdlIGFuZCBhbGwgaXRzIGF0dGFjaG1lbnRz

Lgo8L2JvZHk+PC9odG1sPg==

----boundary_7399_602d20d3-69ee-4751-b53e-d32e4b607130

Content-Type: application/octet-stream; name="emaillogo.gif"

Content-Transfer-Encoding: base64

Content-ID: <imgLogo>

----boundary_7399_602d20d3-69ee-4751-b53e-d32e4b607130--

----boundary_7398_ba022b4d-4e63-4cbe-9168-3a6b35b8ac48--

----boundary_7400_9e59c35a-8018-4ae5-8d6f-0d659fbe8882

Content-Type: multipart/mixed; boundary="--boundary_7401_6ad5ec11-c0c2-4841-8b28-baeeb8a3b8b8"

----boundary_7401_6ad5ec11-c0c2-4841-8b28-baeeb8a3b8b8

Content-Type: application/octet-stream; name="Last_20_Days_Containers_20170616_1513.xls"

Content-Transfer-Encoding: base64

Content-Disposition: attachment

----boundary_7401_6ad5ec11-c0c2-4841-8b28-baeeb8a3b8b8--

----boundary_7400_9e59c35a-8018-4ae5-8d6f-0d659fbe8882--Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **explorer** » 2017-06-16 11:52 @536

Eso quizás quiere decir que los programas de correo, que crean las cartas junto con los adjuntos, no los crean de la misma manera. Por ejemplo, con la cantidad y forma de las partes MIME.

En el ejemplo que mandas, veo que hay partes MIME que están anidadas. Creo que es la primera vez que veo algo así.

¿Qué programas de correo usas para crear los correos?

por **coltx** » 2017-06-16 15:24 @683

Hola, explorer. Desconozco el programa; es una aplicación web de otra empresa.

¿Conoces otra forma de poder capturar estos tipos de adjuntos?

por **explorer** » 2017-06-16 21:48 @950

¿Usan un programa web para crear correos? Curioso... ¡Con lo cómodo que es usar el Mozilla Thunderbird!

Por estos foros hemos hablado en algunas ocasiones de poner y sacar adjuntos a un correo, algunas veces usando las mimetools.

Usa el sistema de búsqueda de estos foros. Busca primero por "adjunto", y luego por "MIME".

También se puede hacer con Email::MIME, por ejemplo.

En fin... hay muchas opciones. Pero la clave está en que el correo original debe estar bien construido, siguiendo los estándares.

por **coltx** » 2017-06-20 15:39 @693

Hola, explorer.

No consigo llegar al adjunto. He tratado de descargar el correo a un texto para luego obtenerlo desde ahí... pero nada.

Si le hago un dumper a la variable $parsed asignada por mail::MIME->new($data), un extracto de lo que obtengo :

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

$VAR1 = bless( {

                 'body_raw' => '

----boundary_13912_ed9bff6e-191b-4b8e-922f-63cffb7265ca

Content-Type: multipart/alternative;

        boundary="--boundary_13910_1963eff1-7a46-477d-8b32-92add3e009c2"

----boundary_13910_1963eff1-7a46-477d-8b32-92add3e009c2

Content-Type: multipart/related;

        boundary="--boundary_13911_08b51114-0d00-4e9e-8a78-5f4f4805d710";

        type="text/html"

----boundary_13911_08b51114-0d00-4e9e-8a78-5f4f4805d710

Content-Type: text/html; charset="utf-8"

Content-Transfer-Encoding: base64

PGh0bWw+PGhlYWQ+DQoJPHN0eWxlIHR5cGU9InRleHQvY3NzIj4NCglib2R5

LCB0YWJsZSwgdGQNCgl7DQoJCWZvbnQtZmFtaWx5OiBHZW5ldmEsIEFyaWFs

LCBIZWx2ZXRpY2EsIHNhbnMtc2VyaWY7DQoJCXBhZGRpbmc6IDVweCAxMHB4

IDBweCA1cHg7DQoJCWZvbnQtc2l6ZTogMTJweDsNCgl9CQkNCgk8L3N0eWxl

Pg0KPC9oZWFkPjxib2R5PjxwPjxzdHJvbmc+UGxlYXNlIGNvbnRhY3QgeW91

9amxwOpqYyk5XCrbndwZEaM6lhn7steHOi57naNpszzbsz77s0AbtEI7tERb

tEZ7tEibtEq7tEzbtE77tFDLFwEBADs=

----boundary_13911_08b51114-0d00-4e9e-8a78-5f4f4805d710--

----boundary_13910_1963eff1-7a46-477d-8b32-92add3e009c2--

----boundary_13912_ed9bff6e-191b-4b8e-922f-63cffb7265ca

Content-Type: multipart/mixed;

        boundary="--boundary_13913_c1542f50-154c-42de-9683-efb9854ec2be"

----boundary_13913_c1542f50-154c-42de-9683-efb9854ec2be

Content-Type: application/octet-stream;

        name="Shipments_20170620_1445.xls"

Content-Transfer-Encoding: base64

Content-Disposition: attachment

DQoNCjxodG1sPg0KPGhlYWQ+DQogICAgPHN0eWxlIHR5cGU9InRleHQvY3Nz

Ij4NCiAgICAgICAgDQogICAgICAgIGJyIHttc28tZGF0YS1wbGFjZW1lbnQ6

c2FtZS1jZWxsO30NCiAgICAgICAgDQogICAgPC9zdHlsZT4NCjwvaGVhZD4N

Cg0KPGRpdiBpZD0iZHZIZWFkZXIiPg0KICAgIDx0YWJsZT4NCgkgICAgPHRy

Pg0KCQkgICAgPHRkIHJvd3NwYW49IjUiPjxpbWcgc3JjPSJodHRwczovL3Ry

UFAAAgABkmmnCeAB1eoRfhhoWLoW9YqwyvGdN0ACHsCEOTAHdKkR31AHN4AE

9amxwOpqYyk5XCrbndwZEaM6lhn7steHOi57naNpszzbsz77s0AbtEI7tERb

tEZ7tEibtEq7tEzbtE77tFDLFwEBADs=

----boundary_13911_08b51114-0d00-4e9e-8a78-5f4f4805d710--

----boundary_13910_1963eff1-7a46-477d-8b32-92add3e009c2--

',

                                       'header' => bless( {

                                                            'mycrlf' => '

',

                                                            'headers' => [

                                                                           'Content-Type',

                                                                           [

                                                                             'multipart/alternative; boundary="--boundary_13910_1963eff1-7a46-477

d-8b32-92add3e009c2"',

                                                                             'Content-Type: multipart/alternative;

        boundary="--boundary_13910_1963eff1-7a46-477d-8b32-92add3e009c2"'

                                                                           ]

                                                                         ]

                                                          }, 'Email::MIME::Header' ),

                                       'ct' => {

                                                 'discrete' => 'multipart',

                                                 'subtype' => 'alternative',

                                                 'attributes' => {

                                                                   'boundary' => '--boundary_13910_1963eff1-7a46-477d-8b32-92add3e009c2'

                                                                 },

                                                 'type' => 'multipart',

                                                 'composite' => 'alternative'

                                               },

                                       'mycrlf' => '

',

                                       'parts' => [

                                                    bless( {

                                                             'body_raw' => '

----boundary_13911_08b51114-0d00-4e9e-8a78-5f4f4805d710

Content-Type: text/html; charset="utf-8"

Content-Transfer-Encoding: base64
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Por favor, échame una mano para poder llegar al adjunto. El script que más cercano he construido ha sido el siguiente:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
 
        use Net::IMAP::Client;
        use Email::MIME::Attachment::Stripper;
        use Data::Dumper;
 
 
 
                $HOST           =        "imap.gmail.com";
                $USERNAME       =       "usuario";
                $PASSWORD       =       "contraseña";
 
                my $imap = Net::IMAP::Client->new(
                        server => $HOST,
                    user   => $USERNAME,
                    pass   => $PASSWORD,
                    ssl    => 1,
                    port   => 993,
                ) or die "Could not connect to IMAP server";
 
                $imap->login or die('Login failed: ' . $imap->last_error);
 
                $imap->select('INBOX');
 
                my $messages = $imap->search('ALL');
 
 
 
                foreach $msg (@$messages)
                {
 
                    my $data = $imap->get_rfc822_body($msg);
                    my $parsed = Email::MIME->new($data);
 
                        my $stripper = Email::MIME::Attachment::Stripper->new($parsed);
 
                        my @attachments = $stripper->attachments;
 
 
                    for my $a ($stripper->attachments()) {
 
 
                                print "$msg "  .$a->{'content_type'}." : ".$a->{'filename'}."\n";
 
                        next if $a->{'filename'} !~ /xls/i;
                        my $tempdir = "EXCEL/IN/";
                        my $tmpPath = $tempdir . $a->{'filename'};
 
                                my $f = new IO::File $tmpPath, "w" or die "Cannot create file " . $tmpPath;
 
                                $f->binmode();
 
                        print $f $a->{'payload'};
                    }
 
                        $imap->copy($msg, 'Trash');
                    $imap->add_flags($msg, '\\Deleted');
                    $imap->expunge;
 
                }
 
                $imap->logout();
 
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

y solo obtengo:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

multipart/alternative : 

multipart/mixed : Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Muchas gracias de antemano.

por **explorer** » 2017-06-20 20:09 @881

Creo que es una limitación del módulo Email::MIME::Attachment::Stripper.

En la descripción del módulo pone que los adjuntos deben ser solo de los tipos multipart/alternative o multipart/related. Si, como ocurre en tu caso, es un multipart/mixed, solo se tendrá en cuenta la primera parte de ese "mixed". Tu correo tiene esta estructura:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

+ multipart/alternative

| \- multipart/related

    \- text/html; charset="utf-8"

  + multipart/mixed

   \- application/octet-stream; name="Shipments_20170620_1445.xls"Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Así que hay una parte mixed que no la entiende el módulo.

Pero... estoy viendo, además, que las partes MIME se solapan entre sí.

Por ejemplo, estoy viendo que la parte con márgenes 5f4f4805d710 se entremezcla con los límites de las partes 92add3e009c2.

Humm... no me gusta nada... el correo es horrible. Parece generado por un producto de Micro$oft.

A las malas... pues habrá que hacerlo como antiguamente: sacar del mensaje la parte que nos interesa (la que va de la línea name="Shipments_20170620_1445.xls" hasta la siguiente línea que comience por '---boundary'), y todo ese contenido decodificarlo (sabemos que está codificado en base64).

Yo te diría que probaras con las mimetools, porque quizás entiendan este estropicio de correo. O al menos, decodificar el archivo en base64.

De todas maneras... lo que nos interesa es ver la parte 'parts' que hay al final de tu dumpeo. No la has puesto entera, pero si aparece la de la hoja de cálculo, hay una esperanza.

Foro - Perl en Español

Descargar adjuntos desde Gmail

Descargar adjuntos desde Gmail

Publicidad

Re: Descargar adjuntos desde Gmail

Re: Descargar adjuntos desde Gmail

Re: Descargar adjuntos desde Gmail

Re: Descargar adjuntos desde Gmail

Re: Descargar adjuntos desde Gmail

Re: Descargar adjuntos desde Gmail

Re: Descargar adjuntos desde Gmail

Re: Descargar adjuntos desde Gmail

¿Quién está conectado?