Extracting and resending email attachments. Input invited 1

CRCR123 · Jun 28, 2003

Regarding this script which was provided by Rob M at

http://forums.devshed.com/showthread.php?s=&postid=299226#post299226

See my response beneath the second dashed line below:

-----------------------------------------------------------------------------------------------------------

#!/usr/bin/perl -w
use strict;
use MIME:

arser;

my $logfile='/home/directory/attaches.log';
my $attachdir='/home/directory';

my $parser=new MIME:

arser;
$parser->ignore_errors(1);
$parser->extract_uuencode(1);
$parser->tmp_recycling(0);
$parser->output_to_core(1);
my $entity=$parser->parse(*STDIN);

my $from=$entity->head->get('From');
my $subject=$entity->head->get('Subject');
my @parts=$entity->parts;
my $aname='attachment001';
while(my $part = shift(@parts)) {
if($part->parts) {
push @parts,$part->parts; # Nested multi-part
next;
}
my $type=$part->head->mime_type || $part->head->effective_type;
if($type !~ /^(text|message)/i) { # Not a text, save it
my $filename=$part->head->recommended_filename || $aname;
$aname++;
my $io=$part->open("r&quot

;
my $uniq=time().'-'.$$;
$filename =~ s/[;<>*|`&\$!#()[]{}:'"\n]//g;
open(F,">> $attachdir/$uniq-$filename&quot

;
my $buf;
while($io->read($buf,1024)) {
print F $buf;
}
close(F);
$io->close;
open(LOG,">> $logfile&quot

;
print LOG localtime()." From: $from\tSubject: $subject\tFile: $uniq-$filename\n";
close(LOG);
}
}
exit;

-----------------------------------------------------------------------------------------------------------

Rob M (and anyone else that can help)

I tested your above script and it is one GREAT script!
Thank you!

I'm new to all this, but am trying to customize your script
so that I can use it for the specific purpose I have in mind.

I have an email-to-cgi script (see it below) that automatically
sends out a preformatted email and attachment in response
to a particular email address sent to me.

I was looking for a script that extracts attachments and deposits
them in a directory on my server when I found your script, which
I just love because it not only logs the incoming emails, but also
generates different file names for each attachment by appending
the existing filename, which would be great for a future project.
I'm not sure how the "10 digit dash five digit dash" numbering
is determined (doesn't seem to correspond with time and date
or any other info I can recognize), but I would really like to
know : )

My question is:

1) If I wanted the script to rename incoming email attachments
(there would only be one attachment per email from a unified
messaging service) with the same name so that the new file
attachment would simply re-write over the existing file with the
same name already in the server directory it's being extracted to,
how would the script look then, and is there a way to either...

1a) incorporate the script below so that it will "also" execute,
and send out the file that was just extracted and renamed to
its directory, or alternatively...

1b) If 1a above can't be done, can a few few lines of code be
inserted into the script answer for question 1 above so that
the script will simply generate any kind of email, so that I can
use that email to execute the script below (assuming the script
below can't be incorporated into the script answer for question
1 above).

Here's the email-to-cgi script I'm using which automatically
sends out a preformatted email
--------------------------------------------------------------------------

#!/usr/bin/perl
use strict;
use MIME::Lite;

my @email=<STDIN>;

my $msg = MIME::Lite->new(
To => 'to@getaloan.net',
From => '1877LoanOfficer@getaloan.net',
Subject => 'Extension 3 Subject Line',
Type => 'multipart/mixed',
);

$msg->attach(Type =>'TEXT',
Data =>"Here's the mp3 file you wanted"
);

$msg->attach(
Type => 'audio/x-mpeg',
Path => '/usr/home/getaloan.net/htdocs/voicemail.mp3',
);

$msg->send;

--------------------------------------------------------------------------

Thanks Rob and/or, et al

billr1 · Jun 28, 2003

The leading uniq part of the filename is created here:
my $uniq=time().'-'.$$;
which is the current time in seconds since Jan 1 1970, followed by a '-', followed by the current process id (the $$).

To keep the filename the same, just pick a name and assign it to the $filename variable and drop the $uniq part in the open call, so these lines:
my $uniq=time().'-'.$$;
$filename =~ s/[;<>*|`&\$!#()[]{}:'"\n]//g;
open(F,">> $attachdir/$uniq-$filename&quot

;
would be replaced by something like:
$filename = "attach1";
open(F,"> $attachdir/$filename&quot

;

Note the use of ">" in the open call to overwrite any existing file with the same name, rather than the original ">>", which appended.

You have the attached file with a fixed, known filename, so you should be able to just incorporate your second script directly into the detaching script anywhere after the close(F) call. E.g.:
close(F);
$io->close;
my $msg = MIME::Lite->new(
To => 'to@getaloan.net',
From => '1877LoanOfficer@getaloan.net',
Subject => 'Extension 3 Subject Line',
Type => 'multipart/mixed',
);

$msg->attach(Type =>'TEXT',
Data =>"Here's the mp3 file you wanted"
);

$msg->attach(
Type => 'audio/x-mpeg',
Path => "$attachdir/$filename",
);

$msg->send;

open(LOG,">> $logfile&quot

;
print LOG localtime() .
" From: $from\tSubject: $subject" .
"\tFile: $filename\n";
close(LOG);
etc.

-Bill

CRCR123 · Jun 28, 2003

Bill, you're a genius! The script extracts the attachment
and over-writes the existing filename perfectly, but for
some reason the script isn't generating the outgoing email,
with or without the attachment. I'm sure it's just a symbol
missing somewhere, but I don't know where.

However, please know you have helped me alot already. I
feel like I'm now just one symbol or character away,
whatever that symbol or character might be : )

I've copied the revised script below

Thank you so much Bill.

Carlton@getaloan.net

#!/usr/bin/perl -w
use strict;
use MIME:

arser;

my $logfile='/usr/home/getaloan.net/htdocs/cgi-bin/test/attach.log';
my $attachdir='/usr/home/getaloan.net/htdocs/cgi-bin/test';

my $parser=new MIME:

arser;
$parser->ignore_errors(1);
$parser->extract_uuencode(1);
$parser->tmp_recycling(0);
$parser->output_to_core(1);
my $entity=$parser->parse(\*STDIN);
my $from=$entity->head->get('From');
my $subject=$entity->head->get('Subject');
my @parts=$entity->parts;
my $aname='attachment001';
while(my $part = shift(@parts)) {
if($part->parts) {
push @parts,$part->parts; # Nested multi-part
next;
}
my $type=$part->head->mime_type || $part->head->effective_type;
if($type !~ /^(text|message)/i) { # Not a text, save it
my $filename=$part->head->recommended_filename || $aname;
$aname++;
my $io=$part->open("r&quot

;
$filename = "attach1";
open(F,"> $attachdir/$filename&quot

;
my $buf;
while($io->read($buf,1024)) {
print F $buf;
}
close(F);
$io->close;
my $msg = MIME::Lite->new(
To => 'to@getaloan.net',
From => '1877LoanOfficer@getaloan.net',
Subject => 'Extension 3 Subject Line',
Type => 'multipart/mixed',
);

$msg->attach(Type =>'TEXT',
Data =>"Here's the mp3 file you wanted"
);

$msg->attach(
Type => 'audio/x-mpeg',
Path => "$attachdir/$filename",
);

$msg->send;

open(LOG,">> $logfile&quot

;
print LOG localtime() .
" From: $from\tSubject: $subject" .
"\tFile: $filename\n";
close(LOG);
}
}
exit;

CRCR123 · Jun 29, 2003

OK, now everything works great, extracting file to
directory on server, renaming it and resending file, EXCEPT
for one small thing. When the file called voicemail gets
sent back out it becomes voicemail.dat

The message type below is
Type => 'audio/x-mpeg',

so I'm not sure why it's not working. This wasn't a problem
when using the Mime:Lite script all by itself without the
Mime

arser

carlton@getaloan.net

Here's the script:

#!/usr/bin/perl -w
use strict;
use MIME:

arser;
use MIME::Lite;

my $attachdir='/path/to/directory/cgi-bin/extract_&_send';

my $parser=new MIME:

arser;
$parser->ignore_errors(1);
$parser->extract_uuencode(1);
$parser->tmp_recycling(0);
$parser->output_to_core(1);
my $entity=$parser->parse(\*STDIN);
my $from=$entity->head->get('From');
my $subject=$entity->head->get('Subject');
my @parts=$entity->parts;
my $aname='attachment001';
while(my $part = shift(@parts)) {
if($part->parts) {
push @parts,$part->parts; # Nested multi-part
next;
}
my $type=$part->head->mime_type || $part->head->effective_type;
if($type !~ /^(text|message)/i) { # Not a text, save it
my $filename=$part->head->recommended_filename || $aname;
$aname++;
my $io=$part->open("r&quot

;
$filename = "voicemail";
open(F,"> $attachdir/$filename&quot

;
my $buf;
while($io->read($buf,1024)) {
print F $buf;
}
close(F);
$io->close;
my @email=<STDIN>;

my $msg = MIME::Lite->new(
To => 'to@recipient.com',
From => 'from@me.com',
Subject => 'You've got voicemail',
Type => 'multipart/mixed',
);

$msg->attach(Type =>'TEXT',
Data =>"Attached is an mp3 voicemail message to you"
);

$msg->attach(
Type => 'audio/x-mpeg',
Path => "$attachdir/$filename",
);

$msg->send;

}
}
exit;

dsm325 · Aug 27, 2003

Folks, to get this to work, do I need mime parser and what else. Can munpack do the samething.

Thanks to everyone

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Extracting and resending email attachments. Input invited 1

CRCR123

Technical User

billr1

Programmer

CRCR123

Technical User

CRCR123

Technical User

dsm325

Technical User

Similar threads

Part and Inventory Search

Sponsor