Changeset 33

Show
Ignore:
Timestamp:
02/06/06 07:19:33
Author:
miyagawa
Message:

Added TLS support to Publish::Gmail. Fixes #9

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • trunk/plagger/lib/Plagger/Plugin/Publish/Gmail.pm

    r31 r33  
    7272 
    7373    my $route = $cfg->{mailroute} || { via => 'smtp', host => 'localhost' }; 
    74     my @args  = $route->{host} ? ($route->{host}) : (); 
    75     $msg->send($route->{via}, @args); 
     74    if ($route->{via} eq 'smtp_tls') { 
     75        $msg->send_by_smtp_tls( 
     76            $route->{host}, 
     77            User     => $route->{username}, 
     78            Password => $route->{password}, 
     79        ); 
     80    } else { 
     81        my @args  = $route->{host} ? ($route->{host}) : (); 
     82        $msg->send($route->{via}, @args); 
     83    } 
    7684} 
    7785 
     
    102110} 
    103111 
     112# hack MIME::Lite to support TLS Authentication 
     113package MIME::Lite; 
     114 
     115sub send_by_smtp_tls { 
     116    my($self, @args) = @_; 
     117 
     118    ### We need the "From:" and "To:" headers to pass to the SMTP mailer: 
     119    my $hdr  = $self->fields(); 
     120    my $from = $self->get('From'); 
     121    my $to   = $self->get('To'); 
     122 
     123    ### Sanity check: 
     124    defined($to) or Carp::croak "send_by_smtp_tls: missing 'To:' address\n"; 
     125 
     126    ### Get the destinations as a simple array of addresses: 
     127    my @to_all = extract_addrs($to); 
     128    if ($MIME::Lite::AUTO_CC) { 
     129        foreach my $field (qw(Cc Bcc)) { 
     130            my $value = $self->get($field); 
     131            push @to_all, extract_addrs($value) if defined($value); 
     132        } 
     133    } 
     134 
     135    ### Create SMTP TLS client: 
     136    require Net::SMTP::TLS; 
     137    my $smtp = MIME::Lite::SMTP::TLS->new(@args) 
     138        or Carp::croak("Failed to connect to mail server: $!\n"); 
     139    $smtp->mail($from); 
     140    $smtp->to(@to_all); 
     141    $smtp->data(); 
     142 
     143    ### MIME::Lite can print() to anything with a print() method: 
     144    $self->print_for_smtp($smtp); 
     145    $smtp->dataend(); 
     146    eval { 
     147        local $SIG{__WARN__} = sub { }; 
     148        $smtp->quit; 
     149    }; 
     150 
     151    # known error from Gmail SMTP 
     152    if ($@ && $@ !~ /An error occurred disconnecting from the mail server/) { 
     153        warn $@; 
     154    } 
     155 
     156    1; 
     157} 
     158 
     159package MIME::Lite::SMTP::TLS; 
     160use base qw( Net::SMTP::TLS ); 
     161 
     162sub print { shift->datasend(@_) } 
     163 
    1041641;