• Publicidad

Descargar adjuntos desde Gmail

¿Apenas comienzas con Perl? En este foro podrás encontrar y hacer preguntas básicas de Perl con respuestas aptas a tu nivel.

Descargar adjuntos desde Gmail

Notapor 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
  1. #!/usr/bin/perl
  2.  
  3. use Net::IMAP::Client;
  4. use Email::MIME::Attachment::Stripper;
  5. use Data::Dumper;
  6.  
  7. $HOST     = "imap.gmail.com";
  8. $USERNAME = "cuenta\@dominio.com";
  9. $PASSWORD = "contraseña";
  10.  
  11. my $imap = Net::IMAP::Client->new(
  12.     server => $HOST,
  13.     user   => $USERNAME,
  14.     pass   => $PASSWORD,
  15.     ssl    => 1,
  16.     port   => 993,
  17. ) or die "Could not connect to IMAP server";
  18.  
  19. $imap->login or die( 'Login failed: ' . $imap->last_error );
  20.  
  21. $imap->select('INBOX');
  22.  
  23. my $messages = $imap->search('ALL');
  24.  
  25. foreach $msg (@$messages) {
  26.     my $data = $imap->get_rfc822_body($msg);
  27.  
  28.     my $parsed = Email::MIME->new($data);
  29.  
  30.     my $stripper = Email::MIME::Attachment::Stripper->new($parsed);
  31.  
  32.     for my $a ( $stripper->attachments() ) {
  33.  
  34.         next if $a->{'filename'} !~ /xls/i;
  35.         my $tempdir = "EXCEL/IN/";
  36.         my $tmpPath = $tempdir . $a->{'filename'};
  37.  
  38.         my $f = new IO::File $tmpPath, "w" or die "Cannot create file " . $tmpPath;
  39.         print $f $a->{'filename'};
  40.     }
  41. }
  42.  
  43. $imap->logout();
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4
Última edición por explorer el 2017-06-15 12:52 @578, editado 1 vez en total
Razón: Formateado de código con perltidy
coltx
Perlero nuevo
Perlero nuevo
 
Mensajes: 79
Registrado: 2011-09-16 08:01 @376

Publicidad

Re: Descargar adjuntos desde Gmail

Notapor explorer » 2017-06-15 13:05 @587

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.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Re: Descargar adjuntos desde Gmail

Notapor 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
  1. $f->binmode();
  2. print $f $a->{'payload'};
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
coltx
Perlero nuevo
Perlero nuevo
 
Mensajes: 79
Registrado: 2011-09-16 08:01 @376

Re: Descargar adjuntos desde Gmail

Notapor 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
coltx
Perlero nuevo
Perlero nuevo
 
Mensajes: 79
Registrado: 2011-09-16 08:01 @376

Re: Descargar adjuntos desde Gmail

Notapor 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?
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Re: Descargar adjuntos desde Gmail

Notapor 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?
coltx
Perlero nuevo
Perlero nuevo
 
Mensajes: 79
Registrado: 2011-09-16 08:01 @376

Re: Descargar adjuntos desde Gmail

Notapor 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.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Re: Descargar adjuntos desde Gmail

Notapor 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
  1. #!/usr/bin/perl
  2.  
  3.         use Net::IMAP::Client;
  4.         use Email::MIME::Attachment::Stripper;
  5.         use Data::Dumper;
  6.  
  7.  
  8.  
  9.                 $HOST           =        "imap.gmail.com";
  10.                 $USERNAME       =       "usuario";
  11.                 $PASSWORD       =       "contraseña";
  12.  
  13.                 my $imap = Net::IMAP::Client->new(
  14.                         server => $HOST,
  15.                     user   => $USERNAME,
  16.                     pass   => $PASSWORD,
  17.                     ssl    => 1,
  18.                     port   => 993,
  19.                 ) or die "Could not connect to IMAP server";
  20.  
  21.                 $imap->login or die('Login failed: ' . $imap->last_error);
  22.  
  23.                 $imap->select('INBOX');
  24.  
  25.                 my $messages = $imap->search('ALL');
  26.  
  27.  
  28.  
  29.                 foreach $msg (@$messages)
  30.                 {
  31.  
  32.                     my $data = $imap->get_rfc822_body($msg);
  33.                     my $parsed = Email::MIME->new($data);
  34.  
  35.                         my $stripper = Email::MIME::Attachment::Stripper->new($parsed);
  36.  
  37.                         my @attachments = $stripper->attachments;
  38.  
  39.  
  40.                     for my $a ($stripper->attachments()) {
  41.  
  42.  
  43.                                 print "$msg "  .$a->{'content_type'}." : ".$a->{'filename'}."\n";
  44.  
  45.                         next if $a->{'filename'} !~ /xls/i;
  46.                         my $tempdir = "EXCEL/IN/";
  47.                         my $tmpPath = $tempdir . $a->{'filename'};
  48.  
  49.                                 my $f = new IO::File $tmpPath, "w" or die "Cannot create file " . $tmpPath;
  50.  
  51.                                 $f->binmode();
  52.  
  53.                         print $f $a->{'payload'};
  54.                     }
  55.  
  56.                         $imap->copy($msg, 'Trash');
  57.                     $imap->add_flags($msg, '\\Deleted');
  58.                     $imap->expunge;
  59.  
  60.                 }
  61.  
  62.                 $imap->logout();
  63.  
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

y solo obtengo:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
11 multipart/alternative :
11 multipart/mixed :
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

:(
Muchas gracias de antemano.
coltx
Perlero nuevo
Perlero nuevo
 
Mensajes: 79
Registrado: 2011-09-16 08:01 @376

Re: Descargar adjuntos desde Gmail

Notapor 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.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España


Volver a Básico

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 4 invitados