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

[Edilson Azevedo]

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