1# Copyright 2010 Amazon.com, Inc. or its affiliates. All Rights Reserved.
2#
3# Licensed under the Apache License, Version 2.0 (the "License"). You may not
4# use this file except in compliance with the License. A copy of the License
5# is located at
6#
7#        http://aws.amazon.com/apache2.0/
8#
9# or in the "LICENSE" file accompanying this file. This file is distributed
10# on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either
11# express or implied. See the License for the specific language governing
12# permissions and limitations under the License.
13
14# This is a code sample showing how to use the Amazon Simple Email Service from the
15# command line.  To learn more about this code sample, see the AWS Simple Email
16# Service Developer Guide.
17
18package SES;
19
20use strict;
21use warnings;
22our $VERSION = '1.00';
23use base 'Exporter';
24our @EXPORT = qw();
25use Switch;
26use Digest::SHA qw (hmac_sha1_base64 hmac_sha256_base64 sha256);
27use URI::Escape qw (uri_escape_utf8);
28use LWP 6;
29use LWP::Protocol::https;
30
31
32my $endpoint = 'https://email.us-east-1.amazonaws.com/';
33my $service_version = '2010-12-01';
34my $tools_version = '1.1';
35my $signature_version = 'HTTP';
36my %opts;
37my %params;
38my $aws_access_key_id;
39my $aws_secret_access_key;
40
41our $aws_email_ns = "http://ses.amazonaws.com/doc/$service_version/";
42
43# RFC3986 unsafe characters
44my $unsafe_characters = "^A-Za-z0-9\-\._~";
45
46
47# Read the credentials from $AWS_CREDENTIALS_FILE file.
48sub read_credentials {
49    my $file;
50    if ($opts{'k'}) {
51        $file = $opts{'k'};
52    } else {
53        $file = $ENV{'AWS_CREDENTIAL_FILE'};
54        $file = $ENV{'AWS_CREDENTIALS_FILE'} unless defined($file);
55    }
56    die "Unspecified AWS credentials file." unless defined($file);
57    open (FILE, '<:utf8', $file) or die "Cannot open credentials file <$file>.";
58    while (my $line = <FILE>) {
59        $line =~ /^\s*(.*?)=(.*?)\s*$/ or die "Cannot parse credentials entry <$line> in <$file>.";
60        my ($key, $value) = ($1, $2);
61        switch ($key) {
62            case 'AWSAccessKeyId' { $aws_access_key_id     = $value; }
63            case 'AWSSecretKey'   { $aws_secret_access_key = $value; }
64            else                  { die "Unrecognized credential <$key> in <$file>."; }
65        }
66    }
67    close (FILE);
68}
69
70
71# Prepares AWS-specific service call parameters.
72sub prepare_aws_params {
73    $params{'AWSAccessKeyId'}   = $aws_access_key_id;
74    $params{'Timestamp'}        = sprintf(
75	                                "%04d-%02d-%02dT%02d:%02d:%02d.000Z",
76	                                sub {($_[5]+1900,$_[4]+1,$_[3],$_[2],$_[1],$_[0])}
77	                                    ->(gmtime(time))
78	                            );
79    $params{'Version'}          = $service_version;
80}
81
82
83# Compute the V1 AWS request signature.
84# (see http://developer.amazonwebservices.com/connect/entry.jspa?externalID=1928#HTTP)
85sub get_signature_v1 {
86    $params{'SignatureMethod'}  = 'HmacSHA1';
87    $params{'SignatureVersion'} = '1';
88
89    my $data = '';
90    for my $key (sort {lc($a) cmp lc($b)} keys %params) {
91        my $value = $params{$key};
92        $data .= $key . $value;
93    }
94
95    return hmac_sha1_base64($data, $aws_secret_access_key) . '=';
96}
97
98
99# Compute the V2 AWS request signature.
100# (see http://developer.amazonwebservices.com/connect/entry.jspa?externalID=1928#HTTP)
101sub get_signature_v2 {
102    $params{'SignatureMethod'}  = 'HmacSHA256';
103    $params{'SignatureVersion'} = '2';
104
105    my $endpoint_name = $endpoint;
106    $endpoint_name =~ s!^https?://(.*?)/?$!$1!;
107
108    my $data = '';
109    $data .= 'POST';
110    $data .= "\n";
111    $data .= $endpoint_name;
112    $data .= "\n";
113    $data .= '/';
114    $data .= "\n";
115
116    my @params = ();
117    for my $key (sort keys %params) {
118        my $evalue = uri_escape_utf8($params{$key}, $unsafe_characters);
119        push @params, "$key=$evalue";
120    }
121    my $query_string = join '&', @params;
122    $data .= $query_string;
123
124    return hmac_sha256_base64($data, $aws_secret_access_key) . '=';
125}
126
127
128# Add the V1 signature to service call parameters.
129sub sign_v1 {
130    $params{'Signature'} = get_signature_v1;
131}
132
133
134# Add the V2 signature to service call parameters.
135sub sign_v2 {
136    $params{'Signature'} = get_signature_v2;
137}
138
139
140# Compute HTTP signature.
141sub sign_http_request {
142    my $request = shift;
143
144    my $data = '';
145    $data .= 'POST';
146    $data .= "\n";
147    $data .= '/';
148    $data .= "\n";
149    $data .= $request->content();
150    $data .= "\n";
151    $data .= 'date:'.$request->header('Date');
152    $data .= "\n";
153    $data .= 'host:'.$request->header('Host');
154    $data .= "\n";
155    $data .= "\n";
156
157    my $sig = hmac_sha256_base64(sha256($data), $aws_secret_access_key) . '=';
158
159    my $signature = '';
160    $signature .= 'AWS3 ';
161    $signature .= "AWSAccessKeyId=$params{'AWSAccessKeyId'}, ";
162    $signature .= "Signature=$sig, ";
163    $signature .= 'Algorithm=HmacSHA256, ';
164    $signature .= 'SignedHeaders=Date;Host';
165
166    return $signature;
167}
168
169
170# Compute HTTPS signature.
171sub sign_https_request {
172    my $request = shift;
173
174    my $data = '';
175    $data .= $request->header('Date');
176
177    my $sig = hmac_sha256_base64($data, $aws_secret_access_key) . '=';;
178
179    my $signature = '';
180    $signature .= 'AWS3-HTTPS ';
181    $signature .= "AWSAccessKeyId=$params{'AWSAccessKeyId'}, ";
182    $signature .= "Signature=$sig, ";
183    $signature .= 'Algorithm=HmacSHA256';
184
185    return $signature;
186}
187
188
189# Sign the HTTP request.
190sub sign_http {
191    my $request = shift;
192
193    my $endpoint_name = $endpoint;
194    $endpoint_name =~ s!^https?://(.*?)/?$!$1!;
195
196    $request->date(time);
197    $request->header('Host', $endpoint_name);
198
199    my $signature;
200    my $use_https = $endpoint =~ m!^https://!;
201    if ($use_https) {
202        $signature = sign_https_request $request;
203    } else {
204        $signature = sign_http_request $request;
205    }
206
207    $request->header('x-amzn-authorization', $signature);
208}
209
210
211# Build the service call payload.
212sub build_payload {
213    my @params = ();
214    my $payload;
215    for my $key (sort keys %params) {
216        my $value = $params{$key};
217        my ($ekey, $evalue) = (uri_escape_utf8($key, $unsafe_characters),
218			       uri_escape_utf8($value, $unsafe_characters));
219        push @params, "$ekey=$evalue";
220    }
221    $payload = join '&', @params;
222    return $payload;
223}
224
225# Detect throttling messages
226sub get_response_flag {
227    my $content = shift;
228
229    if ($content =~ /<Message>(.*?)<\/Message>/s) {
230	switch ($1) {
231	    case /Maximum sending rate exceeded/                       { return 'THROTTLING_MAX_RATE'; }
232	    case /Daily message quota exceeded/                        { return 'THROTTLING_DAILY_QUOTA'; }
233	    case /Maximum number of verified email addresses exceeded/ { return 'THROTTLING_MAX_VERIFY' }
234	    case /Rate exceeded/                                       { return 'THROTTLING_GLOBAL_RATE' }
235	}
236    }
237    return 'CLEAN_CONTENT';
238}
239
240# Call the service.
241sub call_ses {
242    my $params = shift;
243    my $opts = shift;
244
245    %opts = %$opts;
246    %params = %$params;
247
248    $endpoint = $opts{'e'} if defined($opts{'e'});
249    my $endpoint_name = $endpoint;
250    $endpoint_name =~ s!^https?://(.*?)(:\d+)?/?$!$1!;
251
252    read_credentials;
253    prepare_aws_params;
254
255    switch ($signature_version) {
256	case 'V1'   { sign_v1; }
257	case 'V2'   { sign_v2; }
258	case 'HTTP' { }
259	else        { die "Unrecognized signature version <$signature_version>."; }
260    }
261
262    my $payload = build_payload;
263
264    my $browser = new LWP::UserAgent(agent => "SES-Perl-$tools_version/$service_version");
265    my $request = new HTTP::Request 'POST', $endpoint;
266    $request->header("If-SSL-Cert-Subject" => "/CN=$endpoint_name");
267    $request->content($payload);
268    $request->content_type('application/x-www-form-urlencoded');
269    if ($signature_version eq 'HTTP') {
270        sign_http $request;
271    }
272    my $response = $browser->request($request);
273
274    # print the detailed response in verbose mode
275    print($response->content) if ($opts{'verbose'});
276
277    my $status = $response->is_success;
278    if (!$status) {
279        my $content = $response->content;
280        my $errmsg = $content;
281        if ($content =~ /<Message>(.*?)<\/Message>/s) {
282            $errmsg = $1;
283        }
284        print STDERR $errmsg, "\n";
285    }
286    my $response_flag = get_response_flag($response->content);
287    return ($response->code, $response->content, $response_flag);
288}
289