line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::AWS::SES;
|
2
|
1
|
|
|
1
|
|
156020
|
use strict;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
30
|
|
3
|
1
|
|
|
1
|
|
4
|
use warnings;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
4
|
1
|
|
|
1
|
|
5
|
use Carp ('croak');
|
|
1
|
|
|
|
|
11
|
|
|
1
|
|
|
|
|
46
|
|
5
|
1
|
|
|
1
|
|
5
|
use MIME::Base64;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
6
|
1
|
|
|
1
|
|
1705
|
use Time::Piece;
|
|
1
|
|
|
|
|
8768
|
|
|
1
|
|
|
|
|
4
|
|
7
|
1
|
|
|
1
|
|
2181
|
use HTTP::Headers;
|
|
1
|
|
|
|
|
8436
|
|
|
1
|
|
|
|
|
31
|
|
8
|
1
|
|
|
1
|
|
6900
|
use LWP::UserAgent;
|
|
1
|
|
|
|
|
56358
|
|
|
1
|
|
|
|
|
37
|
|
9
|
1
|
|
|
1
|
|
1015
|
use Digest::HMAC_SHA1;
|
|
1
|
|
|
|
|
6986
|
|
|
1
|
|
|
|
|
49
|
|
10
|
1
|
|
|
1
|
|
612
|
use Net::AWS::SES::Response;
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.04';
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub __timestamp {
|
14
|
|
|
|
|
|
|
return localtime->datetime;
|
15
|
|
|
|
|
|
|
}
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub __signature {
|
18
|
|
|
|
|
|
|
my $self = shift;
|
19
|
|
|
|
|
|
|
my ($date) = @_;
|
20
|
|
|
|
|
|
|
unless ($date) {
|
21
|
|
|
|
|
|
|
croak "signature(): usage error";
|
22
|
|
|
|
|
|
|
}
|
23
|
|
|
|
|
|
|
my $hmac = Digest::HMAC_SHA1->new( $self->secret_key );
|
24
|
|
|
|
|
|
|
$hmac->add($date);
|
25
|
|
|
|
|
|
|
return encode_base64( $hmac->digest );
|
26
|
|
|
|
|
|
|
}
|
27
|
|
|
|
|
|
|
sub __user_agent {
|
28
|
|
|
|
|
|
|
my $self = shift;
|
29
|
|
|
|
|
|
|
my $ua = LWP::UserAgent->new(
|
30
|
|
|
|
|
|
|
agent => sprintf( "%s/%s", __PACKAGE__, $VERSION ),
|
31
|
|
|
|
|
|
|
default_headers => $self->__header
|
32
|
|
|
|
|
|
|
);
|
33
|
|
|
|
|
|
|
return $ua;
|
34
|
|
|
|
|
|
|
}
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub __header {
|
37
|
|
|
|
|
|
|
my $self = shift;
|
38
|
|
|
|
|
|
|
my $h = HTTP::Headers->new;
|
39
|
|
|
|
|
|
|
$h->date(time);
|
40
|
|
|
|
|
|
|
$h->header(
|
41
|
|
|
|
|
|
|
'Content-type' => 'application/x-www-form-urlencoded',
|
42
|
|
|
|
|
|
|
'X-Amzn-Authorization' => sprintf(
|
43
|
|
|
|
|
|
|
"AWS3-HTTPS AWSAccessKeyId=%s,Algorithm=HmacSHA1,Signature=%s",
|
44
|
|
|
|
|
|
|
$self->access_key, $self->__signature( $h->header('Date') )
|
45
|
|
|
|
|
|
|
)
|
46
|
|
|
|
|
|
|
);
|
47
|
|
|
|
|
|
|
return $h;
|
48
|
|
|
|
|
|
|
}
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub new {
|
51
|
|
|
|
|
|
|
my $class = shift;
|
52
|
|
|
|
|
|
|
my %data = (
|
53
|
|
|
|
|
|
|
access_key => '',
|
54
|
|
|
|
|
|
|
secret_key => '',
|
55
|
|
|
|
|
|
|
region => 'us-east-1',
|
56
|
|
|
|
|
|
|
from => '',
|
57
|
|
|
|
|
|
|
__user_agent => undef,
|
58
|
|
|
|
|
|
|
__response => undef,
|
59
|
|
|
|
|
|
|
@_
|
60
|
|
|
|
|
|
|
);
|
61
|
|
|
|
|
|
|
unless ( $data{access_key} && $data{secret_key} ) {
|
62
|
|
|
|
|
|
|
croak "new(): usage error";
|
63
|
|
|
|
|
|
|
}
|
64
|
|
|
|
|
|
|
return bless \%data, $class;
|
65
|
|
|
|
|
|
|
}
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub DESTROY {
|
68
|
|
|
|
|
|
|
my $self = shift;
|
69
|
|
|
|
|
|
|
$self->{__response} = undef;
|
70
|
|
|
|
|
|
|
}
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub response {
|
73
|
|
|
|
|
|
|
my $self = shift;
|
74
|
|
|
|
|
|
|
return $self->{__response};
|
75
|
|
|
|
|
|
|
}
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub access_key {
|
78
|
|
|
|
|
|
|
my $self = shift;
|
79
|
|
|
|
|
|
|
my ($key) = @_;
|
80
|
|
|
|
|
|
|
return $self->{access_key} unless $key;
|
81
|
|
|
|
|
|
|
return $self->{access_key} = $key;
|
82
|
|
|
|
|
|
|
}
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub secret_key {
|
85
|
|
|
|
|
|
|
my $self = shift;
|
86
|
|
|
|
|
|
|
my ($key) = @_;
|
87
|
|
|
|
|
|
|
return $self->{secret_key} unless $key;
|
88
|
|
|
|
|
|
|
return $self->{secret_key} = $key;
|
89
|
|
|
|
|
|
|
}
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub region {
|
92
|
|
|
|
|
|
|
my $self = shift;
|
93
|
|
|
|
|
|
|
my ($key) = @_;
|
94
|
|
|
|
|
|
|
return $self->{region} unless $key;
|
95
|
|
|
|
|
|
|
return $self->{region} = $key;
|
96
|
|
|
|
|
|
|
}
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub call {
|
99
|
|
|
|
|
|
|
my $self = shift;
|
100
|
|
|
|
|
|
|
my ( $action, $args, $responseClass ) = @_;
|
101
|
|
|
|
|
|
|
unless ($action) {
|
102
|
|
|
|
|
|
|
croak "call(): usage error";
|
103
|
|
|
|
|
|
|
}
|
104
|
|
|
|
|
|
|
$args->{AWSAccessKeyId} = $self->access_key;
|
105
|
|
|
|
|
|
|
$args->{Action} = $action;
|
106
|
|
|
|
|
|
|
$args->{Timestamp} = $self->__timestamp;
|
107
|
|
|
|
|
|
|
my $ua = $self->__user_agent;
|
108
|
|
|
|
|
|
|
my $response =
|
109
|
|
|
|
|
|
|
$ua->post( "https://email." . $self->region . ".amazonaws.com",
|
110
|
|
|
|
|
|
|
$args );
|
111
|
|
|
|
|
|
|
return Net::AWS::SES::Response->new( $response, $action );
|
112
|
|
|
|
|
|
|
}
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub send {
|
115
|
|
|
|
|
|
|
my $self = shift;
|
116
|
|
|
|
|
|
|
return $self->send_mime(@_) if ( @_ == 1 );
|
117
|
|
|
|
|
|
|
my (%args) = @_;
|
118
|
|
|
|
|
|
|
unless ( ref( $args{To} ) ) {
|
119
|
|
|
|
|
|
|
$args{To} = [ $args{To} ];
|
120
|
|
|
|
|
|
|
}
|
121
|
|
|
|
|
|
|
my $from = $args{From} || $self->{from};
|
122
|
|
|
|
|
|
|
unless ($from) {
|
123
|
|
|
|
|
|
|
croak "send(): usage error";
|
124
|
|
|
|
|
|
|
}
|
125
|
|
|
|
|
|
|
unless ( $from && ( $args{Body} || $args{Body_html} ) && $args{To} ) {
|
126
|
|
|
|
|
|
|
croak "Usage Error";
|
127
|
|
|
|
|
|
|
}
|
128
|
|
|
|
|
|
|
my %call_args = (
|
129
|
|
|
|
|
|
|
'Message.Subject.Data' => $args{Subject},
|
130
|
|
|
|
|
|
|
'Message.Subject.Charset' => 'UTF-8',
|
131
|
|
|
|
|
|
|
'Source' => $from
|
132
|
|
|
|
|
|
|
);
|
133
|
|
|
|
|
|
|
if ( $args{Body} ) {
|
134
|
|
|
|
|
|
|
$call_args{'Message.Body.Text.Data'} = $args{Body};
|
135
|
|
|
|
|
|
|
$call_args{'Message.Body.Text.Charset'} = 'UTF-8',;
|
136
|
|
|
|
|
|
|
}
|
137
|
|
|
|
|
|
|
if ( $args{Body_html} ) {
|
138
|
|
|
|
|
|
|
$call_args{'Message.Body.Html.Data'} = $args{Body_html};
|
139
|
|
|
|
|
|
|
$call_args{'Message.Body.Html.Charset'} = 'UTF-8';
|
140
|
|
|
|
|
|
|
}
|
141
|
|
|
|
|
|
|
if ( $args{ReturnPath} ) {
|
142
|
|
|
|
|
|
|
$call_args{'ReturnPath'} = $args{ReturnPath};
|
143
|
|
|
|
|
|
|
}
|
144
|
|
|
|
|
|
|
for ( my $i = 0 ; $i < @{ $args{To} } ; $i++ ) {
|
145
|
|
|
|
|
|
|
my $email = $args{To}->[$i];
|
146
|
|
|
|
|
|
|
$call_args{ sprintf( 'Destination.ToAddresses.member.%d', $i + 1 ) } =
|
147
|
|
|
|
|
|
|
$email;
|
148
|
|
|
|
|
|
|
}
|
149
|
|
|
|
|
|
|
my $r = $self->call( 'SendEmail', \%call_args );
|
150
|
|
|
|
|
|
|
} ## end sub send
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub verify_email {
|
153
|
|
|
|
|
|
|
my ( $self, $email ) = @_;
|
154
|
|
|
|
|
|
|
unless ($email) {
|
155
|
|
|
|
|
|
|
croak "verify_email(): usage error";
|
156
|
|
|
|
|
|
|
}
|
157
|
|
|
|
|
|
|
return $self->call( 'VerifyEmailIdentity', { EmailAddress => $email } );
|
158
|
|
|
|
|
|
|
}
|
159
|
|
|
|
|
|
|
*delete_domain = \&delete_identity;
|
160
|
|
|
|
|
|
|
*delete_email = \&delete_identity;
|
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub delete_identity {
|
163
|
|
|
|
|
|
|
my ( $self, $identity ) = @_;
|
164
|
|
|
|
|
|
|
unless ($identity) {
|
165
|
|
|
|
|
|
|
croak "delete_identity(): usage error";
|
166
|
|
|
|
|
|
|
}
|
167
|
|
|
|
|
|
|
return $self->call( 'DeleteIdentity', { Identity => $identity } );
|
168
|
|
|
|
|
|
|
}
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub list_emails {
|
171
|
|
|
|
|
|
|
my $self = shift;
|
172
|
|
|
|
|
|
|
my %args = @_;
|
173
|
|
|
|
|
|
|
my %call_args = ( IdentityType => 'EmailAddress' );
|
174
|
|
|
|
|
|
|
if ( $args{limit} ) {
|
175
|
|
|
|
|
|
|
$call_args{MaxItems} = $args{limit};
|
176
|
|
|
|
|
|
|
}
|
177
|
|
|
|
|
|
|
if ( $args{offset} ) {
|
178
|
|
|
|
|
|
|
$call_args{NextToken} = $args{offset};
|
179
|
|
|
|
|
|
|
}
|
180
|
|
|
|
|
|
|
my $r = $self->call( 'ListIdentities', \%call_args );
|
181
|
|
|
|
|
|
|
}
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub list_domains {
|
184
|
|
|
|
|
|
|
my $self = shift;
|
185
|
|
|
|
|
|
|
my %args = @_;
|
186
|
|
|
|
|
|
|
my %call_args = ( IdentityType => 'Domain' );
|
187
|
|
|
|
|
|
|
if ( $args{limit} ) {
|
188
|
|
|
|
|
|
|
$call_args{MaxItems} = $args{limit};
|
189
|
|
|
|
|
|
|
}
|
190
|
|
|
|
|
|
|
if ( $args{offset} ) {
|
191
|
|
|
|
|
|
|
$call_args{NextToken} = $args{offset};
|
192
|
|
|
|
|
|
|
}
|
193
|
|
|
|
|
|
|
my $r = $self->call( 'ListIdentities', \%call_args );
|
194
|
|
|
|
|
|
|
}
|
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub get_quota {
|
197
|
|
|
|
|
|
|
my $self = shift;
|
198
|
|
|
|
|
|
|
return $self->call('GetSendQuota');
|
199
|
|
|
|
|
|
|
}
|
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub get_statistics {
|
202
|
|
|
|
|
|
|
my $self = shift;
|
203
|
|
|
|
|
|
|
return $self->call('GetSendStatistics');
|
204
|
|
|
|
|
|
|
}
|
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub send_mime {
|
207
|
|
|
|
|
|
|
my $self = shift;
|
208
|
|
|
|
|
|
|
my $msg = $_[0] if ( @_ == 1 );
|
209
|
|
|
|
|
|
|
if ( $msg && ref($msg) && $msg->isa("MIME::Entity") ) {
|
210
|
|
|
|
|
|
|
my $r = $self->call( 'SendRawEmail',
|
211
|
|
|
|
|
|
|
{ 'RawMessage.Data' => encode_base64( $msg->stringify ) } );
|
212
|
|
|
|
|
|
|
return $r;
|
213
|
|
|
|
|
|
|
}
|
214
|
|
|
|
|
|
|
}
|
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub get_dkim_attributes {
|
217
|
|
|
|
|
|
|
my $self = shift;
|
218
|
|
|
|
|
|
|
my @identities = @_;
|
219
|
|
|
|
|
|
|
my %call_args = ();
|
220
|
|
|
|
|
|
|
for ( my $i = 0 ; $i < @identities ; $i++ ) {
|
221
|
|
|
|
|
|
|
my $id = $identities[$i];
|
222
|
|
|
|
|
|
|
$call_args{ 'Identities.member.' . ( $i + 1 ) } = $id;
|
223
|
|
|
|
|
|
|
}
|
224
|
|
|
|
|
|
|
return $self->call( 'GetIdentityDkimAttributes', \%call_args );
|
225
|
|
|
|
|
|
|
}
|
226
|
|
|
|
|
|
|
__END__
|