[SP-pm] Script coleta informações de email

Mike Tesliuk mike em braslink.com
Terça Junho 10 10:21:47 PDT 2008


Olá Edilson,

Você está colocando (talvez mais alguem alem de mim) no destinatario 
também, ou seja, estou recebendo sua mensagem na minha conta e na lista 
de email.


----------------------------------
Mike Tesliuk
Administrador de Sistemas
Braslink Networks
Phone: +55 11 2104 0005
Fax: +55 11 3544 4401


Edilson Azevedo wrote:
> Caramba!
> 
> Quantas respostas em tão pouco tempo! Fiquei impressionado!
> 
> Segue abaixo os dados solicitados:
> 
> Código:
> 
> ############################################################
> #!/usr/bin/perl
> 
> use MIME::Parser;
> use File::Basename;
> 
> undef $/; # We want to treat everything read from STDIN as one line
> $input = <>;
> $/ = "\n";
> ($headers, $body) = split (/\n\n/, $input, 2);
> 
> # Split MIME-multipart messages and store the parts in subdirectories
> # under the directory indicated by $output_path. Depending on which
> # mail system your site uses, the directory specified by $output_path might
> # have to have special permissions. If you have qmail, the dir should
> # be owned by the user 'alias'. Sendmail should be content with 'root'
> # as owner.
> my $output_path = '/home/r232991/perl';
> my ($parsed) = (basename($0))[0];
> my $parser = MIME::Parser->new();
> 
> # Permission mask for output files.
> # These permissions are very lax. Replace with what is appropriate
> # for your system.
> $oldumask = umask 0002;
> 
> #$parser->output_under($output_path);
> $parser->output_prefix($parsed);
> $parser->output_to_core();
> 
> my $entity = $parser->parse_data($input);
> # Permissions for the directory containing the output files.
> # These permissions are very lax. Replace with what is appropriate
> # for your system.
> chmod 0775, ($parser->output_dir);
> 
> # Process the headers:
> $procheaders = $headers;
> $procheaders =~ s/\?=\s\n/\?=\n/g; # Lines ending with an encoded-word
> # have an extra space at the end. Remove it.
> $procheaders =~ s/\n[ |\t]//g; # Merge multi-line headers into a single 
> line.
> $transheaders = '';
> 
> foreach $line (split(/\n/, $procheaders))
> {
> while ($line =~ m/=\?[^?]+\?(.)\?([^?]*)\?=/)
> {
> $encoding = $1;
> $txt = $2;
> $str_before = $`;
> $str_after = $';
> 
> # Base64
> if ($encoding =~ /b/i)
> {
> require MIME::Base64;
> MIME::Base64->import(decode_base64);
> $txt = decode_base64($txt);
> }
> 
> # QP
> elsif ($encoding =~ /q/i)
> {
> require MIME::QuotedPrint;
> MIME::QuotedPrint->import(decode_qp);
> $txt = decode_qp($txt);
> }
> 
> $line = $str_before . $txt . $str_after;
> }
> # The decode above does not do underline-to-space translation:
> $line =~ tr/_/ /;
> $transheaders .= $line . "\n";
> }
> 
> # Reconstruct the message, made from headers and the MIME text parts
> # we saved earlier. Add references in the message body to the non-text
> # parts that have been stripped out and stored. The purgeable method
> # returns the full path of the files constructed from the different
> # message parts.
> print $transheaders . "\n";
> 
> foreach $file ($parser->filer->purgeable) {
> # Strip trailing spaces from filenames:
> $file =~ /(\S*)\s*$/;
> $file = $1;
> if ($file =~ /\.txt\s*$/) {
> # We have found a plaintext part. Include it in the new body:
> #open PART, $file;
> #while (<PART>) {
> # print;
> #}
> #close PART;
> # Build list of files included in the new body. We will delete
> # these files further down.
> unshift @purgeables, $file;
> }
> else {
> # We have found a non-plaintext part. Add a reference to it in the
> # new body:
> print "\n\n** Attachment decoded and saved to \n** $file\n\n";
> }
> }
> 
> # Make the list we built the new list of purgeable files:
> $parser->filer->purgeable(\@purgeables);
> # Delete them:
> $parser->filer->purge;
> 
> umask $oldumask;
> ###############################################
> 
> Saída do comando em cima de uma mensagem:
> 
> ##############################################################
> 
> Return-Path: <jcarlos barbosa em blabla.com.uk>
> Delivered-To: faoliveira em blabla.com.uk
> Received: from 10.21.179.136
> Message-ID: 
> <1269.10.21.179.136.1212062961.squirrel em metromail.clusclus.uk.gov.uk>
> Date: Thu, 29 May 2008 09:09:21 -0300 (ukT)
> Subject: [Fwd: Fw: FW: En: [Fwd: simplesmente impressionante!!!!!!!]]]]]
> From: "Jose Carlos Barbosa" <jcarlos barbosa em blabla.com.uk>
> To: euripedes ferreira em blabla.com.uk
> MIME-Version: 1.0
> Content-Type: multipart/mixed;boundary="----= 20080529090921 24520"
> X-Priority: 3 (Normal)
> Importance: Normal
> 
> --------------------------- Mensagem Original ----------------------------
> Assunto: [Fwd: Fw: FW: En: [Fwd: B?BLIA- simplesmente
> impressionante!!!!!!!]]]]]
> De: "Francisco Assis Oliveira" <faoliveira em blabla.com.uk>
> Data: Qua, Maio 28, 2008 2:47 pm
> Para:
> --------------------------------------------------------------------------
> 
> ** Attachment decoded and saved to
> ** ./untitled-1.2
> 
> 
> 
> ** Attachment decoded and saved to
> ** ./untitled-1-1.2
> 
> 
> 
> ** Attachment decoded and saved to
> ** ./Biblia.pps
> 
> ##########################################################
> 
> 
> Dados históricos comprovam que em 06/10/2008 12:52 PM, Edilson Azevedo 
> aparentemente escreveu a mensagem abaixo::
>> Olá pessoal!
>>
>> Sou novo por aqui e essa é a minha primeira pergunta... espero um dia 
>> estar respondendo algumas também hehe.
>>
>> Seguinte, possuo um script em perl que analiza uma mensagem de email e 
>> separa apenas o header dela. Até aí tudo perfeito, porém esse mesmo 
>> script separa o anexo da mensagem - se tiver - e salva na pasta onde 
>> ele mesmo está rodando.
>>
>> O que eu preciso - creio eu - é bem simples: Quero que ao invés que 
>> ele salve o anexo em disco, quero que ele apenas me mostre o nome do 
>> anexo, sem salva-lo em disco, sacaram?
>>
>> Nos links abaixo eu tenho uma amostra da saída do script após realizar 
>> a filtragem do email e o link para vcs visualizarem o script.
>>
>>
>> Exemplo de saída do script:
>> http://sites.google.com/site/apropos/Home/saidadoemail.txt?attredirects=0
>>
>> LINK para baixar o script:
>> http://sites.google.com/site/apropos/Home/mail.pl?attredirects=0
>>
>> Obrigado mesmo pessoal!!!
>>
> 
> _______________________________________________
> SaoPaulo-pm mailing list
> SaoPaulo-pm em pm.org
> http://mail.pm.org/mailman/listinfo/saopaulo-pm
> 
> 


Mais detalhes sobre a lista de discussão SaoPaulo-pm