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

Solli Honorio shonorio em gmail.com
Terça Junho 10 18:01:37 PDT 2008


Edilson, o código abaixo informa o nome do arquivo que veio anexo no email
...


<codigo>
#!/usr/bin/perl
use strict;
use MIME::Parser;

#Dê uma olhada no schema no link
http://search.cpan.org/~doneill/MIME-tools-5.426/lib/MIME/Tools.pm

my $parse  = MIME::Parser->new;
my $entity = $parse->parse(\*STDIN) or die "parse failed\n";

foreach ( $entity->parts() ) {
  print $_->head->mime_type,"\n";
  print $_->head->recommended_filename,"\n";
  print "*" x 50;
  print "\n";
}
</codigo>

2008/6/10 Edilson Azevedo <eazevedo em bsd.com.br>:

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


-- 
"o animal satisfeito dorme". - Guimarães Rosa
-------------- Próxima Parte ----------
Um anexo em HTML foi limpo...
URL: http://mail.pm.org/pipermail/saopaulo-pm/attachments/20080610/9fac46fa/attachment.html 


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