How to forward emails with perl's Net::IMAP::Simple

user_5478114 0
Viewed 110

There seem to be hundreds of questions in a similar vein. I think have read them all but none seem to answer this question. I have looked at FetchMail but don't think I can install it on my DreamHost shared server. I have looked at Mail::Box, but cannot figure out how to log in and collect the mail I want to forward. I am currently trying to do it as shown below ... obviously this has been simplified to make it easier to follow and may contain errors. But essentially I am taking the body of the read mail and trying to post that on as the body of the forwarded email.

The mail is read and forwarded correctly but when viewing the forwarded mail all the formatting is wrong and sometimes it is truncated.

use Net::IMAP::Simple;
use Email::Simple;
use IO::Socket::SSL;
use Email::Address;

# Connect
my $imap = Net::IMAP::Simple->new($Server, port  => 993,  use_ssl => 1,) || die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";

# Log in
if ( !$imap->login( $L, $P ) ) {print  "Login failed for $L: " . $imap->errstr . "\n"; exit(64);}

# Look in the inbox
my $nm = $imap->select('Inbox');

## Iterate through all messages
for ( my $i = 1 ; $i <= $nm ; $i++ ) {
my $es = Email::Simple->new( join '', @{ $imap->get($i) } );
$Body = $es->body;

use Net::SMTP::SSL;
my $smtp;
if (not $smtp = Net::SMTP::SSL->new($Server, Port => 465, Debug => 0)) {warn "Could not connect to $Server!\n"; $method = 'Server Fail'; $error=$@;} else {

if (not $smtp->auth($L2, $P2)) {warn "Authentication Failed! Login: $L sending from $from TO $to\n"; $method = "Authentication Fail Login: $L2 $P2 sending from $from TO $to\n"; $error=$@;} else {

$smtp->mail($from . "\n");
$smtp->to($to . "\n");
$smtp->data();
$smtp->datasend("MIME-Version: 1.0\n");
$smtp->datasend("From: " . $from . "\n");
$smtp->datasend("To: " . $to . "\n");
$smtp->datasend("Subject: " . $subject . "\n");
$smtp->datasend("\n");
$smtp->datasend($Body . "\n");
$smtp->dataend();
# Check it was sent correctly 
$result = $smtp->message();
if ($result !~ /OK/i) {$error = $result; if ($result =~ /quota exceeded/) {$method = 'Quota Blocking'; } else {$method = 'Bad Address';}}

$smtp->quit;

# Copy this message
$imap->create_mailbox( "Inbox.Processed" );
$imap->copy( $i, "Inbox.Processed" ) or die $imap->errstr;
$imap->delete( $i );
imap perl email
1 Answers

This is all you have to do. Simply have two "sessions" of Net::Imap::Simple running and copy the message from one to the other.

    use Net::IMAP::Simple;
    use IO::Socket::SSL;
    # Conntect to the TO mailbox       
    $imap2 = Net::IMAP::Simple->new('smtp.SomeServer.com', port  => 993,  use_ssl => 1,) || die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
    $L2 = 'TOaddress@mail.com';
    $P2 = 'password';
    # Log in
    if ( !$imap2->login( $L2, $P2 ) ) {print  "Login failed for $L2: " . $imap2->errstr . "\n"; exit(64);}
    
    # Connect to the From Mail box
    $imap = Net::IMAP::Simple->new('smtp.SomeOtherServer.com', port  => 993,  use_ssl => 1,) || die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
     $L = 'FROMaddress@mail.com';
    $P = 'password';   
    # Log in
    if ( !$imap->login( $L, $P ) ) {print  "Login failed for $L: " . $imap->errstr . "\n"; exit(64);}
    
    # Look in the inbox
    my $nm = $imap->select('Inbox');
    
    ## Iterate through all messages
    for ( my $i = 1 ; $i <= $nm ; $i++ ) {
    $message = $imap->get( $i ) or die $imap->errstr;
    @flags = $imap->msg_flags($i);
    
    # Move this message into a processed folder
    $imap->create_mailbox( "Inbox.Processed" );
    $imap->copy( $i, "Inbox.Processed" ) or die $imap->errstr;
    $imap->delete( $i );
    
    # Copy to other mail address ...
    $imap2->put( 'Inbox', $message, @flags ) or die $imap2->errstr;
    
    }
    
    # Disconnect
    $imap->quit;
    $imap2->quit;
user_54781140
Related