line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package VM::EC2; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
VM::EC2 - Perl interface to Amazon EC2, Virtual Private Cloud, Elastic Load Balancing, Autoscaling, and Relational Database services |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 SYNOPSIS |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
NOTE: For information on AWS's VPC, load balancing, autoscaling and relational |
10
|
|
|
|
|
|
|
databases services, see L, L, |
11
|
|
|
|
|
|
|
L, and |
12
|
|
|
|
|
|
|
L |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# set environment variables EC2_ACCESS_KEY, EC2_SECRET_KEY and/or EC2_URL |
15
|
|
|
|
|
|
|
# to fill in arguments automatically |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
## IMAGE AND INSTANCE MANAGEMENT |
18
|
|
|
|
|
|
|
# get new EC2 object |
19
|
|
|
|
|
|
|
my $ec2 = VM::EC2->new(-access_key => 'access key id', |
20
|
|
|
|
|
|
|
-secret_key => 'aws_secret_key', |
21
|
|
|
|
|
|
|
-endpoint => 'http://ec2.amazonaws.com'); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# fetch an image by its ID |
24
|
|
|
|
|
|
|
my $image = $ec2->describe_images('ami-12345'); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# get some information about the image |
27
|
|
|
|
|
|
|
my $architecture = $image->architecture; |
28
|
|
|
|
|
|
|
my $description = $image->description; |
29
|
|
|
|
|
|
|
my @devices = $image->blockDeviceMapping; |
30
|
|
|
|
|
|
|
for my $d (@devices) { |
31
|
|
|
|
|
|
|
print $d->deviceName,"\n"; |
32
|
|
|
|
|
|
|
print $d->snapshotId,"\n"; |
33
|
|
|
|
|
|
|
print $d->volumeSize,"\n"; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# run two instances |
37
|
|
|
|
|
|
|
my @instances = $image->run_instances(-key_name =>'My_key', |
38
|
|
|
|
|
|
|
-security_group=>'default', |
39
|
|
|
|
|
|
|
-min_count =>2, |
40
|
|
|
|
|
|
|
-instance_type => 't1.micro') |
41
|
|
|
|
|
|
|
or die $ec2->error_str; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# wait for both instances to reach "running" or other terminal state |
44
|
|
|
|
|
|
|
$ec2->wait_for_instances(@instances); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# print out both instance's current state and DNS name |
47
|
|
|
|
|
|
|
for my $i (@instances) { |
48
|
|
|
|
|
|
|
my $status = $i->current_status; |
49
|
|
|
|
|
|
|
my $dns = $i->dnsName; |
50
|
|
|
|
|
|
|
print "$i: [$status] $dns\n"; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# tag both instances with Role "server" |
54
|
|
|
|
|
|
|
foreach (@instances) {$_->add_tag(Role=>'server'); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# stop both instances |
57
|
|
|
|
|
|
|
foreach (@instances) {$_->stop} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# find instances tagged with Role=Server that are |
60
|
|
|
|
|
|
|
# stopped, change the user data and restart. |
61
|
|
|
|
|
|
|
@instances = $ec2->describe_instances({'tag:Role' => 'Server', |
62
|
|
|
|
|
|
|
'instance-state-name' => 'stopped'}); |
63
|
|
|
|
|
|
|
for my $i (@instances) { |
64
|
|
|
|
|
|
|
$i->userData('Secure-mode: off'); |
65
|
|
|
|
|
|
|
$i->start or warn "Couldn't start $i: ",$i->error_str; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# create an image from both instance, tag them, and make |
69
|
|
|
|
|
|
|
# them public |
70
|
|
|
|
|
|
|
for my $i (@instances) { |
71
|
|
|
|
|
|
|
my $img = $i->create_image("Autoimage from $i","Test image"); |
72
|
|
|
|
|
|
|
$img->add_tags(Name => "Autoimage from $i", |
73
|
|
|
|
|
|
|
Role => 'Server', |
74
|
|
|
|
|
|
|
Status=> 'Production'); |
75
|
|
|
|
|
|
|
$img->make_public(1); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
## KEY MANAGEMENT |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# retrieve the name and fingerprint of the first instance's |
81
|
|
|
|
|
|
|
# key pair |
82
|
|
|
|
|
|
|
my $kp = $instances[0]->keyPair; |
83
|
|
|
|
|
|
|
print $instances[0], ": keypair $kp=",$kp->fingerprint,"\n"; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# create a new key pair |
86
|
|
|
|
|
|
|
$kp = $ec2->create_key_pair('My Key'); |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# get the private key from this key pair and write it to a disk file |
89
|
|
|
|
|
|
|
# in ssh-compatible format |
90
|
|
|
|
|
|
|
my $private_key = $kp->private_key; |
91
|
|
|
|
|
|
|
open (my $f,'>MyKeypair.rsa') or die $!; |
92
|
|
|
|
|
|
|
print $f $private_key; |
93
|
|
|
|
|
|
|
close $f; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# Import a preexisting SSH key |
96
|
|
|
|
|
|
|
my $public_key = 'ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC8o...'; |
97
|
|
|
|
|
|
|
$key = $ec2->import_key_pair('NewKey',$public_key); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
## SECURITY GROUPS AND FIREWALL RULES |
100
|
|
|
|
|
|
|
# Create a new security group |
101
|
|
|
|
|
|
|
my $group = $ec2->create_security_group(-name => 'NewGroup', |
102
|
|
|
|
|
|
|
-description => 'example'); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# Add a firewall rule |
105
|
|
|
|
|
|
|
$group->authorize_incoming(-protocol => 'tcp', |
106
|
|
|
|
|
|
|
-port => 80, |
107
|
|
|
|
|
|
|
-source_ip => ['192.168.2.0/24','192.168.2.1/24'}); |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# Write rules back to Amazon |
110
|
|
|
|
|
|
|
$group->update; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# Print current firewall rules |
113
|
|
|
|
|
|
|
print join ("\n",$group->ipPermissions),"\n"; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
## VOLUME && SNAPSHOT MANAGEMENT |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# find existing volumes that are available |
118
|
|
|
|
|
|
|
my @volumes = $ec2->describe_volumes({status=>'available'}); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# back 'em all up to snapshots |
121
|
|
|
|
|
|
|
foreach (@volumes) {$_->snapshot('Backup on '.localtime)} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# find a stopped instance in first volume's availability zone and |
124
|
|
|
|
|
|
|
# attach the volume to the instance using /dev/sdg |
125
|
|
|
|
|
|
|
my $vol = $volumes[0]; |
126
|
|
|
|
|
|
|
my $zone = $vol->availabilityZone; |
127
|
|
|
|
|
|
|
@instances = $ec2->describe_instances({'availability-zone'=> $zone, |
128
|
|
|
|
|
|
|
'run-state-name' => $stopped); |
129
|
|
|
|
|
|
|
$instances[0]->attach_volume($vol=>'/dev/sdg') if @instances; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# create a new 20 gig volume |
132
|
|
|
|
|
|
|
$vol = $ec2->create_volume(-availability_zone=> 'us-east-1a', |
133
|
|
|
|
|
|
|
-size => 20); |
134
|
|
|
|
|
|
|
$ec2->wait_for_volumes($vol); |
135
|
|
|
|
|
|
|
print "Volume $vol is ready!\n" if $vol->current_status eq 'available'; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# create a new elastic address and associate it with an instance |
138
|
|
|
|
|
|
|
my $address = $ec2->allocate_address(); |
139
|
|
|
|
|
|
|
$instances[0]->associate_address($address); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=head1 DESCRIPTION |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
This is an interface to the 2014-05-01 version of the Amazon AWS API |
144
|
|
|
|
|
|
|
(http://aws.amazon.com/ec2). It was written provide access to the new |
145
|
|
|
|
|
|
|
tag and metadata interface that is not currently supported by |
146
|
|
|
|
|
|
|
Net::Amazon::EC2, as well as to provide developers with an extension |
147
|
|
|
|
|
|
|
mechanism for the API. This library will also support the Open Stack |
148
|
|
|
|
|
|
|
open source cloud (http://www.openstack.org/). |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
The main interface is the VM::EC2 object, which provides methods for |
151
|
|
|
|
|
|
|
interrogating the Amazon EC2, launching instances, and managing |
152
|
|
|
|
|
|
|
instance lifecycle. These methods return the following major object |
153
|
|
|
|
|
|
|
classes which act as specialized interfaces to AWS: |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
VM::EC2::BlockDevice -- A block device |
156
|
|
|
|
|
|
|
VM::EC2::BlockDevice::Attachment -- Attachment of a block device to an EC2 instance |
157
|
|
|
|
|
|
|
VM::EC2::BlockDevice::EBS -- An elastic block device |
158
|
|
|
|
|
|
|
VM::EC2::BlockDevice::Mapping -- Mapping of a virtual storage device to a block device |
159
|
|
|
|
|
|
|
VM::EC2::BlockDevice::Mapping::EBS -- Mapping of a virtual storage device to an EBS block device |
160
|
|
|
|
|
|
|
VM::EC2::Group -- Security groups |
161
|
|
|
|
|
|
|
VM::EC2::Image -- Amazon Machine Images (AMIs) |
162
|
|
|
|
|
|
|
VM::EC2::Instance -- Virtual machine instances |
163
|
|
|
|
|
|
|
VM::EC2::Instance::Metadata -- Access to runtime metadata from running instances |
164
|
|
|
|
|
|
|
VM::EC2::Region -- Availability regions |
165
|
|
|
|
|
|
|
VM::EC2::Snapshot -- EBS snapshots |
166
|
|
|
|
|
|
|
VM::EC2::Tag -- Metadata tags |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
In addition, there is a high level interface for interacting with EC2 |
169
|
|
|
|
|
|
|
servers and volumes, including file transfer and remote shell facilities: |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
VM::EC2::Staging::Manager -- Manage a set of servers and volumes. |
172
|
|
|
|
|
|
|
VM::EC2::Staging::Server -- A staging server, with remote shell and file transfer |
173
|
|
|
|
|
|
|
facilities. |
174
|
|
|
|
|
|
|
VM::EC2::Staging::Volume -- A staging volume with the ability to copy itself between |
175
|
|
|
|
|
|
|
availability zones and regions. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
and a few specialty classes: |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
VM::EC2::Security::Token -- Temporary security tokens for granting EC2 access to |
180
|
|
|
|
|
|
|
non-AWS account holders. |
181
|
|
|
|
|
|
|
VM::EC2::Security::Credentials -- Credentials for use by temporary account holders. |
182
|
|
|
|
|
|
|
VM::EC2::Security::Policy -- Policies that restrict what temporary account holders |
183
|
|
|
|
|
|
|
can do with EC2 resources. |
184
|
|
|
|
|
|
|
VM::EC2::Security::FederatedUser -- Account name information for temporary account holders. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Lastly, there are several utility classes: |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
VM::EC2::Generic -- Base class for all AWS objects |
189
|
|
|
|
|
|
|
VM::EC2::Error -- Error messages |
190
|
|
|
|
|
|
|
VM::EC2::Dispatch -- Maps AWS XML responses onto perl object classes |
191
|
|
|
|
|
|
|
VM::EC2::ReservationSet -- Hidden class used for describe_instances() request; |
192
|
|
|
|
|
|
|
The reservation Ids are copied into the Instance |
193
|
|
|
|
|
|
|
object. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
There is also a high-level API called "VM::EC2::Staging::Manager" for |
196
|
|
|
|
|
|
|
managing groups of staging servers and volumes which greatly |
197
|
|
|
|
|
|
|
simplifies the task of creating and updating instances that mount |
198
|
|
|
|
|
|
|
multiple volumes. The API also provides a one-line command for |
199
|
|
|
|
|
|
|
migrating EBS-backed AMIs from one zone to another. See |
200
|
|
|
|
|
|
|
L. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
The interface provided by these modules is based on that described at |
203
|
|
|
|
|
|
|
http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/. The |
204
|
|
|
|
|
|
|
following caveats apply: |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
1) Not all of the Amazon API is currently implemented. Specifically, |
207
|
|
|
|
|
|
|
a handful calls dealing with cluster management and VM importing |
208
|
|
|
|
|
|
|
are missing. See L for a list of all the |
209
|
|
|
|
|
|
|
unimplemented API calls. Volunteers to fill in these gaps are |
210
|
|
|
|
|
|
|
most welcome! |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
2) For consistency with common Perl coding practices, method calls |
213
|
|
|
|
|
|
|
are lowercase and words in long method names are separated by |
214
|
|
|
|
|
|
|
underscores. The Amazon API prefers mixed case. So in the Amazon |
215
|
|
|
|
|
|
|
API the call to fetch instance information is "DescribeInstances", |
216
|
|
|
|
|
|
|
while in VM::EC2, the method is "describe_instances". To avoid |
217
|
|
|
|
|
|
|
annoyance, if you use the mixed case form for a method name, the |
218
|
|
|
|
|
|
|
Perl autoloader will automatically translate it to underscores for |
219
|
|
|
|
|
|
|
you, and vice-versa; this means you can call either |
220
|
|
|
|
|
|
|
$ec2->describe_instances() or $ec2->DescribeInstances(). |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
3) Named arguments passed to methods are all lowercase, use |
223
|
|
|
|
|
|
|
underscores to separate words and start with hyphens. |
224
|
|
|
|
|
|
|
In other words, if the AWS API calls for an argument named |
225
|
|
|
|
|
|
|
"InstanceId" to be passed to the "DescribeInstances" call, then |
226
|
|
|
|
|
|
|
the corresponding Perl function will look like: |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
$instance = $ec2->describe_instances(-instance_id=>'i-12345') |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
In most cases automatic case translation will be performed for you |
231
|
|
|
|
|
|
|
on arguments. So in the previous example, you could use |
232
|
|
|
|
|
|
|
-InstanceId as well as -instance_id. The exception |
233
|
|
|
|
|
|
|
is when an absurdly long argument name was replaced with an |
234
|
|
|
|
|
|
|
abbreviated one as described below. In this case, you must use |
235
|
|
|
|
|
|
|
the documented argument name. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
In a small number of cases, when the parameter name was absurdly |
238
|
|
|
|
|
|
|
long, it has been abbreviated. For example, the |
239
|
|
|
|
|
|
|
"Placement.AvailabilityZone" parameter has been represented as |
240
|
|
|
|
|
|
|
-placement_zone and not -placement_availability_zone. See the |
241
|
|
|
|
|
|
|
documentation for these cases. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
4) For each of the describe_foo() methods (where "foo" is a type of |
244
|
|
|
|
|
|
|
resource such as "instance"), you can fetch the resource by using |
245
|
|
|
|
|
|
|
their IDs either with the long form: |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
$ec2->describe_foo(-foo_id=>['a','b','c']), |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
or a shortcut form: |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
$ec2->describe_foo('a','b','c'); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
Both forms are listed in the headings in the documentation. |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
5) When the API calls for a list of arguments named Arg.1, Arg.2, |
256
|
|
|
|
|
|
|
then the Perl interface allows you to use an anonymous array for |
257
|
|
|
|
|
|
|
the consecutive values. For example to call describe_instances() |
258
|
|
|
|
|
|
|
with multiple instance IDs, use: |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
@i = $ec2->describe_instances(-instance_id=>['i-12345','i-87654']) |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
6) All Filter arguments are represented as a -filter argument whose value is |
263
|
|
|
|
|
|
|
an anonymous hash: |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
@i = $ec2->describe_instances(-filter=>{architecture=>'i386', |
266
|
|
|
|
|
|
|
'tag:Name' =>'WebServer'}) |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
If there are no other arguments you wish to pass, you can omit the |
269
|
|
|
|
|
|
|
-filter argument and just pass a hashref: |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
@i = $ec2->describe_instances({architecture=>'i386', |
272
|
|
|
|
|
|
|
'tag:Name' =>'WebServer'}) |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
For any filter, you may represent multiple OR arguments as an arrayref: |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
@i = $ec2->describe-instances({'instance-state-name'=>['stopped','terminated']}) |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
When adding or removing tags, the -tag argument uses the same syntax. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
7) The tagnames of each XML object returned from AWS are converted into methods |
281
|
|
|
|
|
|
|
with the same name and typography. So the tag in a |
282
|
|
|
|
|
|
|
DescribeInstancesResponse, becomes: |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
$instance->privateIpAddress |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
You can also use the more Perlish form -- this is equivalent: |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
$instance->private_ip_address |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
Methods that correspond to complex objects in the XML hierarchy |
291
|
|
|
|
|
|
|
return the appropriate Perl object. For example, an instance's |
292
|
|
|
|
|
|
|
blockDeviceMapping() method returns an object of type |
293
|
|
|
|
|
|
|
VM::EC2::BlockDevice::Mapping. |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
All objects have a fields() method that will return the XML |
296
|
|
|
|
|
|
|
tagnames listed in the AWS specifications. |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
@fields = sort $instance->fields; |
299
|
|
|
|
|
|
|
# 'amiLaunchIndex', 'architecture', 'blockDeviceMapping', ... |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
8) Whenever an object has a unique ID, string overloading is used so that |
302
|
|
|
|
|
|
|
the object interpolates the ID into the string. For example, when you |
303
|
|
|
|
|
|
|
print a VM::EC2::Volume object, or use it in another string context, |
304
|
|
|
|
|
|
|
then it will appear as the string "vol-123456". Nevertheless, it will |
305
|
|
|
|
|
|
|
continue to be usable for method calls. |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
($v) = $ec2->describe_volumes(); |
308
|
|
|
|
|
|
|
print $v,"\n"; # prints as "vol-123456" |
309
|
|
|
|
|
|
|
$zone = $v->availabilityZone; # acts like an object |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
9) Many objects have convenience methods that invoke the AWS API on your |
312
|
|
|
|
|
|
|
behalf. For example, instance objects have a current_status() method that returns |
313
|
|
|
|
|
|
|
the run status of the object, as well as start(), stop() and terminate() |
314
|
|
|
|
|
|
|
methods that control the instance's lifecycle. |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
if ($instance->current_status eq 'running') { |
317
|
|
|
|
|
|
|
$instance->stop; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
10) Calls to AWS that have failed for one reason or another (invalid |
321
|
|
|
|
|
|
|
arguments, communications problems, service interruptions) will |
322
|
|
|
|
|
|
|
return undef and set the VM::EC2->is_error() method to true. The |
323
|
|
|
|
|
|
|
error message and its code can then be recovered by calling |
324
|
|
|
|
|
|
|
VM::EC2->error. |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
$i = $ec2->describe_instance('i-123456'); |
327
|
|
|
|
|
|
|
unless ($i) { |
328
|
|
|
|
|
|
|
warn 'Got no instance. Message was: ',$ec2->error; |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
You may also elect to raise an exception when an error occurs. |
332
|
|
|
|
|
|
|
See the new() method for details. |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=head1 ASYNCHRONOUS CALLS |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
As of version 1.24, VM::EC2 supports asynchronous calls to AWS using |
337
|
|
|
|
|
|
|
AnyEvent::HTTP. This allows you to make multiple calls in parallel for |
338
|
|
|
|
|
|
|
a significant improvement in performance. |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
In asynchronous mode, VM::EC2 calls that ordinarily wait for AWS to |
341
|
|
|
|
|
|
|
respond and then return objects corresponding to EC2 instances, |
342
|
|
|
|
|
|
|
volumes, images, and so forth, will instead immediately return an |
343
|
|
|
|
|
|
|
AnyEvent condition variable. You can retrieve the result of the call |
344
|
|
|
|
|
|
|
by calling the condition variable's recv() method, or by setting a |
345
|
|
|
|
|
|
|
callback to be executed when the call is complete. |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
To make an asynchronous call, you can set the global variable |
348
|
|
|
|
|
|
|
$VM::EC2::ASYNC to a true value |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
Here is an example of a normal synchronous call: |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
my @instances = $ec2->describe_instances(); |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
Here is the asynchronous version initiated after setting |
355
|
|
|
|
|
|
|
$VM::EC2::ASYNC (using a local block to limit its effects). |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
{ |
358
|
|
|
|
|
|
|
local $VM::EC2::ASYNC=1; |
359
|
|
|
|
|
|
|
my $cv = $ec2->describe_instances(); # returns immediately |
360
|
|
|
|
|
|
|
my @instances = $cv->recv; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
In case of an error recv() will return undef and the error object can |
364
|
|
|
|
|
|
|
be recovered using the condition variable's error() method (this is an |
365
|
|
|
|
|
|
|
enhancement over AnyEvent's standard condition variable class): |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
my @instances = $cv->recv |
368
|
|
|
|
|
|
|
or die "No instances found! error = ",$cv->error(); |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
You may attach a callback CODE reference to the condition variable using |
371
|
|
|
|
|
|
|
its cb() method, in which case the callback will be invoked when the |
372
|
|
|
|
|
|
|
APi call is complete. The callback will be invoked with a single |
373
|
|
|
|
|
|
|
argument consisting of the condition variable. Ordinarily you will |
374
|
|
|
|
|
|
|
call recv() on the variable and then do something with the result: |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
{ |
377
|
|
|
|
|
|
|
local $VM::EC2::ASYNC=1; |
378
|
|
|
|
|
|
|
my $cv = $ec2->describe_instances(); |
379
|
|
|
|
|
|
|
$cv->cb(sub {my $v = shift; |
380
|
|
|
|
|
|
|
my @i = $v->recv; |
381
|
|
|
|
|
|
|
print "instances = @i\n"; |
382
|
|
|
|
|
|
|
}); |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
For callbacks to be invoked, someone must be run an event loop |
386
|
|
|
|
|
|
|
using one of the event frameworks that AnyEvent supports (e.g. Coro, |
387
|
|
|
|
|
|
|
Tk or Gtk). Alternately, you may simply run: |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
AnyEvent->condvar->recv(); |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
If $VM::EC2::ASYNC is false, you can issue a single asynchronous call |
392
|
|
|
|
|
|
|
by appending "_async" to the name of the method call. Similarly, if |
393
|
|
|
|
|
|
|
$VM::EC2::ASYNC is true, you can make a single normal synchrous call |
394
|
|
|
|
|
|
|
by appending "_sync" to the method name. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
For example, this is equivalent to the above: |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
my $cv = $ec2->describe_instances_async(); # returns immediately |
399
|
|
|
|
|
|
|
my @instances = $cv->recv; |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
You may stack multiple asynchronous calls on top of one another. When |
402
|
|
|
|
|
|
|
you call recv() on any of the returned condition variables, they will |
403
|
|
|
|
|
|
|
all run in parallel. Hence the three calls will take no longer than |
404
|
|
|
|
|
|
|
the longest individual one: |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
my $cv1 = $ec2->describe_instances_async({'instance-state-name'=>'running'}); |
407
|
|
|
|
|
|
|
my $cv2 = $ec2->describe_instances_async({'instance-state-name'=>'stopped'}); |
408
|
|
|
|
|
|
|
my @running = $cv1->recv; |
409
|
|
|
|
|
|
|
my @stopped = $cv2->recv; |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
Same thing with callbacks: |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
my (@running,@stopped); |
414
|
|
|
|
|
|
|
my $cv1 = $ec2->describe_instances_async({'instance-state-name'=>'running'}); |
415
|
|
|
|
|
|
|
$cv1->cb(sub {@running = shift->recv}); |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
my $cv2 = $ec2->describe_instances_async({'instance-state-name'=>'stopped'}); |
418
|
|
|
|
|
|
|
$cv1->cb(sub {@stopped = shift->recv}); |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
AnyEvent->condvar->recv; |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
And here it is using a group conditional variable to block until all |
423
|
|
|
|
|
|
|
pending describe_instances() requests have completed: |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
my %instances; |
426
|
|
|
|
|
|
|
my $group = AnyEvent->condvar; |
427
|
|
|
|
|
|
|
$group->begin; |
428
|
|
|
|
|
|
|
for my $state (qw(pending running stopping stopped)) { |
429
|
|
|
|
|
|
|
$group->begin; |
430
|
|
|
|
|
|
|
my $cv = $ec2->describe_instances_async({'instance-state-name'=>$state}); |
431
|
|
|
|
|
|
|
$cv->cb(sub {my @i = shift->recv; |
432
|
|
|
|
|
|
|
$instances{$state}=\@i; |
433
|
|
|
|
|
|
|
$group->end}); |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
$group->recv; |
436
|
|
|
|
|
|
|
# when we get here %instances will be populated by all instances, |
437
|
|
|
|
|
|
|
# sorted by their state. |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
If this looks mysterious, please consult L for full |
440
|
|
|
|
|
|
|
documentation and examples. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
Lastly, be advised that some of the objects returned by calls to |
443
|
|
|
|
|
|
|
VM::EC2, such as the VM::EC2::Instance object, will make their own |
444
|
|
|
|
|
|
|
calls into VM::EC2 for certain methods. Some of these methods will |
445
|
|
|
|
|
|
|
block (be synchronous) of necessity, even if you have set |
446
|
|
|
|
|
|
|
$VM::EC2::ASYNC. For example, the instance object's current_status() |
447
|
|
|
|
|
|
|
method must block in order to update the object and return the current |
448
|
|
|
|
|
|
|
status. Other object methods may behave unpredictably in async |
449
|
|
|
|
|
|
|
mode. Caveat emptor! |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=head1 API GROUPS |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
The extensive (and growing) Amazon API has many calls that you may |
454
|
|
|
|
|
|
|
never need. To avoid the performance overhead of loading the |
455
|
|
|
|
|
|
|
interfaces to all these calls, you may use Perl's import mechanism to |
456
|
|
|
|
|
|
|
load only those modules you care about. By default, all methods are |
457
|
|
|
|
|
|
|
loaded. |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
Loading is controlled by the "use" import list, and follows the |
460
|
|
|
|
|
|
|
conventions described in the Exporter module: |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
use VM::EC2; # load all methods! |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
use VM::EC2 'key','elastic_ip'; # load Key Pair and Elastic IP |
465
|
|
|
|
|
|
|
# methods only |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
use VM::EC2 ':standard'; # load all the standard methods |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
use VM::EC2 ':standard','!key'; # load standard methods but not Key Pair |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
Related API calls are grouped together using the scheme described at |
472
|
|
|
|
|
|
|
http://docs.aws.amazon.com/AWSEC2/latest/APIReference/OperationList-query.html. The |
473
|
|
|
|
|
|
|
modules that define the API calls can be found in VM/EC2/REST/; you |
474
|
|
|
|
|
|
|
can read their documentation by running perldoc VM::EC2::REST::"name |
475
|
|
|
|
|
|
|
of module": |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
perldoc VM::EC2::REST::elastic_ip |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
The groups that you can import are as follows: |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
:standard => ami, ebs, elastic_ip, instance, keys, general, |
482
|
|
|
|
|
|
|
monitoring, tag, security_group, security_token, zone |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
:vpc => customer_gateway, dhcp, elastic_network_interface, |
485
|
|
|
|
|
|
|
private_ip, internet_gateway, network_acl, route_table, |
486
|
|
|
|
|
|
|
vpc, vpn, vpn_gateway |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
:misc => devpay, monitoring, reserved_instance, |
489
|
|
|
|
|
|
|
spot_instance, vm_export, vm_import, windows |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
:scaling => elastic_load_balancer,autoscaling |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
:hpc => placement_group |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
:all => :standard, :vpn, :misc |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
:DEFAULT => :all |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
The individual modules are: |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
ami -- Control Amazon Machine Images |
502
|
|
|
|
|
|
|
autoscaling -- Control autoscaling |
503
|
|
|
|
|
|
|
customer_gateway -- VPC/VPN gateways |
504
|
|
|
|
|
|
|
devpay -- DevPay API |
505
|
|
|
|
|
|
|
dhcp -- VPC DHCP options |
506
|
|
|
|
|
|
|
ebs -- Elastic Block Store volumes & snapshots |
507
|
|
|
|
|
|
|
elastic_ip -- Elastic IP addresses |
508
|
|
|
|
|
|
|
elastic_load_balancer -- The Elastic Load Balancer service |
509
|
|
|
|
|
|
|
elastic_network_interface -- VPC Elastic Network Interfaces |
510
|
|
|
|
|
|
|
general -- Get console output and account attributes |
511
|
|
|
|
|
|
|
instance -- Control EC2 instances |
512
|
|
|
|
|
|
|
internet_gateway -- VPC connections to the internet |
513
|
|
|
|
|
|
|
keys -- Manage SSH keypairs |
514
|
|
|
|
|
|
|
monitoring -- Control instance monitoring |
515
|
|
|
|
|
|
|
network_acl -- Control VPC network access control lists |
516
|
|
|
|
|
|
|
placement_group -- Control the placement of HPC instances |
517
|
|
|
|
|
|
|
private_ip -- VPC private IP addresses |
518
|
|
|
|
|
|
|
reserved_instance -- Reserve instances and view reservations |
519
|
|
|
|
|
|
|
route_table -- VPC network routing |
520
|
|
|
|
|
|
|
security_group -- Security groups for VPCs and normal instances |
521
|
|
|
|
|
|
|
security_token -- Temporary credentials for use with IAM roles |
522
|
|
|
|
|
|
|
spot_instance -- Request and manage spot instances |
523
|
|
|
|
|
|
|
subnet -- VPC subnets |
524
|
|
|
|
|
|
|
tag -- Create and interrogate resource tags. |
525
|
|
|
|
|
|
|
vm_export -- Export VMs |
526
|
|
|
|
|
|
|
vm_import -- Import VMs |
527
|
|
|
|
|
|
|
vpc -- Create and manipulate virtual private clouds |
528
|
|
|
|
|
|
|
vpn_gateway -- Create and manipulate VPN gateways within VPCs |
529
|
|
|
|
|
|
|
vpn -- Create and manipulate VPNs within VPCs |
530
|
|
|
|
|
|
|
windows -- Windows operating system-specific API calls. |
531
|
|
|
|
|
|
|
zone -- Interrogate availability zones |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
=head1 EXAMPLE SCRIPT |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
The script sync_to_snapshot.pl, distributed with this module, |
536
|
|
|
|
|
|
|
illustrates a relatively complex set of steps on EC2 that does |
537
|
|
|
|
|
|
|
something useful. Given a list of directories or files on the local |
538
|
|
|
|
|
|
|
filesystem it copies the files into an EBS snapshot with the desired |
539
|
|
|
|
|
|
|
name by executing the following steps: |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
1. Provisions a new EBS volume on EC2 large enough to hold the data. |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
2. Spins up a staging instance to manage the network transfer of data |
544
|
|
|
|
|
|
|
from the local machine to the staging volume. |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
3. Creates a temporary ssh keypair and a security group that allows an |
547
|
|
|
|
|
|
|
rsync-over-ssh. |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
4. Formats and mounts the volume if necessary. |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
5. Initiates an rsync-over-ssh for the designated files and |
552
|
|
|
|
|
|
|
directories. |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
6. Unmounts and snapshots the volume. |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
7. Cleans up. |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
If a snapshot of the same name already exists, then it is used to |
559
|
|
|
|
|
|
|
create the staging volume, enabling network-efficient synchronization |
560
|
|
|
|
|
|
|
of the files. A snapshot tag named "Version" is incremented each time |
561
|
|
|
|
|
|
|
you synchronize. |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
=head1 CORE METHODS |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
This section describes the VM::EC2 constructor, accessor methods, and |
566
|
|
|
|
|
|
|
methods relevant to error handling. |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=cut |
569
|
|
|
|
|
|
|
|
570
|
7
|
|
|
7
|
|
7307
|
use strict; |
|
7
|
|
|
|
|
18
|
|
|
7
|
|
|
|
|
462
|
|
571
|
|
|
|
|
|
|
|
572
|
7
|
|
|
7
|
|
4108
|
use VM::EC2::Dispatch; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
use VM::EC2::ParmParser; |
574
|
|
|
|
|
|
|
eval "require AWS::Signature4"; # optional |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
use MIME::Base64 qw(encode_base64 decode_base64); |
577
|
|
|
|
|
|
|
use Digest::SHA qw(hmac_sha256 sha1_hex sha256_hex); |
578
|
|
|
|
|
|
|
use POSIX 'strftime'; |
579
|
|
|
|
|
|
|
use URI; |
580
|
|
|
|
|
|
|
use URI::Escape; |
581
|
|
|
|
|
|
|
use AnyEvent; |
582
|
|
|
|
|
|
|
use AnyEvent::HTTP; |
583
|
|
|
|
|
|
|
use AnyEvent::CacheDNS ':register'; |
584
|
|
|
|
|
|
|
use HTTP::Request::Common; |
585
|
|
|
|
|
|
|
use VM::EC2::Error; |
586
|
|
|
|
|
|
|
use Carp 'croak','carp'; |
587
|
|
|
|
|
|
|
use JSON; |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
our $VERSION = '1.28'; |
590
|
|
|
|
|
|
|
our $AUTOLOAD; |
591
|
|
|
|
|
|
|
our @CARP_NOT = qw(VM::EC2::Image VM::EC2::Volume |
592
|
|
|
|
|
|
|
VM::EC2::Snapshot VM::EC2::Instance |
593
|
|
|
|
|
|
|
VM::EC2::ReservedInstance); |
594
|
|
|
|
|
|
|
our $ASYNC; |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
# hard-coded timeout for several wait_for_terminal_state() calls. |
597
|
|
|
|
|
|
|
use constant WAIT_FOR_TIMEOUT => 600; |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
sub AUTOLOAD { |
600
|
|
|
|
|
|
|
my $self = shift; |
601
|
|
|
|
|
|
|
my ($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/; |
602
|
|
|
|
|
|
|
return if $func_name eq 'DESTROY'; |
603
|
|
|
|
|
|
|
my $proper = VM::EC2->canonicalize($func_name); |
604
|
|
|
|
|
|
|
$proper =~ s/^-//; |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
my $async; |
607
|
|
|
|
|
|
|
if ($proper =~ /^(\w+)_(a?sync)$/i) { |
608
|
|
|
|
|
|
|
$proper = $1; |
609
|
|
|
|
|
|
|
$async = $2 eq 'async' ? 1 : 0; |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
if ($self->can($proper)) { |
613
|
|
|
|
|
|
|
my $local = defined $async ? "local \$ASYNC=$async;" : ''; |
614
|
|
|
|
|
|
|
eval "sub $pack\:\:$func_name {$local shift->$proper(\@_)}; 1" or die $@; |
615
|
|
|
|
|
|
|
$self->$func_name(@_); |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
else { |
619
|
|
|
|
|
|
|
croak "Can't locate object method \"$func_name\" via package \"$pack\""; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
use constant import_tags => { |
624
|
|
|
|
|
|
|
':standard' => [qw(instance elastic_ip ebs ami keys monitoring zone general tag security_group security_token)], |
625
|
|
|
|
|
|
|
':vpc' => [qw(customer_gateway dhcp elastic_network_interface private_ip |
626
|
|
|
|
|
|
|
internet_gateway network_acl route_table subnet vpc vpn vpn_gateway)], |
627
|
|
|
|
|
|
|
':hpc' => ['placement_group'], |
628
|
|
|
|
|
|
|
':scaling' => ['elastic_load_balancer','autoscaling'], |
629
|
|
|
|
|
|
|
':elb' => ['elastic_load_balancer'], |
630
|
|
|
|
|
|
|
':rds' => ['relational_database_service'], |
631
|
|
|
|
|
|
|
':misc' => ['devpay','reserved_instance', 'spot_instance','vm_export','vm_import','windows'], |
632
|
|
|
|
|
|
|
':all' => [qw(:standard :vpc :hpc :scaling :misc)], |
633
|
|
|
|
|
|
|
':DEFAULT' => [':all'], |
634
|
|
|
|
|
|
|
}; |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
# e.g. use VM::EC2 ':default','!ami'; |
637
|
|
|
|
|
|
|
sub import { |
638
|
|
|
|
|
|
|
my $self = shift; |
639
|
|
|
|
|
|
|
my @args = @_; |
640
|
|
|
|
|
|
|
@args = ':DEFAULT' unless @args; |
641
|
|
|
|
|
|
|
while (1) { |
642
|
|
|
|
|
|
|
my @processed = map {/^:/ && import_tags->{$_} ? @{import_tags->{$_}} : $_ } @args; |
643
|
|
|
|
|
|
|
last if "@processed" eq "@args"; # no more expansion needed |
644
|
|
|
|
|
|
|
@args = @processed; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
my (%excluded,%included); |
647
|
|
|
|
|
|
|
foreach (@args) { |
648
|
|
|
|
|
|
|
if (/^!(\S+)/) { |
649
|
|
|
|
|
|
|
$excluded{$1}++ ; |
650
|
|
|
|
|
|
|
$_ = $1; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
foreach (@args) { |
654
|
|
|
|
|
|
|
next unless /^\S/; |
655
|
|
|
|
|
|
|
next if $excluded{$_}; |
656
|
|
|
|
|
|
|
next if $included{$_}++; |
657
|
|
|
|
|
|
|
croak "'$_' is not a valid import tag" if /^[!:]/; |
658
|
|
|
|
|
|
|
next if $INC{"VM/EC2/REST/$_.pm"}; |
659
|
|
|
|
|
|
|
my $class = "VM::EC2::REST::$_"; |
660
|
|
|
|
|
|
|
eval "require $class; 1" or die $@; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
} |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
=head2 $ec2 = VM::EC2->new(-access_key=>$id,-secret_key=>$key,-endpoint=>$url) |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
Create a new Amazon access object. Required arguments are: |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
-access_key Access ID for an authorized user |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
-secret_key Secret key corresponding to the Access ID |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
-security_token Temporary security token obtained through a call to the |
673
|
|
|
|
|
|
|
AWS Security Token Service |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
-endpoint The URL for making API requests |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
-region The region to receive the API requests |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
-raise_error If true, throw an exception. |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
-print_error If true, print errors to STDERR. |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
One or more of -access_key or -secret_key can be omitted if the |
684
|
|
|
|
|
|
|
environment variables EC2_ACCESS_KEY and EC2_SECRET_KEY are |
685
|
|
|
|
|
|
|
defined. If no endpoint is specified, then the environment variable |
686
|
|
|
|
|
|
|
EC2_URL is consulted; otherwise the generic endpoint |
687
|
|
|
|
|
|
|
http://ec2.amazonaws.com/ is used. You can also select the endpoint by |
688
|
|
|
|
|
|
|
specifying one of the Amazon regions, such as "us-west-2", with the |
689
|
|
|
|
|
|
|
-region argument. The endpoint specified by -region will override |
690
|
|
|
|
|
|
|
-endpoint. |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
-security_token is used in conjunction with temporary security tokens |
693
|
|
|
|
|
|
|
returned by $ec2->get_federation_token() and $ec2->get_session_token() |
694
|
|
|
|
|
|
|
to grant restricted, time-limited access to some or all your EC2 |
695
|
|
|
|
|
|
|
resources to users who do not have access to your account. If you pass |
696
|
|
|
|
|
|
|
either a VM::EC2::Security::Token object, or the |
697
|
|
|
|
|
|
|
VM::EC2::Security::Credentials object contained within the token |
698
|
|
|
|
|
|
|
object, then new() does not need the -access_key or -secret_key |
699
|
|
|
|
|
|
|
arguments. You may also pass a session token string scalar to |
700
|
|
|
|
|
|
|
-security_token, in which case you must also pass the access key ID |
701
|
|
|
|
|
|
|
and secret keys generated at the same time the session token was |
702
|
|
|
|
|
|
|
created. See |
703
|
|
|
|
|
|
|
http://docs.amazonwebservices.com/AWSEC2/latest/UserGuide/UsingIAM.html |
704
|
|
|
|
|
|
|
and L. |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
To use an Open Stack cloud, please provide the appropriate endpoint |
707
|
|
|
|
|
|
|
URL. |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
By default, when the Amazon API reports an error, such as attempting |
710
|
|
|
|
|
|
|
to perform an invalid operation on an instance, the corresponding |
711
|
|
|
|
|
|
|
method will return empty and the error message can be recovered from |
712
|
|
|
|
|
|
|
$ec2->error(). However, if you pass -raise_error=>1 to new(), the module |
713
|
|
|
|
|
|
|
will instead raise a fatal error, which you can trap with eval{} and |
714
|
|
|
|
|
|
|
report with $@: |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
eval { |
717
|
|
|
|
|
|
|
$ec2->some_dangerous_operation(); |
718
|
|
|
|
|
|
|
$ec2->another_dangerous_operation(); |
719
|
|
|
|
|
|
|
}; |
720
|
|
|
|
|
|
|
print STDERR "something bad happened: $@" if $@; |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
The error object can be retrieved with $ec2->error() as before. |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
=cut |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
sub new { |
727
|
|
|
|
|
|
|
my $self = shift; |
728
|
|
|
|
|
|
|
my %args = @_; |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
my ($id,$secret,$token); |
731
|
|
|
|
|
|
|
if (ref $args{-security_token} && $args{-security_token}->can('access_key_id')) { |
732
|
|
|
|
|
|
|
$id = $args{-security_token}->accessKeyId; |
733
|
|
|
|
|
|
|
$secret = $args{-security_token}->secretAccessKey; |
734
|
|
|
|
|
|
|
$token = $args{-security_token}->sessionToken; |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
$id ||= $args{-access_key} || $ENV{EC2_ACCESS_KEY} |
738
|
|
|
|
|
|
|
or croak "Please provide -access_key parameter or define environment variable EC2_ACCESS_KEY"; |
739
|
|
|
|
|
|
|
$secret ||= $args{-secret_key} || $ENV{EC2_SECRET_KEY} |
740
|
|
|
|
|
|
|
or croak "Please provide -secret_key or define environment variable EC2_SECRET_KEY"; |
741
|
|
|
|
|
|
|
$token ||= $args{-security_token}; |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
my $endpoint_url = $args{-endpoint} || $ENV{EC2_URL} || 'https://ec2.amazonaws.com/'; |
744
|
|
|
|
|
|
|
$endpoint_url .= '/' unless $endpoint_url =~ m!/$!; |
745
|
|
|
|
|
|
|
$endpoint_url = "https://".$endpoint_url unless $endpoint_url =~ m!https?://!; |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
my $raise_error = $args{-raise_error}; |
748
|
|
|
|
|
|
|
my $print_error = $args{-print_error}; |
749
|
|
|
|
|
|
|
my $obj = bless { |
750
|
|
|
|
|
|
|
id => $id, |
751
|
|
|
|
|
|
|
secret => $secret, |
752
|
|
|
|
|
|
|
security_token => $token, |
753
|
|
|
|
|
|
|
endpoint => $endpoint_url, |
754
|
|
|
|
|
|
|
idempotent_seed => sha1_hex(rand()), |
755
|
|
|
|
|
|
|
raise_error => $raise_error, |
756
|
|
|
|
|
|
|
print_error => $print_error, |
757
|
|
|
|
|
|
|
},ref $self || $self; |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
if ($args{-region}) { |
760
|
|
|
|
|
|
|
$self->import('zone'); |
761
|
|
|
|
|
|
|
my $region = eval{$obj->describe_regions($args{-region})}; |
762
|
|
|
|
|
|
|
my $endpoint = $region ? $region->regionEndpoint :"ec2.$args{-region}.amazonaws.com"; |
763
|
|
|
|
|
|
|
$obj->endpoint($endpoint); |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
return $obj; |
767
|
|
|
|
|
|
|
} |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
sub _region { |
770
|
|
|
|
|
|
|
my $self = shift; |
771
|
|
|
|
|
|
|
my $endpoint = $self->endpoint || return 'us-east-1'; |
772
|
|
|
|
|
|
|
my ($region) = $endpoint =~ /([^.]+)\.amazonaws\.com/; |
773
|
|
|
|
|
|
|
return $region || 'us-east-1'; |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
=head2 $access_key = $ec2->access_key([$new_access_key]) |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
Get or set the ACCESS KEY. In this and all similar get/set methods, |
779
|
|
|
|
|
|
|
call the method with no arguments to get the current value, and with a |
780
|
|
|
|
|
|
|
single argument to change the value: |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
$current_key = $ec2->access_key; |
783
|
|
|
|
|
|
|
$ec2->access_key('XYZZY'); |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
In the case of setting the value, these methods will return the old |
786
|
|
|
|
|
|
|
value as their result: |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
$old_key = $ec2->access_key($new_key); |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=cut |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
sub access_key {shift->id(@_)} |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
sub id { |
795
|
|
|
|
|
|
|
my $self = shift; |
796
|
|
|
|
|
|
|
my $d = $self->{id}; |
797
|
|
|
|
|
|
|
$self->{id} = shift if @_; |
798
|
|
|
|
|
|
|
$d; |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=head2 $secret = $ec2->secret([$new_secret]) |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
Get or set the SECRET KEY |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=cut |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
sub secret { |
808
|
|
|
|
|
|
|
my $self = shift; |
809
|
|
|
|
|
|
|
my $d = $self->{secret}; |
810
|
|
|
|
|
|
|
$self->{secret} = shift if @_; |
811
|
|
|
|
|
|
|
$d; |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
=head2 $secret = $ec2->security_token([$new_token]) |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
Get or set the temporary security token. See L. |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=cut |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
sub security_token { |
821
|
|
|
|
|
|
|
my $self = shift; |
822
|
|
|
|
|
|
|
my $d = $self->{security_token}; |
823
|
|
|
|
|
|
|
$self->{security_token} = shift if @_; |
824
|
|
|
|
|
|
|
$d; |
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=head2 $endpoint = $ec2->endpoint([$new_endpoint]) |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Get or set the ENDPOINT URL. |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=cut |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
sub endpoint { |
834
|
|
|
|
|
|
|
my $self = shift; |
835
|
|
|
|
|
|
|
my $d = $self->{endpoint}; |
836
|
|
|
|
|
|
|
if (@_) { |
837
|
|
|
|
|
|
|
my $new_endpoint = shift; |
838
|
|
|
|
|
|
|
$new_endpoint = 'https://'.$new_endpoint |
839
|
|
|
|
|
|
|
unless $new_endpoint =~ /^https?:/; |
840
|
|
|
|
|
|
|
$self->{endpoint} = $new_endpoint; |
841
|
|
|
|
|
|
|
} |
842
|
|
|
|
|
|
|
$d; |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=head2 $region = $ec2->region([$new_region]) |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
Get or set the EC2 region manipulated by this module. This has the side effect |
848
|
|
|
|
|
|
|
of changing the endpoint. |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
=cut |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
sub region { |
853
|
|
|
|
|
|
|
my $self = shift; |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
my $d = $self->{endpoint}; |
856
|
|
|
|
|
|
|
$d =~ s!^https?://!!; |
857
|
|
|
|
|
|
|
$d =~ s!/$!!; |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
$self->import('zone'); |
860
|
|
|
|
|
|
|
my @regions = $self->describe_regions; |
861
|
|
|
|
|
|
|
my ($current_region) = grep {$_->regionEndpoint eq $d} @regions; |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
if (@_) { |
864
|
|
|
|
|
|
|
my $new_region = shift; |
865
|
|
|
|
|
|
|
my ($region) = grep {/$new_region/} @regions; |
866
|
|
|
|
|
|
|
$region or croak "unknown region $new_region"; |
867
|
|
|
|
|
|
|
$self->endpoint($region->regionEndpoint); |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
return $current_region; |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
=head2 $ec2->raise_error($boolean) |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
Change the handling of error conditions. Pass a true value to cause |
875
|
|
|
|
|
|
|
Amazon API errors to raise a fatal error. Pass false to make methods |
876
|
|
|
|
|
|
|
return undef. In either case, you can detect the error condition |
877
|
|
|
|
|
|
|
by calling is_error() and fetch the error message using error(). This |
878
|
|
|
|
|
|
|
method will also return the current state of the raise error flag. |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
=cut |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
sub raise_error { |
883
|
|
|
|
|
|
|
my $self = shift; |
884
|
|
|
|
|
|
|
my $d = $self->{raise_error}; |
885
|
|
|
|
|
|
|
$self->{raise_error} = shift if @_; |
886
|
|
|
|
|
|
|
$d; |
887
|
|
|
|
|
|
|
} |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=head2 $ec2->print_error($boolean) |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
Change the handling of error conditions. Pass a true value to cause |
892
|
|
|
|
|
|
|
Amazon API errors to print error messages to STDERR. Pass false to |
893
|
|
|
|
|
|
|
cancel this behavior. |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=cut |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
sub print_error { |
898
|
|
|
|
|
|
|
my $self = shift; |
899
|
|
|
|
|
|
|
my $d = $self->{print_error}; |
900
|
|
|
|
|
|
|
$self->{print_error} = shift if @_; |
901
|
|
|
|
|
|
|
$d; |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
=head2 $boolean = $ec2->is_error |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
If a method fails, it will return undef. However, some methods, such |
907
|
|
|
|
|
|
|
as describe_images(), will also return undef if no resources matches |
908
|
|
|
|
|
|
|
your search criteria. Call is_error() to distinguish the two |
909
|
|
|
|
|
|
|
eventualities: |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
@images = $ec2->describe_images(-owner=>'29731912785'); |
912
|
|
|
|
|
|
|
unless (@images) { |
913
|
|
|
|
|
|
|
die "Error: ",$ec2->error if $ec2->is_error; |
914
|
|
|
|
|
|
|
print "No appropriate images found\n"; |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=cut |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
sub is_error { |
920
|
|
|
|
|
|
|
defined shift->error(); |
921
|
|
|
|
|
|
|
} |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
=head2 $err = $ec2->error |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
If the most recently-executed method failed, $ec2->error() will return |
926
|
|
|
|
|
|
|
the error code and other descriptive information. This method will |
927
|
|
|
|
|
|
|
return undef if the most recently executed method was successful. |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
The returned object is actually an AWS::Error object, which |
930
|
|
|
|
|
|
|
has two methods named code() and message(). If used in a string |
931
|
|
|
|
|
|
|
context, its operator overloading returns the composite string |
932
|
|
|
|
|
|
|
"$message [$code]". |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
=cut |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
sub error { |
937
|
|
|
|
|
|
|
my $self = shift; |
938
|
|
|
|
|
|
|
my $d = $self->{error}; |
939
|
|
|
|
|
|
|
$self->{error} = shift if @_; |
940
|
|
|
|
|
|
|
$d; |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
=head2 $err = $ec2->error_str |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
Same as error() except it returns the string representation, not the |
946
|
|
|
|
|
|
|
object. This works better in debuggers and exception handlers. |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
=cut |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
sub error_str { |
951
|
|
|
|
|
|
|
my $e = shift->{error}; |
952
|
|
|
|
|
|
|
$e ||= ''; |
953
|
|
|
|
|
|
|
return "$e"; |
954
|
|
|
|
|
|
|
} |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
=head2 $account_id = $ec2->account_id |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
Looks up the account ID corresponding to the credentials provided when |
959
|
|
|
|
|
|
|
the VM::EC2 instance was created. The way this is done is to fetch the |
960
|
|
|
|
|
|
|
"default" security group, which is guaranteed to exist, and then |
961
|
|
|
|
|
|
|
return its groupId field. The result is cached so that subsequent |
962
|
|
|
|
|
|
|
accesses are fast. |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=head2 $account_id = $ec2->userId |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
Same as above, for convenience. |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=cut |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
sub account_id { |
971
|
|
|
|
|
|
|
my $self = shift; |
972
|
|
|
|
|
|
|
return $self->{account_id} if exists $self->{account_id}; |
973
|
|
|
|
|
|
|
my $sg = $self->describe_security_groups(-group_name=>'default') or return; |
974
|
|
|
|
|
|
|
return $self->{account_id} ||= $sg->ownerId; |
975
|
|
|
|
|
|
|
} |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
sub userId { shift->account_id } |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
=head2 $new_ec2 = $ec2->clone |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
This method creates an identical copy of the EC2 object. It is used |
982
|
|
|
|
|
|
|
occasionally internally for creating an EC2 object in a different AWS |
983
|
|
|
|
|
|
|
region: |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
$singapore = $ec2->clone; |
986
|
|
|
|
|
|
|
$singapore->region('ap-souteast-1'); |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
=cut |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
sub clone { |
991
|
|
|
|
|
|
|
my $self = shift; |
992
|
|
|
|
|
|
|
my %contents = %$self; |
993
|
|
|
|
|
|
|
return bless \%contents,ref $self; |
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
=head1 INSTANCES |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
Load the 'instances' module to bring in methods for interrogating, |
999
|
|
|
|
|
|
|
launching and manipulating EC2 instances. This module is part of |
1000
|
|
|
|
|
|
|
the ':standard' API group. The methods are described in detail in |
1001
|
|
|
|
|
|
|
L. Briefly: |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
@i = $ec2->describe_instances(-instance_id=>\@ids,-filter=>\%filters) |
1004
|
|
|
|
|
|
|
@i = $ec2->run_instances(-image_id=>$id,%other_args) |
1005
|
|
|
|
|
|
|
@s = $ec2->start_instances(-instance_id=>\@instance_ids) |
1006
|
|
|
|
|
|
|
@s = $ec2->stop_instances(-instance_id=>\@instance_ids,-force=>1) |
1007
|
|
|
|
|
|
|
@s = $ec2->reboot_instances(-instance_id=>\@instance_ids) |
1008
|
|
|
|
|
|
|
$b = $ec2->confirm_product_instance($instance_id,$product_code) |
1009
|
|
|
|
|
|
|
$m = $ec2->instance_metadata |
1010
|
|
|
|
|
|
|
@d = $ec2->describe_instance_attribute($instance_id,$attribute) |
1011
|
|
|
|
|
|
|
$b = $ec2->modify_instance_attribute($instance_id,-$attribute_name=>$value) |
1012
|
|
|
|
|
|
|
$b = $ec2->reset_instance_attribute($instance_id,$attribute) |
1013
|
|
|
|
|
|
|
@s = $ec2->describe_instance_status(-instance_id=>\@ids,-filter=>\%filters,%other_args); |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
=head1 VOLUMES |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
Load the 'ebs' module to bring in methods specific for elastic block |
1018
|
|
|
|
|
|
|
storage volumes and snapshots. This module is part of the ':standard' |
1019
|
|
|
|
|
|
|
API group. The methods are described in detail in |
1020
|
|
|
|
|
|
|
L. Briefly: |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
@v = $ec2->describe_volumes(-volume_id=>\@ids,-filter=>\%filters) |
1023
|
|
|
|
|
|
|
$v = $ec2->create_volume(%args) |
1024
|
|
|
|
|
|
|
$b = $ec2->delete_volume($volume_id) |
1025
|
|
|
|
|
|
|
$a = $ec2->attach_volume($volume_id,$instance_id,$device) |
1026
|
|
|
|
|
|
|
$a = $ec2->detach_volume($volume_id) |
1027
|
|
|
|
|
|
|
$ec2->wait_for_attachments(@attachment) |
1028
|
|
|
|
|
|
|
@v = $ec2->describe_volume_status(-volume_id=>\@ids,-filter=>\%filters) |
1029
|
|
|
|
|
|
|
$ec2->wait_for_volumes(@volumes) |
1030
|
|
|
|
|
|
|
@d = $ec2->describe_volume_attribute($volume_id,$attribute) |
1031
|
|
|
|
|
|
|
$b = $ec2->enable_volume_io(-volume_id=>$volume_id) |
1032
|
|
|
|
|
|
|
@s = $ec2->describe_snapshots(-snapshot_id=>\@ids,%other_args) |
1033
|
|
|
|
|
|
|
@d = $ec2->describe_snapshot_attribute($snapshot_id,$attribute) |
1034
|
|
|
|
|
|
|
$b = $ec2->modify_snapshot_attribute($snapshot_id,-$argument=>$value) |
1035
|
|
|
|
|
|
|
$b = $ec2->reset_snapshot_attribute($snapshot_id,$attribute) |
1036
|
|
|
|
|
|
|
$s = $ec2->create_snapshot(-volume_id=>$vol,-description=>$desc) |
1037
|
|
|
|
|
|
|
$b = $ec2->delete_snapshot($snapshot_id) |
1038
|
|
|
|
|
|
|
$s = $ec2->copy_snapshot(-source_region=>$region,-source_snapshot_id=>$id,-description=>$desc) |
1039
|
|
|
|
|
|
|
$ec2->wait_for_snapshots(@snapshots) |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
=head1 AMAZON MACHINE IMAGES |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
Load the 'ami' module to bring in methods for creating and |
1044
|
|
|
|
|
|
|
manipulating Amazon Machine Images. This module is part of the |
1045
|
|
|
|
|
|
|
':standard" group. Full details are in L. Briefly: |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
@i = $ec2->describe_images(@image_ids) |
1048
|
|
|
|
|
|
|
$i = $ec2->create_image(-instance_id=>$id,-name=>$name,%other_args) |
1049
|
|
|
|
|
|
|
$i = $ec2->register_image(-name=>$name,%other_args) |
1050
|
|
|
|
|
|
|
$r = $ec2->deregister_image($image_id) |
1051
|
|
|
|
|
|
|
@d = $ec2->describe_image_attribute($image_id,$attribute) |
1052
|
|
|
|
|
|
|
$b = $ec2->modify_image_attribute($image_id,-$attribute_name=>$value) |
1053
|
|
|
|
|
|
|
$b = $ec2->reset_image_attribute($image_id,$attribute_name) |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
=head1 KEYS |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
Load the 'keys' module to bring in methods for creating and |
1058
|
|
|
|
|
|
|
manipulating SSH keypairs. This module is loaded with the ':standard' |
1059
|
|
|
|
|
|
|
group and documented in L
|
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
@k = $ec2->describe_key_pairs(@names); |
1062
|
|
|
|
|
|
|
$k = $ec2->create_key_pair($name) |
1063
|
|
|
|
|
|
|
$k = $ec2->import_key_pair($name,$public_key) |
1064
|
|
|
|
|
|
|
$b = $ec2->delete_key_pair($name) |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
=head1 TAGS |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
The methods in this module (loaded with ':standard') allow you to |
1069
|
|
|
|
|
|
|
create, delete and fetch resource tags. You may find that you rarely |
1070
|
|
|
|
|
|
|
need to use these methods directly because every object produced by |
1071
|
|
|
|
|
|
|
VM::EC2 supports a simple tag interface: |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
$object = $ec2->describe_volumes(-volume_id=>'vol-12345'); # e.g. |
1074
|
|
|
|
|
|
|
$tags = $object->tags(); |
1075
|
|
|
|
|
|
|
$name = $tags->{Name}; |
1076
|
|
|
|
|
|
|
$object->add_tags(Role => 'Web Server', Status=>'development); |
1077
|
|
|
|
|
|
|
$object->delete_tags(Name=>undef); |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
See L for a full description of the uniform object |
1080
|
|
|
|
|
|
|
tagging interface, and L for methods that allow |
1081
|
|
|
|
|
|
|
you to manipulate the tags on multiple objects simultaneously. The |
1082
|
|
|
|
|
|
|
methods defined by this module are: |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
@t = $ec2->describe_tags(-filter=>\%filters); |
1085
|
|
|
|
|
|
|
$b = $ec2->create_tags(-resource_id=>\@ids,-tag=>{key1=>value1...}) |
1086
|
|
|
|
|
|
|
$b = $ec2->delete_tags(-resource_id=>$id1,-tag=>{key1=>value1...}) |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
=head1 VIRTUAL PRIVATE CLOUDS |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
EC2 virtual private clouds (VPCs) provide facilities for creating |
1091
|
|
|
|
|
|
|
tiered applications combining public and private subnetworks, and for |
1092
|
|
|
|
|
|
|
extending your home/corporate network into the cloud. VPC-related |
1093
|
|
|
|
|
|
|
methods are defined in the customer_gateway, dhcp, |
1094
|
|
|
|
|
|
|
elastic_network_interface, private_ip, internet_gateway, network_acl, |
1095
|
|
|
|
|
|
|
route_table, vpc, vpn, and vpn_gateway modules, and are loaded by |
1096
|
|
|
|
|
|
|
importing ':vpc'. See L for an introduction. |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
The L and L modules define |
1099
|
|
|
|
|
|
|
convenience methods that simplify working with VPC objects. This |
1100
|
|
|
|
|
|
|
allows for steps that typically follow each other, such as creating a |
1101
|
|
|
|
|
|
|
route table and associating it with a subnet, happen |
1102
|
|
|
|
|
|
|
automatically. For example, this series of calls creates a VPC with a |
1103
|
|
|
|
|
|
|
single subnet, creates an Internet gateway attached to the VPC, |
1104
|
|
|
|
|
|
|
associates a new route table with the subnet and then creates a |
1105
|
|
|
|
|
|
|
default route from the subnet to the Internet gateway: |
1106
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
$vpc = $ec2->create_vpc('10.0.0.0/16') or die $ec2->error_str; |
1108
|
|
|
|
|
|
|
$subnet1 = $vpc->create_subnet('10.0.0.0/24') or die $vpc->error_str; |
1109
|
|
|
|
|
|
|
$gateway = $vpc->create_internet_gateway or die $vpc->error_str; |
1110
|
|
|
|
|
|
|
$routeTbl = $subnet->create_route_table or die $vpc->error_str; |
1111
|
|
|
|
|
|
|
$routeTbl->create_route('0.0.0.0/0' => $gateway) or die $vpc->error_str; |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
=head1 ELASTIC LOAD BALANCERS (ELB) AND AUTOSCALING |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
The methods in the 'elastic_load_balancer' and 'autoscaling' modules |
1116
|
|
|
|
|
|
|
allow you to retrieve information about Elastic Load Balancers, create |
1117
|
|
|
|
|
|
|
new ELBs, and change the properties of the ELBs, as well as define |
1118
|
|
|
|
|
|
|
autoscaling groups and their launch configurations. These modules are |
1119
|
|
|
|
|
|
|
both imported by the ':scaling' import group. See |
1120
|
|
|
|
|
|
|
L and |
1121
|
|
|
|
|
|
|
L for descriptions of the facilities |
1122
|
|
|
|
|
|
|
enabled by this module. |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
=head1 AWS SECURITY POLICY |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
The VM::EC2::Security::Policy module provides a simple Identity and |
1127
|
|
|
|
|
|
|
Access Management (IAM) policy statement generator geared for use with |
1128
|
|
|
|
|
|
|
AWS security tokens (see next section). Its facilities are defined in |
1129
|
|
|
|
|
|
|
L. |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
=head1 AWS SECURITY TOKENS |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
AWS security tokens provide a way to grant temporary access to |
1134
|
|
|
|
|
|
|
resources in your EC2 space without giving them permanent |
1135
|
|
|
|
|
|
|
accounts. They also provide the foundation for mobile services and |
1136
|
|
|
|
|
|
|
multifactor authentication devices (MFA). These methods are defined in |
1137
|
|
|
|
|
|
|
'security_token', which is part of the ':standard' group. See |
1138
|
|
|
|
|
|
|
L for details. Here is a quick example: |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
Here is an example: |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
# on your side of the connection |
1143
|
|
|
|
|
|
|
$ec2 = VM::EC2->new(...); # as usual |
1144
|
|
|
|
|
|
|
my $policy = VM::EC2::Security::Policy->new; |
1145
|
|
|
|
|
|
|
$policy->allow('DescribeImages','RunInstances'); |
1146
|
|
|
|
|
|
|
my $token = $ec2->get_federation_token(-name => 'TemporaryUser', |
1147
|
|
|
|
|
|
|
-duration => 60*60*3, # 3 hrs, as seconds |
1148
|
|
|
|
|
|
|
-policy => $policy); |
1149
|
|
|
|
|
|
|
my $serialized = $token->credentials->serialize; |
1150
|
|
|
|
|
|
|
send_data_to_user_somehow($serialized); |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
# on the temporary user's side of the connection |
1153
|
|
|
|
|
|
|
my $serialized = get_data_somehow(); |
1154
|
|
|
|
|
|
|
my $token = VM::EC2::Security::Credentials->new_from_serialized($serialized); |
1155
|
|
|
|
|
|
|
my $ec2 = VM::EC2->new(-security_token => $token); |
1156
|
|
|
|
|
|
|
print $ec2->describe_images(-owner=>'self'); |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=head1 SPOT AND RESERVED INSTANCES |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
The 'spot_instance' and 'reserved_instance' modules allow you to |
1161
|
|
|
|
|
|
|
create and manipulate spot and reserved instances. They are both part |
1162
|
|
|
|
|
|
|
of the ':misc' import group. See L and |
1163
|
|
|
|
|
|
|
L. For example: |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
@offerings = $ec2->describe_reserved_instances_offerings( |
1166
|
|
|
|
|
|
|
{'availability-zone' => 'us-east-1a', |
1167
|
|
|
|
|
|
|
'instance-type' => 'c1.medium', |
1168
|
|
|
|
|
|
|
'product-description' =>'Linux/UNIX', |
1169
|
|
|
|
|
|
|
'duration' => 31536000, # this is 1 year |
1170
|
|
|
|
|
|
|
}); |
1171
|
|
|
|
|
|
|
$offerings[0]->purchase(5) and print "Five reserved instances purchased\n"; |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
=head1 WAITING FOR STATE CHANGES |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
VM::EC2 provides a series of methods that allow your script to wait in |
1178
|
|
|
|
|
|
|
an efficient manner for desired state changes in instances, volumes |
1179
|
|
|
|
|
|
|
and other objects. They are described in detail the individual modules |
1180
|
|
|
|
|
|
|
to which they apply, but in each case the method will block until each |
1181
|
|
|
|
|
|
|
member of a list of objects transitions to a terminal state |
1182
|
|
|
|
|
|
|
(e.g. "completed" in the case of a snapshot). Briefly: |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
$ec2->wait_for_instances(@instances) |
1185
|
|
|
|
|
|
|
$ec2->wait_for_snapshots(@snapshots) |
1186
|
|
|
|
|
|
|
$ec2->wait_for_volumes(@volumes) |
1187
|
|
|
|
|
|
|
$ec2->wait_for_attachments(@attachment) |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
There is also a generic version of this defined in the VM::EC2 core: |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
=head2 $ec2->wait_for_terminal_state(\@objects,['list','of','states'] [,$timeout]) |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
Generic version of the last four methods. Wait for all members of the |
1194
|
|
|
|
|
|
|
provided list of Amazon objects instances to reach some terminal state |
1195
|
|
|
|
|
|
|
listed in the second argument, and then return a hash reference that |
1196
|
|
|
|
|
|
|
maps each object ID to its final state. |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
If a timeout is provided, in seconds, then the method will abort after |
1199
|
|
|
|
|
|
|
waiting the indicated time and return undef. |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
=cut |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
sub wait_for_terminal_state { |
1204
|
|
|
|
|
|
|
my $self = shift; |
1205
|
|
|
|
|
|
|
my ($objects,$terminal_states,$timeout) = @_; |
1206
|
|
|
|
|
|
|
my %terminal_state = map {$_=>1} @$terminal_states; |
1207
|
|
|
|
|
|
|
my %status = (); |
1208
|
|
|
|
|
|
|
my @pending = grep {defined $_} @$objects; # in case we're passed an undef |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
my %timers; |
1211
|
|
|
|
|
|
|
my $done = $self->condvar(); |
1212
|
|
|
|
|
|
|
$done->begin(sub { |
1213
|
|
|
|
|
|
|
my $cv = shift; |
1214
|
|
|
|
|
|
|
if ($cv->error) { |
1215
|
|
|
|
|
|
|
$self->error($cv->error); |
1216
|
|
|
|
|
|
|
$cv->send(); |
1217
|
|
|
|
|
|
|
} else { |
1218
|
|
|
|
|
|
|
$cv->send(\%status); |
1219
|
|
|
|
|
|
|
} |
1220
|
|
|
|
|
|
|
} |
1221
|
|
|
|
|
|
|
); |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
for my $obj (@pending) { |
1224
|
|
|
|
|
|
|
$done->begin; |
1225
|
|
|
|
|
|
|
my $timer = AnyEvent->timer(interval => 3, |
1226
|
|
|
|
|
|
|
cb => sub { |
1227
|
|
|
|
|
|
|
$obj->current_status_async->cb( |
1228
|
|
|
|
|
|
|
sub { |
1229
|
|
|
|
|
|
|
my $state = shift->recv; |
1230
|
|
|
|
|
|
|
if (!$state || $terminal_state{$state}) { |
1231
|
|
|
|
|
|
|
$status{$obj} = $state; |
1232
|
|
|
|
|
|
|
$done->end; |
1233
|
|
|
|
|
|
|
undef $timers{$obj}; |
1234
|
|
|
|
|
|
|
}})}); |
1235
|
|
|
|
|
|
|
$timers{$obj} = $timer; |
1236
|
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
# timeout |
1239
|
|
|
|
|
|
|
my $timeout_event; |
1240
|
|
|
|
|
|
|
$timeout_event = AnyEvent->timer(after=> $timeout, |
1241
|
|
|
|
|
|
|
cb => sub { |
1242
|
|
|
|
|
|
|
undef %timers; # cancel all timers |
1243
|
|
|
|
|
|
|
undef $timeout_event; |
1244
|
|
|
|
|
|
|
$done->error('timeout waiting for terminal state'); |
1245
|
|
|
|
|
|
|
$done->end foreach @pending; |
1246
|
|
|
|
|
|
|
}) if $timeout; |
1247
|
|
|
|
|
|
|
$done->end; |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
return $ASYNC ? $done : $done->recv; |
1250
|
|
|
|
|
|
|
} |
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
=head2 $timeout = $ec2->wait_for_timeout([$new_timeout]); |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
Get or change the timeout for wait_for_instances(), wait_for_attachments(), |
1255
|
|
|
|
|
|
|
and wait_for_volumes(). The timeout is given in seconds, and defaults to |
1256
|
|
|
|
|
|
|
600 (10 minutes). You can set this to 0 to wait forever. |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
=cut |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
sub wait_for_timeout { |
1261
|
|
|
|
|
|
|
my $self = shift; |
1262
|
|
|
|
|
|
|
$self->{wait_for_timeout} = WAIT_FOR_TIMEOUT |
1263
|
|
|
|
|
|
|
unless defined $self->{wait_for_timeout}; |
1264
|
|
|
|
|
|
|
my $d = $self->{wait_for_timeout}; |
1265
|
|
|
|
|
|
|
$self->{wait_for_timeout} = shift if @_; |
1266
|
|
|
|
|
|
|
return $d; |
1267
|
|
|
|
|
|
|
} |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------------------ |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
=head1 INTERNAL METHODS |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
These methods are used internally and are listed here without |
1274
|
|
|
|
|
|
|
documentation (yet). |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
=head2 $underscore_name = $ec2->canonicalize($mixedCaseName) |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
=cut |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
sub canonicalize { |
1281
|
|
|
|
|
|
|
my $self = shift; |
1282
|
|
|
|
|
|
|
my $name = shift; |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
$name =~ s/^-//; |
1285
|
|
|
|
|
|
|
$name =~ s/DB/Db/g; |
1286
|
|
|
|
|
|
|
$name =~ s/AZ/Az/g; |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
while ($name =~ /[A-Z][^A-Z]/) { |
1289
|
|
|
|
|
|
|
$name =~ s/(?
|
1290
|
|
|
|
|
|
|
} |
1291
|
|
|
|
|
|
|
return '-'.lc $name; |
1292
|
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
sub uncanonicalize { |
1295
|
|
|
|
|
|
|
my $self = shift; |
1296
|
|
|
|
|
|
|
my $name = shift; |
1297
|
|
|
|
|
|
|
$name =~ s/_([a-z])/\U$1/g; |
1298
|
|
|
|
|
|
|
return $name; |
1299
|
|
|
|
|
|
|
} |
1300
|
|
|
|
|
|
|
|
1301
|
|
|
|
|
|
|
=head2 $instance_id = $ec2->instance_parm(@args) |
1302
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
=cut |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
sub instance_parm { |
1306
|
|
|
|
|
|
|
my $self = shift; |
1307
|
|
|
|
|
|
|
my %args; |
1308
|
|
|
|
|
|
|
if ($_[0] =~ /^-/) { |
1309
|
|
|
|
|
|
|
%args = @_; |
1310
|
|
|
|
|
|
|
} elsif (@_ > 1) { |
1311
|
|
|
|
|
|
|
%args = (-instance_id => [@_]); |
1312
|
|
|
|
|
|
|
} else { |
1313
|
|
|
|
|
|
|
%args = (-instance_id => shift); |
1314
|
|
|
|
|
|
|
} |
1315
|
|
|
|
|
|
|
my $id = $args{-instance_id}; |
1316
|
|
|
|
|
|
|
return ref $id && ref $id eq 'ARRAY' ? @$id : $id; |
1317
|
|
|
|
|
|
|
} |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
=head2 @arguments = $ec2->value_parm(ParameterName => \%args) |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
=cut |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
sub value_parm { |
1324
|
|
|
|
|
|
|
my $self = shift; |
1325
|
|
|
|
|
|
|
my ($argname,$args) = @_; |
1326
|
|
|
|
|
|
|
my $name = $self->canonicalize($argname); |
1327
|
|
|
|
|
|
|
return unless exists $args->{$name} || exists $args->{"-$argname"}; |
1328
|
|
|
|
|
|
|
my $val = $args->{$name} || $args->{"-$argname"}; |
1329
|
|
|
|
|
|
|
return ("$argname.Value"=>$val); |
1330
|
|
|
|
|
|
|
} |
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
=head2 @arguments = $ec2->single_parm(ParameterName => \%args) |
1333
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
=cut |
1335
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
sub single_parm { |
1337
|
|
|
|
|
|
|
my $self = shift; |
1338
|
|
|
|
|
|
|
my ($argname,$args) = @_; |
1339
|
|
|
|
|
|
|
my $name = $self->canonicalize($argname); |
1340
|
|
|
|
|
|
|
my $val = $args->{$name} || $args->{"-$argname"}; |
1341
|
|
|
|
|
|
|
defined $val or return; |
1342
|
|
|
|
|
|
|
my $v = ref $val && ref $val eq 'ARRAY' ? $val->[0] : $val; |
1343
|
|
|
|
|
|
|
return ($argname=>$v); |
1344
|
|
|
|
|
|
|
} |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
=head2 @parameters = $ec2->prefix_parm($prefix, ParameterName => \%args) |
1347
|
|
|
|
|
|
|
|
1348
|
|
|
|
|
|
|
=cut |
1349
|
|
|
|
|
|
|
|
1350
|
|
|
|
|
|
|
sub prefix_parm { |
1351
|
|
|
|
|
|
|
my $self = shift; |
1352
|
|
|
|
|
|
|
my ($prefix,$argname,$args) = @_; |
1353
|
|
|
|
|
|
|
my $name = $self->canonicalize($argname); |
1354
|
|
|
|
|
|
|
my $val = $args->{$name} || $args->{"-$argname"}; |
1355
|
|
|
|
|
|
|
defined $val or return; |
1356
|
|
|
|
|
|
|
my $v = ref $val && ref $val eq 'ARRAY' ? $val->[0] : $val; |
1357
|
|
|
|
|
|
|
return ("$prefix.$argname"=>$v); |
1358
|
|
|
|
|
|
|
} |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
=head2 @arguments = $ec2->member_hash_parms(ParameterName => \%args) |
1361
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
Create a parameter list from a hashref or arrayref of hashes |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
Created specifically for the RDS ModifyDBParameterGroup parameter |
1365
|
|
|
|
|
|
|
'Parameters', but may be useful for other calls in the future. |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
ie: |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
The argument would be in the form: |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
[ |
1372
|
|
|
|
|
|
|
{ |
1373
|
|
|
|
|
|
|
ParameterName=>'max_user_connections', |
1374
|
|
|
|
|
|
|
ParameterValue=>24, |
1375
|
|
|
|
|
|
|
ApplyMethod=>'pending-reboot' |
1376
|
|
|
|
|
|
|
}, |
1377
|
|
|
|
|
|
|
{ |
1378
|
|
|
|
|
|
|
ParameterName=>'max_allowed_packet', |
1379
|
|
|
|
|
|
|
ParameterValue=>1024, |
1380
|
|
|
|
|
|
|
ApplyMethod=>'immediate' |
1381
|
|
|
|
|
|
|
}, |
1382
|
|
|
|
|
|
|
]; |
1383
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
The resulting output would be if the argname is '-parameters': |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
Parameters.member.1.ParameterName => max_user_connections |
1387
|
|
|
|
|
|
|
Parameters.member.1.ParameterValue => 24 |
1388
|
|
|
|
|
|
|
Parameters.member.1.ApplyMethod => pending-reboot |
1389
|
|
|
|
|
|
|
Parameters.member.2.ParameterName => max_allowed_packet |
1390
|
|
|
|
|
|
|
Parameters.member.2.ParameterValue => 1024 |
1391
|
|
|
|
|
|
|
Parameters.member.2.ApplyMethod => immediate |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
=cut |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
sub member_hash_parms { |
1396
|
|
|
|
|
|
|
my $self = shift; |
1397
|
|
|
|
|
|
|
my ($argname,$args) = @_; |
1398
|
|
|
|
|
|
|
my $name = $self->canonicalize($argname); |
1399
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
my @params; |
1401
|
|
|
|
|
|
|
if (my $arg = $args->{$name}||$args->{"-$argname"}) { |
1402
|
|
|
|
|
|
|
$arg = [ $arg ] if ref $arg eq 'HASH'; |
1403
|
|
|
|
|
|
|
return unless ref $arg eq 'ARRAY'; |
1404
|
|
|
|
|
|
|
my $c = 1; |
1405
|
|
|
|
|
|
|
foreach my $a (@$arg) { |
1406
|
|
|
|
|
|
|
next unless ref $a eq 'HASH'; |
1407
|
|
|
|
|
|
|
foreach my $key (keys %$a) { |
1408
|
|
|
|
|
|
|
push @params, ("$argname.member.$c.$key" => $a->{$key}); |
1409
|
|
|
|
|
|
|
} |
1410
|
|
|
|
|
|
|
$c++; |
1411
|
|
|
|
|
|
|
} |
1412
|
|
|
|
|
|
|
} |
1413
|
|
|
|
|
|
|
return @params; |
1414
|
|
|
|
|
|
|
} |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
=head2 @arguments = $ec2->list_parm(ParameterName => \%args) |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
=cut |
1419
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
sub list_parm { |
1421
|
|
|
|
|
|
|
my $self = shift; |
1422
|
|
|
|
|
|
|
my ($argname,$args) = @_; |
1423
|
|
|
|
|
|
|
return $self->_list_parm($argname,$args); |
1424
|
|
|
|
|
|
|
} |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
=head2 @parameters = $ec2->member_list_parm(ParameterName => \%args) |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
=cut |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
sub member_list_parm { |
1431
|
|
|
|
|
|
|
my $self = shift; |
1432
|
|
|
|
|
|
|
my ($argname,$args) = @_; |
1433
|
|
|
|
|
|
|
return $self->_list_parm($argname,$args,'member'); |
1434
|
|
|
|
|
|
|
} |
1435
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
sub _list_parm { |
1437
|
|
|
|
|
|
|
my $self = shift; |
1438
|
|
|
|
|
|
|
my ($argname,$args,$append) = @_; |
1439
|
|
|
|
|
|
|
my $name = $self->canonicalize($argname); |
1440
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
my @params; |
1442
|
|
|
|
|
|
|
if (my $a = $args->{$name}||$args->{"-$argname"}) { |
1443
|
|
|
|
|
|
|
$argname .= ".$append" if $append; |
1444
|
|
|
|
|
|
|
my $c = 1; |
1445
|
|
|
|
|
|
|
for (ref $a && ref $a eq 'ARRAY' ? @$a : $a) { |
1446
|
|
|
|
|
|
|
push @params,("$argname.".$c++ => $_); |
1447
|
|
|
|
|
|
|
} |
1448
|
|
|
|
|
|
|
} |
1449
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
return @params; |
1451
|
|
|
|
|
|
|
} |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
=head2 @arguments = $ec2->filter_parm(\%args) |
1454
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
=cut |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
sub filter_parm { |
1458
|
|
|
|
|
|
|
my $self = shift; |
1459
|
|
|
|
|
|
|
my $args = shift; |
1460
|
|
|
|
|
|
|
return $self->key_value_parameters('Filter','Name','Value',$args); |
1461
|
|
|
|
|
|
|
} |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
=head2 @arguments = $ec2->key_value_parameters($param_name,$keyname,$valuename,\%args,$skip_undef_values) |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
=cut |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
sub key_value_parameters { |
1468
|
|
|
|
|
|
|
my $self = shift; |
1469
|
|
|
|
|
|
|
# e.g. 'Filter', 'Name','Value',{-filter=>{a=>b}} |
1470
|
|
|
|
|
|
|
return $self->_key_value_parameters(@_); |
1471
|
|
|
|
|
|
|
} |
1472
|
|
|
|
|
|
|
|
1473
|
|
|
|
|
|
|
=head2 @arguments = $ec2->member_key_value_parameters($param_name,$keyname,$valuename,\%args,$skip_undef_values) |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
=cut |
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
sub member_key_value_parameters { |
1478
|
|
|
|
|
|
|
my $self = shift; |
1479
|
|
|
|
|
|
|
my ($parameter_name,$keyname,$valuename,$args,$skip_undef_values) = @_; |
1480
|
|
|
|
|
|
|
return $self->_key_value_parameters($parameter_name,$keyname,$valuename,$args,$skip_undef_values,'member'); |
1481
|
|
|
|
|
|
|
} |
1482
|
|
|
|
|
|
|
|
1483
|
|
|
|
|
|
|
sub _key_value_parameters { |
1484
|
|
|
|
|
|
|
my $self = shift; |
1485
|
|
|
|
|
|
|
# e.g. 'Filter', 'Name','Value',{-filter=>{a=>b}} |
1486
|
|
|
|
|
|
|
my ($parameter_name,$keyname,$valuename,$args,$skip_undef_values,$append) = @_; |
1487
|
|
|
|
|
|
|
my $arg_name = $self->canonicalize($parameter_name); |
1488
|
|
|
|
|
|
|
|
1489
|
|
|
|
|
|
|
my @params; |
1490
|
|
|
|
|
|
|
if (my $a = $args->{$arg_name}||$args->{"-$parameter_name"}) { |
1491
|
|
|
|
|
|
|
$parameter_name .= ".$append" if $append; |
1492
|
|
|
|
|
|
|
my $c = 1; |
1493
|
|
|
|
|
|
|
if (ref $a && ref $a eq 'HASH') { |
1494
|
|
|
|
|
|
|
while (my ($name,$value) = each %$a) { |
1495
|
|
|
|
|
|
|
push @params,("$parameter_name.$c.$keyname" => $name); |
1496
|
|
|
|
|
|
|
if (ref $value && ref $value eq 'ARRAY') { |
1497
|
|
|
|
|
|
|
for (my $m=1;$m<=@$value;$m++) { |
1498
|
|
|
|
|
|
|
push @params,("$parameter_name.$c.$valuename.$m" => $value->[$m-1]) |
1499
|
|
|
|
|
|
|
} |
1500
|
|
|
|
|
|
|
} else { |
1501
|
|
|
|
|
|
|
push @params,("$parameter_name.$c.$valuename" => $value) |
1502
|
|
|
|
|
|
|
unless !defined $value && $skip_undef_values; |
1503
|
|
|
|
|
|
|
} |
1504
|
|
|
|
|
|
|
$c++; |
1505
|
|
|
|
|
|
|
} |
1506
|
|
|
|
|
|
|
} else { |
1507
|
|
|
|
|
|
|
for (ref $a ? @$a : $a) { |
1508
|
|
|
|
|
|
|
my ($name,$value) = /([^=]+)\s*=\s*(.+)/; |
1509
|
|
|
|
|
|
|
push @params,("$parameter_name.$c.$keyname" => $name); |
1510
|
|
|
|
|
|
|
push @params,("$parameter_name.$c.$valuename" => $value) |
1511
|
|
|
|
|
|
|
unless !defined $value && $skip_undef_values; |
1512
|
|
|
|
|
|
|
$c++; |
1513
|
|
|
|
|
|
|
} |
1514
|
|
|
|
|
|
|
} |
1515
|
|
|
|
|
|
|
} |
1516
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
return @params; |
1518
|
|
|
|
|
|
|
} |
1519
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
=head2 @arguments = $ec2->launch_perm_parm($prefix,$suffix,$value) |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
=cut |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
sub launch_perm_parm { |
1525
|
|
|
|
|
|
|
my $self = shift; |
1526
|
|
|
|
|
|
|
my ($prefix,$suffix,$value) = @_; |
1527
|
|
|
|
|
|
|
return unless defined $value; |
1528
|
|
|
|
|
|
|
$self->_perm_parm('LaunchPermission',$prefix,$suffix,$value); |
1529
|
|
|
|
|
|
|
} |
1530
|
|
|
|
|
|
|
|
1531
|
|
|
|
|
|
|
sub create_volume_perm_parm { |
1532
|
|
|
|
|
|
|
my $self = shift; |
1533
|
|
|
|
|
|
|
my ($prefix,$suffix,$value) = @_; |
1534
|
|
|
|
|
|
|
return unless defined $value; |
1535
|
|
|
|
|
|
|
$self->_perm_parm('CreateVolumePermission',$prefix,$suffix,$value); |
1536
|
|
|
|
|
|
|
} |
1537
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
sub _perm_parm { |
1539
|
|
|
|
|
|
|
my $self = shift; |
1540
|
|
|
|
|
|
|
my ($base,$prefix,$suffix,$value) = @_; |
1541
|
|
|
|
|
|
|
return unless defined $value; |
1542
|
|
|
|
|
|
|
my @list = ref $value && ref $value eq 'ARRAY' ? @$value : $value; |
1543
|
|
|
|
|
|
|
my $c = 1; |
1544
|
|
|
|
|
|
|
my @param; |
1545
|
|
|
|
|
|
|
for my $v (@list) { |
1546
|
|
|
|
|
|
|
push @param,("$base.$prefix.$c.$suffix" => $v); |
1547
|
|
|
|
|
|
|
$c++; |
1548
|
|
|
|
|
|
|
} |
1549
|
|
|
|
|
|
|
return @param; |
1550
|
|
|
|
|
|
|
} |
1551
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
=head2 @arguments = $ec2->iam_parm($args) |
1553
|
|
|
|
|
|
|
|
1554
|
|
|
|
|
|
|
=cut |
1555
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
sub iam_parm { |
1557
|
|
|
|
|
|
|
my $self = shift; |
1558
|
|
|
|
|
|
|
my $args = shift; |
1559
|
|
|
|
|
|
|
my @p; |
1560
|
|
|
|
|
|
|
push @p,('IamInstanceProfile.Arn' => $args->{-iam_arn}) if $args->{-iam_arn}; |
1561
|
|
|
|
|
|
|
push @p,('IamInstanceProfile.Name' => $args->{-iam_name}) if $args->{-iam_name}; |
1562
|
|
|
|
|
|
|
return @p; |
1563
|
|
|
|
|
|
|
} |
1564
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
=head2 @arguments = $ec2->block_device_parm($block_device_mapping_string) |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
=cut |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
sub block_device_parm { |
1570
|
|
|
|
|
|
|
my $self = shift; |
1571
|
|
|
|
|
|
|
my $devlist = shift or return; |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
my @dev = ref $devlist && ref $devlist eq 'ARRAY' ? @$devlist : $devlist; |
1574
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
my @p; |
1576
|
|
|
|
|
|
|
my $c = 1; |
1577
|
|
|
|
|
|
|
for my $d (@dev) { |
1578
|
|
|
|
|
|
|
$d =~ /^([^=]+)=([^=]+)$/ or croak "block device mapping must be in format /dev/sdXX=device-name"; |
1579
|
|
|
|
|
|
|
|
1580
|
|
|
|
|
|
|
my ($devicename,$blockdevice) = ($1,$2); |
1581
|
|
|
|
|
|
|
push @p,("BlockDeviceMapping.$c.DeviceName"=>$devicename); |
1582
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
if ($blockdevice =~ /^vol-/) { # this is a volume, and not a snapshot |
1584
|
|
|
|
|
|
|
my ($volume,$delete_on_term) = split ':',$blockdevice; |
1585
|
|
|
|
|
|
|
push @p,("BlockDeviceMapping.$c.Ebs.VolumeId" => $volume); |
1586
|
|
|
|
|
|
|
push @p,("BlockDeviceMapping.$c.Ebs.DeleteOnTermination"=>$delete_on_term) |
1587
|
|
|
|
|
|
|
if defined $delete_on_term && $delete_on_term=~/^(true|false|1|0)$/ |
1588
|
|
|
|
|
|
|
} |
1589
|
|
|
|
|
|
|
elsif ($blockdevice eq 'none') { |
1590
|
|
|
|
|
|
|
push @p,("BlockDeviceMapping.$c.NoDevice" => ''); |
1591
|
|
|
|
|
|
|
} elsif ($blockdevice =~ /^ephemeral\d$/) { |
1592
|
|
|
|
|
|
|
push @p,("BlockDeviceMapping.$c.VirtualName"=>$blockdevice); |
1593
|
|
|
|
|
|
|
} else { |
1594
|
|
|
|
|
|
|
my ($snapshot,$size,$delete_on_term,$vtype,$iops) = split ':',$blockdevice; |
1595
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
# Workaround for apparent bug in 2012-12-01 API; instances will crash without volume size |
1597
|
|
|
|
|
|
|
# even if a snapshot ID is provided |
1598
|
|
|
|
|
|
|
if ($snapshot) { |
1599
|
|
|
|
|
|
|
$size ||= eval{$self->describe_snapshots($snapshot)->volumeSize}; |
1600
|
|
|
|
|
|
|
push @p,("BlockDeviceMapping.$c.Ebs.SnapshotId" =>$snapshot); |
1601
|
|
|
|
|
|
|
} |
1602
|
|
|
|
|
|
|
|
1603
|
|
|
|
|
|
|
push @p,("BlockDeviceMapping.$c.Ebs.VolumeSize" =>$size) if $size; |
1604
|
|
|
|
|
|
|
push @p,("BlockDeviceMapping.$c.Ebs.DeleteOnTermination"=>$delete_on_term) |
1605
|
|
|
|
|
|
|
if defined $delete_on_term && $delete_on_term=~/^(true|false|1|0)$/; |
1606
|
|
|
|
|
|
|
push @p,("BlockDeviceMapping.$c.Ebs.VolumeType"=>$vtype) if $vtype; |
1607
|
|
|
|
|
|
|
push @p,("BlockDeviceMapping.$c.Ebs.Iops"=>$iops) if $iops; |
1608
|
|
|
|
|
|
|
} |
1609
|
|
|
|
|
|
|
$c++; |
1610
|
|
|
|
|
|
|
} |
1611
|
|
|
|
|
|
|
return @p; |
1612
|
|
|
|
|
|
|
} |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
# ['eth0=eni-123456','eth1=192.168.2.1,192.168.3.1,192.168.4.1:subnet-12345:sg-12345:true:My Weird Network'] |
1615
|
|
|
|
|
|
|
# form 1: ethX=network device id |
1616
|
|
|
|
|
|
|
# form 2: ethX=primary_address,secondary_address1,secondary_address2...:subnetId:securityGroupId:deleteOnTermination:description:AssociatePublicIpAddress |
1617
|
|
|
|
|
|
|
# form 3: ethX=primary_address,secondary_address_count:subnetId:securityGroupId:deleteOnTermination:description:AssociatePublicIpAddress |
1618
|
|
|
|
|
|
|
sub network_interface_parm { |
1619
|
|
|
|
|
|
|
my $self = shift; |
1620
|
|
|
|
|
|
|
my $args = shift; |
1621
|
|
|
|
|
|
|
my $devlist = $args->{-network_interfaces} or return; |
1622
|
|
|
|
|
|
|
my @dev = ref $devlist && ref $devlist eq 'ARRAY' ? @$devlist : $devlist; |
1623
|
|
|
|
|
|
|
|
1624
|
|
|
|
|
|
|
my @p; |
1625
|
|
|
|
|
|
|
my $c = 0; |
1626
|
|
|
|
|
|
|
for my $d (@dev) { |
1627
|
|
|
|
|
|
|
$d =~ /^eth(\d+)\s*=\s*([^=]+)$/ or croak "network device mapping must be in format ethX=option-string"; |
1628
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
my ($device_index,$device_options) = ($1,$2); |
1630
|
|
|
|
|
|
|
push @p,("NetworkInterface.$c.DeviceIndex" => $device_index); |
1631
|
|
|
|
|
|
|
my @options = split ':',$device_options; |
1632
|
|
|
|
|
|
|
if (@options == 1) { |
1633
|
|
|
|
|
|
|
push @p,("NetworkInterface.$c.NetworkInterfaceId" => $options[0]); |
1634
|
|
|
|
|
|
|
} |
1635
|
|
|
|
|
|
|
else { |
1636
|
|
|
|
|
|
|
my ($ip_addresses,$subnet_id,$security_group_id,$delete_on_termination,$description,$assoc_public_ip_addr) = @options; |
1637
|
|
|
|
|
|
|
# if assoc_public_ip_addr is true, the following conditions must be met: |
1638
|
|
|
|
|
|
|
# * can only associate a public address with a single network interface with a device index of 0 |
1639
|
|
|
|
|
|
|
# * cannot associate a public ip with a second network interface |
1640
|
|
|
|
|
|
|
# * cannot assoicate a public ip when launching more than one network interface |
1641
|
|
|
|
|
|
|
# NOTE: This option defaults to true in a default VPC |
1642
|
|
|
|
|
|
|
if ($assoc_public_ip_addr) { |
1643
|
|
|
|
|
|
|
$assoc_public_ip_addr = (($assoc_public_ip_addr eq 'true') && |
1644
|
|
|
|
|
|
|
($device_index == 0) && |
1645
|
|
|
|
|
|
|
(@dev == 1)) ? 'true' : 'false'; |
1646
|
|
|
|
|
|
|
} |
1647
|
|
|
|
|
|
|
my @addresses = split /\s*,\s*/,$ip_addresses; |
1648
|
|
|
|
|
|
|
for (my $a = 0; $a < @addresses; $a++) { |
1649
|
|
|
|
|
|
|
if ($addresses[$a] =~ /^\d+\.\d+\.\d+\.\d+$/ ) { |
1650
|
|
|
|
|
|
|
push @p,("NetworkInterface.$c.PrivateIpAddresses.$a.PrivateIpAddress" => $addresses[$a]); |
1651
|
|
|
|
|
|
|
push @p,("NetworkInterface.$c.PrivateIpAddresses.$a.Primary" => $a == 0 ? 'true' : 'false'); |
1652
|
|
|
|
|
|
|
} |
1653
|
|
|
|
|
|
|
elsif ($addresses[$a] =~ /^\d+$/ && $a > 0) { |
1654
|
|
|
|
|
|
|
push @p,("NetworkInterface.$c.SecondaryPrivateIpAddressCount" => $addresses[$a]); |
1655
|
|
|
|
|
|
|
} |
1656
|
|
|
|
|
|
|
} |
1657
|
|
|
|
|
|
|
my @sgs = split ',',$security_group_id; |
1658
|
|
|
|
|
|
|
for (my $i=0;$i<@sgs;$i++) { |
1659
|
|
|
|
|
|
|
push @p,("NetworkInterface.$c.SecurityGroupId.$i" => $sgs[$i]); |
1660
|
|
|
|
|
|
|
} |
1661
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
push @p,("NetworkInterface.$c.SubnetId" => $subnet_id) if length $subnet_id; |
1663
|
|
|
|
|
|
|
push @p,("NetworkInterface.$c.DeleteOnTermination" => $delete_on_termination) if length $delete_on_termination; |
1664
|
|
|
|
|
|
|
push @p,("NetworkInterface.$c.Description" => $description) if length $description; |
1665
|
|
|
|
|
|
|
push @p,("NetworkInterface.$c.AssociatePublicIpAddress" => $assoc_public_ip_addr) if $assoc_public_ip_addr; |
1666
|
|
|
|
|
|
|
} |
1667
|
|
|
|
|
|
|
$c++; |
1668
|
|
|
|
|
|
|
} |
1669
|
|
|
|
|
|
|
return @p; |
1670
|
|
|
|
|
|
|
} |
1671
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
sub boolean_parm { |
1673
|
|
|
|
|
|
|
my $self = shift; |
1674
|
|
|
|
|
|
|
my ($argname,$args) = @_; |
1675
|
|
|
|
|
|
|
my $name = $self->canonicalize($argname); |
1676
|
|
|
|
|
|
|
return unless exists $args->{$name} || exists $args->{$argname}; |
1677
|
|
|
|
|
|
|
my $val = $args->{$name} || $args->{$argname}; |
1678
|
|
|
|
|
|
|
return ($argname => $val ? 'true' : 'false'); |
1679
|
|
|
|
|
|
|
} |
1680
|
|
|
|
|
|
|
|
1681
|
|
|
|
|
|
|
sub boolean_value_parm { |
1682
|
|
|
|
|
|
|
my $self = shift; |
1683
|
|
|
|
|
|
|
my ($argname,$args) = @_; |
1684
|
|
|
|
|
|
|
my $name = $self->canonicalize($argname); |
1685
|
|
|
|
|
|
|
return unless exists $args->{$name} || exists $args->{$argname}; |
1686
|
|
|
|
|
|
|
my $val = $args->{$name} || $args->{$argname}; |
1687
|
|
|
|
|
|
|
return ("$argname.Value" => $val ? 'true' : 'false'); |
1688
|
|
|
|
|
|
|
} |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
=head2 $version = $ec2->version() |
1691
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
Returns the API version to be sent to the endpoint. Calls |
1693
|
|
|
|
|
|
|
guess_version_from_endpoint() to determine this. |
1694
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
=cut |
1696
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
sub version { |
1698
|
|
|
|
|
|
|
my $self = shift; |
1699
|
|
|
|
|
|
|
return $self->{version} ||= $self->guess_version_from_endpoint(); |
1700
|
|
|
|
|
|
|
} |
1701
|
|
|
|
|
|
|
|
1702
|
|
|
|
|
|
|
=head2 $version = $ec2->guess_version_from_endpoint() |
1703
|
|
|
|
|
|
|
|
1704
|
|
|
|
|
|
|
This method attempts to guess what version string to use when |
1705
|
|
|
|
|
|
|
communicating with various endpoints. When talking to endpoints that |
1706
|
|
|
|
|
|
|
contain the string "Eucalyptus" uses the old EC2 API |
1707
|
|
|
|
|
|
|
"2009-04-04". When talking to other endpoints, uses the latest EC2 |
1708
|
|
|
|
|
|
|
version string. |
1709
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
=cut |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
sub guess_version_from_endpoint { |
1713
|
|
|
|
|
|
|
my $self = shift; |
1714
|
|
|
|
|
|
|
my $endpoint = $self->endpoint; |
1715
|
|
|
|
|
|
|
return '2009-04-04' if $endpoint =~ /Eucalyptus/; # eucalyptus version according to http://www.eucalyptus.com/participate/code |
1716
|
|
|
|
|
|
|
return '2014-05-01'; # most recent AWS version that we support |
1717
|
|
|
|
|
|
|
} |
1718
|
|
|
|
|
|
|
|
1719
|
|
|
|
|
|
|
=head2 $ts = $ec2->timestamp |
1720
|
|
|
|
|
|
|
|
1721
|
|
|
|
|
|
|
=cut |
1722
|
|
|
|
|
|
|
|
1723
|
|
|
|
|
|
|
sub timestamp { |
1724
|
|
|
|
|
|
|
return strftime("%Y-%m-%dT%H:%M:%SZ",gmtime); |
1725
|
|
|
|
|
|
|
} |
1726
|
|
|
|
|
|
|
|
1727
|
|
|
|
|
|
|
|
1728
|
|
|
|
|
|
|
=head2 @obj = $ec2->call($action,@param); |
1729
|
|
|
|
|
|
|
|
1730
|
|
|
|
|
|
|
Make a call to Amazon using $action and the passed arguments, and |
1731
|
|
|
|
|
|
|
return a list of objects. |
1732
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
if $VM::EC2::ASYNC is set to true, then will return a |
1734
|
|
|
|
|
|
|
AnyEvent::CondVar object instead of a list of objects. You may |
1735
|
|
|
|
|
|
|
retrieve the objects by calling recv() or setting a callback: |
1736
|
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
|
$VM::EC2::ASYNC = 1; |
1738
|
|
|
|
|
|
|
my $cv = $ec2->call('DescribeInstances'); |
1739
|
|
|
|
|
|
|
my @obj = $cv->recv; |
1740
|
|
|
|
|
|
|
|
1741
|
|
|
|
|
|
|
or |
1742
|
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
$VM::EC2::ASYNC = 1; |
1744
|
|
|
|
|
|
|
my $cv = $ec2->call('DescribeInstances'); |
1745
|
|
|
|
|
|
|
$cv->cb(sub { my @objs = shift->recv; |
1746
|
|
|
|
|
|
|
do_something(@objs); |
1747
|
|
|
|
|
|
|
}); |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
=cut |
1750
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
sub call { |
1752
|
|
|
|
|
|
|
my $self = shift; |
1753
|
|
|
|
|
|
|
return $ASYNC ? $self->_call_async(@_) : $self->_call_sync(@_); |
1754
|
|
|
|
|
|
|
} |
1755
|
|
|
|
|
|
|
sub _call_sync { |
1756
|
|
|
|
|
|
|
my $self = shift; |
1757
|
|
|
|
|
|
|
my $cv = $self->_call_async(@_); |
1758
|
|
|
|
|
|
|
my @obj = $cv->recv; |
1759
|
|
|
|
|
|
|
$self->error($cv->error) if $cv->error; |
1760
|
|
|
|
|
|
|
if (!wantarray) { # scalar context |
1761
|
|
|
|
|
|
|
return $obj[0] if @obj == 1; |
1762
|
|
|
|
|
|
|
return if @obj == 0; |
1763
|
|
|
|
|
|
|
return @obj; |
1764
|
|
|
|
|
|
|
} else { |
1765
|
|
|
|
|
|
|
return @obj; |
1766
|
|
|
|
|
|
|
} |
1767
|
|
|
|
|
|
|
} |
1768
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
sub _call_async { |
1770
|
|
|
|
|
|
|
my $self = shift; |
1771
|
|
|
|
|
|
|
my ($action,@param) = @_; |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
# called if AWS::Signature4 NOT present; use built-in method |
1774
|
|
|
|
|
|
|
unless (AWS::Signature4->can('new')) { |
1775
|
|
|
|
|
|
|
my ($action,@param) = @_; |
1776
|
|
|
|
|
|
|
my $post = $self->_signature(Action=>$action,@param); |
1777
|
|
|
|
|
|
|
my $u = URI->new($self->endpoint); |
1778
|
|
|
|
|
|
|
$u->query_form(@$post); |
1779
|
|
|
|
|
|
|
return $self->async_post($action,POST($self->endpoint,Content=>$u->query)); |
1780
|
|
|
|
|
|
|
} |
1781
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
# called if AWS::Signature4 IS present; use external module |
1784
|
|
|
|
|
|
|
my $request = POST($self->endpoint, |
1785
|
|
|
|
|
|
|
'content-type'=>'application/x-www-form-urlencoded', |
1786
|
|
|
|
|
|
|
Content => [ |
1787
|
|
|
|
|
|
|
Action => $action, |
1788
|
|
|
|
|
|
|
Version => $self->version, |
1789
|
|
|
|
|
|
|
@param |
1790
|
|
|
|
|
|
|
]); |
1791
|
|
|
|
|
|
|
my $access_key = $self->access_key; |
1792
|
|
|
|
|
|
|
my $secret_key = $self->secret; |
1793
|
|
|
|
|
|
|
my $host = URI->new($self->endpoint)->host; |
1794
|
|
|
|
|
|
|
$request->header('x-amz-security-token'=>$self->security_token) if $self->security_token; |
1795
|
|
|
|
|
|
|
$request->header('user-agent' => 'VM::EC2-perl'); |
1796
|
|
|
|
|
|
|
$request->header('action' => $action); # maybe not necessary, but docs say it is! |
1797
|
|
|
|
|
|
|
$request->header('host' => $host); |
1798
|
|
|
|
|
|
|
|
1799
|
|
|
|
|
|
|
AWS::Signature4->new(-access_key=>$access_key, |
1800
|
|
|
|
|
|
|
-secret_key=>$secret_key)->sign($request); |
1801
|
|
|
|
|
|
|
$self->async_post($action,$request); |
1802
|
|
|
|
|
|
|
} |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
sub async_post { |
1805
|
|
|
|
|
|
|
my $self = shift; |
1806
|
|
|
|
|
|
|
$self->async_request('POST',@_); |
1807
|
|
|
|
|
|
|
} |
1808
|
|
|
|
|
|
|
|
1809
|
|
|
|
|
|
|
sub async_get { |
1810
|
|
|
|
|
|
|
my $self = shift; |
1811
|
|
|
|
|
|
|
$self->async_request('GET',@_); |
1812
|
|
|
|
|
|
|
} |
1813
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
sub async_put { |
1815
|
|
|
|
|
|
|
my $self = shift; |
1816
|
|
|
|
|
|
|
$self->async_request('PUT',@_); |
1817
|
|
|
|
|
|
|
} |
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
sub async_delete { |
1820
|
|
|
|
|
|
|
my $self = shift; |
1821
|
|
|
|
|
|
|
$self->async_request('DELETE',@_); |
1822
|
|
|
|
|
|
|
} |
1823
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
sub async_request { |
1825
|
|
|
|
|
|
|
my $self = shift; |
1826
|
|
|
|
|
|
|
my ($method,$action,$request) = @_; |
1827
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
my @headers; |
1829
|
|
|
|
|
|
|
$request->headers->scan(sub {push @headers,@_}); |
1830
|
|
|
|
|
|
|
|
1831
|
|
|
|
|
|
|
my $cv = $self->condvar; |
1832
|
|
|
|
|
|
|
my $callback = sub { |
1833
|
|
|
|
|
|
|
my $timer = shift; |
1834
|
|
|
|
|
|
|
http_request( |
1835
|
|
|
|
|
|
|
$method => $request->uri, |
1836
|
|
|
|
|
|
|
body => $request->content, |
1837
|
|
|
|
|
|
|
headers => { |
1838
|
|
|
|
|
|
|
TE => undef, |
1839
|
|
|
|
|
|
|
Referer => undef, |
1840
|
|
|
|
|
|
|
@headers, |
1841
|
|
|
|
|
|
|
}, |
1842
|
|
|
|
|
|
|
sub { |
1843
|
|
|
|
|
|
|
my ($body,$hdr) = @_; |
1844
|
|
|
|
|
|
|
if ($hdr->{Status} !~ /^2/) { # an error |
1845
|
|
|
|
|
|
|
if ($body =~ /RequestLimitExceeded/) { |
1846
|
|
|
|
|
|
|
warn "RequestLimitExceeded. Retry in ",$timer->next_interval()," seconds\n"; |
1847
|
|
|
|
|
|
|
$timer->retry(); |
1848
|
|
|
|
|
|
|
return; |
1849
|
|
|
|
|
|
|
} else { |
1850
|
|
|
|
|
|
|
$self->async_send_error($action,$hdr,$body,$cv); |
1851
|
|
|
|
|
|
|
$timer->success(); |
1852
|
|
|
|
|
|
|
return; |
1853
|
|
|
|
|
|
|
} |
1854
|
|
|
|
|
|
|
} else { # success |
1855
|
|
|
|
|
|
|
$self->error(undef); |
1856
|
|
|
|
|
|
|
my @obj = VM::EC2::Dispatch->content2objects($action,$body,$self); |
1857
|
|
|
|
|
|
|
$cv->send(@obj); |
1858
|
|
|
|
|
|
|
$timer->success(); |
1859
|
|
|
|
|
|
|
} |
1860
|
|
|
|
|
|
|
}) |
1861
|
|
|
|
|
|
|
}; |
1862
|
|
|
|
|
|
|
RetryTimer->new(on_retry => $callback, |
1863
|
|
|
|
|
|
|
interval => 1, |
1864
|
|
|
|
|
|
|
max_retries => 12, |
1865
|
|
|
|
|
|
|
on_max_retries => sub { $cv->error(VM::EC2::Error->new({Code=>500,Message=>'RequestLimitExceeded'},$self)) }); |
1866
|
|
|
|
|
|
|
|
1867
|
|
|
|
|
|
|
return $cv; |
1868
|
|
|
|
|
|
|
} |
1869
|
|
|
|
|
|
|
|
1870
|
|
|
|
|
|
|
sub async_send_error { |
1871
|
|
|
|
|
|
|
my $self = shift; |
1872
|
|
|
|
|
|
|
my ($action,$hdr,$body,$cv) = @_; |
1873
|
|
|
|
|
|
|
my $error; |
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
if ($body =~ //) { |
1876
|
|
|
|
|
|
|
$error = VM::EC2::Dispatch->create_error_object($body,$self,$action); |
1877
|
|
|
|
|
|
|
} elsif ($body =~ /
1878
|
|
|
|
|
|
|
$error = VM::EC2::Dispatch->create_alt_error_object($body,$self,$action); |
1879
|
|
|
|
|
|
|
} else { |
1880
|
|
|
|
|
|
|
my $code = $hdr->{Status}; |
1881
|
|
|
|
|
|
|
my $msg = $code =~ /^59[0-9]/ ? $hdr->{Reason} : $body; |
1882
|
|
|
|
|
|
|
$error = VM::EC2::Error->new({Code=>$code,Message=>"$msg, at API call '$action')"},$self); |
1883
|
|
|
|
|
|
|
} |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
$cv->error($error); |
1886
|
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
# this is probably not want we want to do, because it will cause error messages to |
1888
|
|
|
|
|
|
|
# appear in random places nested into some deep callback. |
1889
|
|
|
|
|
|
|
carp "$error" if $self->print_error; |
1890
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
if ($self->raise_error) { |
1892
|
|
|
|
|
|
|
$cv->croak($error); |
1893
|
|
|
|
|
|
|
} else { |
1894
|
|
|
|
|
|
|
$cv->send; |
1895
|
|
|
|
|
|
|
} |
1896
|
|
|
|
|
|
|
} |
1897
|
|
|
|
|
|
|
|
1898
|
|
|
|
|
|
|
sub signin_call { |
1899
|
|
|
|
|
|
|
my $self = shift; |
1900
|
|
|
|
|
|
|
my ($action,%args) = @_; |
1901
|
|
|
|
|
|
|
my $endpoint = 'https://signin.aws.amazon.com/federation'; |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
$args{'Action'} = $action; |
1904
|
|
|
|
|
|
|
|
1905
|
|
|
|
|
|
|
my @param; |
1906
|
|
|
|
|
|
|
for my $p (sort keys %args) { |
1907
|
|
|
|
|
|
|
push @param , join '=' , map { uri_escape($_,"^A-Za-z0-9\-_.~") } ($p,$args{$p}); |
1908
|
|
|
|
|
|
|
} |
1909
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
my $request = GET "$endpoint?" . join '&', @param; |
1911
|
|
|
|
|
|
|
|
1912
|
|
|
|
|
|
|
my $response = $self->ua->request($request); |
1913
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
return JSON::decode_json($response->content); |
1915
|
|
|
|
|
|
|
} |
1916
|
|
|
|
|
|
|
|
1917
|
|
|
|
|
|
|
=head2 $url = $ec2->login_url(-credentials => $credentials, -issuer => $issuer_url, -destination => $console_url); |
1918
|
|
|
|
|
|
|
|
1919
|
|
|
|
|
|
|
Returns an HTTP::Request object that points to the URL to login a user with STS credentials |
1920
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
-credentials => $fed_token->credentials - Credentials from an $ec2->get_federation_token call |
1922
|
|
|
|
|
|
|
-token => $token - a SigninToken from $ec2->get_signin_token call |
1923
|
|
|
|
|
|
|
-issuer => $issuer_url |
1924
|
|
|
|
|
|
|
-destination => $console_url - URL of the AWS console. Defaults to https://console.aws.amazon.com/console/home |
1925
|
|
|
|
|
|
|
-auto_scaling_group_names List of auto scaling groups to describe |
1926
|
|
|
|
|
|
|
-names Alias of -auto_scaling_group_names |
1927
|
|
|
|
|
|
|
|
1928
|
|
|
|
|
|
|
-credentials or -token are required for this method to work |
1929
|
|
|
|
|
|
|
|
1930
|
|
|
|
|
|
|
Usage can be: |
1931
|
|
|
|
|
|
|
|
1932
|
|
|
|
|
|
|
my $fed_token = $ec2->get_federation_token(...); |
1933
|
|
|
|
|
|
|
my $token = $ec2->get_signin_token(-credentials => $fed_token->credentials); |
1934
|
|
|
|
|
|
|
my $url = $ec2->login_url(-token => $token->{SigninToken}, -issuer => $issuer_url, -destination => $console_url); |
1935
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
Or: |
1937
|
|
|
|
|
|
|
|
1938
|
|
|
|
|
|
|
my $fed_token = $ec2->get_federation_token(...); |
1939
|
|
|
|
|
|
|
my $url = $ec2->login_url(-credentials => $fed_token->credentials, -issuer => $issuer_url, -destination => $console_url); |
1940
|
|
|
|
|
|
|
|
1941
|
|
|
|
|
|
|
=cut |
1942
|
|
|
|
|
|
|
|
1943
|
|
|
|
|
|
|
sub login_url { |
1944
|
|
|
|
|
|
|
my $self = shift; |
1945
|
|
|
|
|
|
|
my %args = @_; |
1946
|
|
|
|
|
|
|
my $endpoint = 'https://signin.aws.amazon.com/federation'; |
1947
|
|
|
|
|
|
|
|
1948
|
|
|
|
|
|
|
my %parms; |
1949
|
|
|
|
|
|
|
$parms{Action} = 'login'; |
1950
|
|
|
|
|
|
|
$parms{Destination} = $args{-destination} if ($args{-destination}); |
1951
|
|
|
|
|
|
|
$parms{Issuer} = $args{-issuer} if ($args{-issuer}); |
1952
|
|
|
|
|
|
|
$parms{SigninToken} = $args{-token} if ($args{-token}); |
1953
|
|
|
|
|
|
|
|
1954
|
|
|
|
|
|
|
if (defined $args{-credentials} and not defined $parms{SigninToken}) { |
1955
|
|
|
|
|
|
|
$parms{SigninToken} = $self->get_signin_token(-credentials => $args{-credentials})->{SigninToken}; |
1956
|
|
|
|
|
|
|
} |
1957
|
|
|
|
|
|
|
|
1958
|
|
|
|
|
|
|
|
1959
|
|
|
|
|
|
|
my @param; |
1960
|
|
|
|
|
|
|
for my $p (sort keys %parms) { |
1961
|
|
|
|
|
|
|
push @param , join '=' , map { uri_escape($_,"^A-Za-z0-9\-_.~") } ($p,$parms{$p}); |
1962
|
|
|
|
|
|
|
} |
1963
|
|
|
|
|
|
|
|
1964
|
|
|
|
|
|
|
GET "$endpoint?" . join '&', @param; |
1965
|
|
|
|
|
|
|
} |
1966
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
=head2 $request = $ec2->_sign(@args) |
1968
|
|
|
|
|
|
|
|
1969
|
|
|
|
|
|
|
Create and sign an HTTP::Request. |
1970
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
=cut |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
# adapted from Jeff Kim's Net::Amazon::EC2 module |
1974
|
|
|
|
|
|
|
sub _sign { |
1975
|
|
|
|
|
|
|
my $self = shift; |
1976
|
|
|
|
|
|
|
my $signature = $self->_signature(@_); |
1977
|
|
|
|
|
|
|
return POST $self->endpoint,$signature; |
1978
|
|
|
|
|
|
|
} |
1979
|
|
|
|
|
|
|
|
1980
|
|
|
|
|
|
|
sub _signature { |
1981
|
|
|
|
|
|
|
my $self = shift; |
1982
|
|
|
|
|
|
|
my @args = @_; |
1983
|
|
|
|
|
|
|
|
1984
|
|
|
|
|
|
|
my $action = 'POST'; |
1985
|
|
|
|
|
|
|
my $uri = URI->new($self->endpoint); |
1986
|
|
|
|
|
|
|
my $host = $uri->host_port; |
1987
|
|
|
|
|
|
|
$host =~ s/:(80|443)$//; # default ports will break |
1988
|
|
|
|
|
|
|
my $path = $uri->path||'/'; |
1989
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
my %sign_hash = @args; |
1991
|
|
|
|
|
|
|
$sign_hash{AWSAccessKeyId} = $self->id; |
1992
|
|
|
|
|
|
|
$sign_hash{Timestamp} = $self->timestamp; |
1993
|
|
|
|
|
|
|
$sign_hash{Version} = $self->version; |
1994
|
|
|
|
|
|
|
$sign_hash{SignatureVersion} = 2; |
1995
|
|
|
|
|
|
|
$sign_hash{SignatureMethod} = 'HmacSHA256'; |
1996
|
|
|
|
|
|
|
$sign_hash{SecurityToken} = $self->security_token if $self->security_token; |
1997
|
|
|
|
|
|
|
|
1998
|
|
|
|
|
|
|
my @param; |
1999
|
|
|
|
|
|
|
my @parameter_keys = sort keys %sign_hash; |
2000
|
|
|
|
|
|
|
for my $p (@parameter_keys) { |
2001
|
|
|
|
|
|
|
push @param,join '=',map {uri_escape($_,"^A-Za-z0-9\-_.~")} ($p,$sign_hash{$p}); |
2002
|
|
|
|
|
|
|
} |
2003
|
|
|
|
|
|
|
my $to_sign = join("\n", |
2004
|
|
|
|
|
|
|
$action,$host,$path,join('&',@param)); |
2005
|
|
|
|
|
|
|
my $signature = encode_base64(hmac_sha256($to_sign,$self->secret),''); |
2006
|
|
|
|
|
|
|
$sign_hash{Signature} = $signature; |
2007
|
|
|
|
|
|
|
return [%sign_hash]; |
2008
|
|
|
|
|
|
|
} |
2009
|
|
|
|
|
|
|
|
2010
|
|
|
|
|
|
|
=head2 @param = $ec2->args(ParamName=>@_) |
2011
|
|
|
|
|
|
|
|
2012
|
|
|
|
|
|
|
Set up calls that take either method(-resource_id=>'foo') or method('foo'). |
2013
|
|
|
|
|
|
|
|
2014
|
|
|
|
|
|
|
=cut |
2015
|
|
|
|
|
|
|
|
2016
|
|
|
|
|
|
|
sub args { |
2017
|
|
|
|
|
|
|
my $self = shift; |
2018
|
|
|
|
|
|
|
my $default_param_name = shift; |
2019
|
|
|
|
|
|
|
return unless @_; |
2020
|
|
|
|
|
|
|
return @_ if $_[0] =~ /^-/; |
2021
|
|
|
|
|
|
|
return (-filter=>shift) if @_==1 && ref $_[0] && ref $_[0] eq 'HASH'; |
2022
|
|
|
|
|
|
|
return ($default_param_name => \@_); |
2023
|
|
|
|
|
|
|
} |
2024
|
|
|
|
|
|
|
|
2025
|
|
|
|
|
|
|
sub condvar { |
2026
|
|
|
|
|
|
|
bless AnyEvent->condvar,'VM::EC2::CondVar'; |
2027
|
|
|
|
|
|
|
} |
2028
|
|
|
|
|
|
|
|
2029
|
|
|
|
|
|
|
# utility - retry a call with exponential backoff until it succeeds |
2030
|
|
|
|
|
|
|
package RetryTimer; |
2031
|
|
|
|
|
|
|
use AnyEvent; |
2032
|
|
|
|
|
|
|
use Carp 'croak'; |
2033
|
|
|
|
|
|
|
|
2034
|
|
|
|
|
|
|
# try a subroutine multiple times with exponential backoff |
2035
|
|
|
|
|
|
|
# until it succeeds. Subroutine must call timer's success() method |
2036
|
|
|
|
|
|
|
# if it succeds, retry() otherwise. |
2037
|
|
|
|
|
|
|
|
2038
|
|
|
|
|
|
|
# Arguments |
2039
|
|
|
|
|
|
|
# on_retry=>CODEREF, |
2040
|
|
|
|
|
|
|
# on_max_retries=>CODEREF, |
2041
|
|
|
|
|
|
|
# interval => $seconds, # defaults to 1 |
2042
|
|
|
|
|
|
|
# multiplier=>$fraction, # defaults to 1.5 |
2043
|
|
|
|
|
|
|
# max_retries=>$integer, # defaults to 10 |
2044
|
|
|
|
|
|
|
sub new { |
2045
|
|
|
|
|
|
|
my $class = shift; |
2046
|
|
|
|
|
|
|
my @args = @_; |
2047
|
|
|
|
|
|
|
|
2048
|
|
|
|
|
|
|
my $self; |
2049
|
|
|
|
|
|
|
$self = bless { |
2050
|
|
|
|
|
|
|
timer => AE::timer(0,0, sub { |
2051
|
|
|
|
|
|
|
delete $self->{timer}; |
2052
|
|
|
|
|
|
|
$self->{on_retry}->($self) if $self->{on_retry}; |
2053
|
|
|
|
|
|
|
}), |
2054
|
|
|
|
|
|
|
tries => 0, |
2055
|
|
|
|
|
|
|
current_interval => 0, |
2056
|
|
|
|
|
|
|
@args, |
2057
|
|
|
|
|
|
|
},ref $class || $class; |
2058
|
|
|
|
|
|
|
|
2059
|
|
|
|
|
|
|
croak "need a on_retry argument" unless $self->{on_retry}; |
2060
|
|
|
|
|
|
|
$self->{interval} ||= 1; |
2061
|
|
|
|
|
|
|
$self->{multiplier} ||= 1.5; |
2062
|
|
|
|
|
|
|
$self->{max_retries} = 10 unless defined $self->{max_retries}; |
2063
|
|
|
|
|
|
|
return $self; |
2064
|
|
|
|
|
|
|
} |
2065
|
|
|
|
|
|
|
|
2066
|
|
|
|
|
|
|
sub retry { |
2067
|
|
|
|
|
|
|
my $self = shift; |
2068
|
|
|
|
|
|
|
return if $self->{timer}; |
2069
|
|
|
|
|
|
|
$self->{current_interval} = $self->next_interval; |
2070
|
|
|
|
|
|
|
$self->{tries}++; |
2071
|
|
|
|
|
|
|
|
2072
|
|
|
|
|
|
|
if ($self->{max_retries} && $self->{max_retries} <= $self->{tries}) { |
2073
|
|
|
|
|
|
|
delete $self->{timer}; |
2074
|
|
|
|
|
|
|
delete $self->{current_interval}; |
2075
|
|
|
|
|
|
|
$self->{on_max_retries}->($self) if $self->{on_max_retries}; |
2076
|
|
|
|
|
|
|
return; |
2077
|
|
|
|
|
|
|
} |
2078
|
|
|
|
|
|
|
$self->{timer} = AE::timer ($self->{current_interval},0, |
2079
|
|
|
|
|
|
|
sub { |
2080
|
|
|
|
|
|
|
delete $self->{timer}; |
2081
|
|
|
|
|
|
|
$self->{on_retry}->($self) |
2082
|
|
|
|
|
|
|
if $self && $self->{on_retry}; |
2083
|
|
|
|
|
|
|
}); |
2084
|
|
|
|
|
|
|
} |
2085
|
|
|
|
|
|
|
|
2086
|
|
|
|
|
|
|
sub next_interval { |
2087
|
|
|
|
|
|
|
my $self = shift; |
2088
|
|
|
|
|
|
|
if ($self->{current_interval}) { |
2089
|
|
|
|
|
|
|
return $self->{current_interval} * $self->{multiplier}; |
2090
|
|
|
|
|
|
|
} else { |
2091
|
|
|
|
|
|
|
return $self->{interval}; |
2092
|
|
|
|
|
|
|
} |
2093
|
|
|
|
|
|
|
} |
2094
|
|
|
|
|
|
|
|
2095
|
|
|
|
|
|
|
sub current_interval { shift->{current_interval} }; |
2096
|
|
|
|
|
|
|
|
2097
|
|
|
|
|
|
|
sub success { |
2098
|
|
|
|
|
|
|
my $self = shift; |
2099
|
|
|
|
|
|
|
delete $self->{current_interval}; |
2100
|
|
|
|
|
|
|
delete $self->{timer}; |
2101
|
|
|
|
|
|
|
} |
2102
|
|
|
|
|
|
|
|
2103
|
|
|
|
|
|
|
package VM::EC2::CondVar; |
2104
|
|
|
|
|
|
|
use base 'AnyEvent::CondVar'; |
2105
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
sub error { |
2107
|
|
|
|
|
|
|
my $self = shift; |
2108
|
|
|
|
|
|
|
my $d = $self->{error}; |
2109
|
|
|
|
|
|
|
$self->{error} = shift if @_; |
2110
|
|
|
|
|
|
|
return $d; |
2111
|
|
|
|
|
|
|
} |
2112
|
|
|
|
|
|
|
|
2113
|
|
|
|
|
|
|
sub recv { |
2114
|
|
|
|
|
|
|
my $self = shift; |
2115
|
|
|
|
|
|
|
my @obj = $self->SUPER::recv; |
2116
|
|
|
|
|
|
|
if (!wantarray) { # scalar context |
2117
|
|
|
|
|
|
|
return $obj[0] if @obj == 1; |
2118
|
|
|
|
|
|
|
return if @obj == 0; |
2119
|
|
|
|
|
|
|
return @obj; |
2120
|
|
|
|
|
|
|
} else { |
2121
|
|
|
|
|
|
|
return @obj; |
2122
|
|
|
|
|
|
|
} |
2123
|
|
|
|
|
|
|
} |
2124
|
|
|
|
|
|
|
|
2125
|
|
|
|
|
|
|
=head1 OTHER INFORMATION |
2126
|
|
|
|
|
|
|
|
2127
|
|
|
|
|
|
|
This section contains technical information that may be of interest to developers. |
2128
|
|
|
|
|
|
|
|
2129
|
|
|
|
|
|
|
=head2 Signing and authentication protocol |
2130
|
|
|
|
|
|
|
|
2131
|
|
|
|
|
|
|
This module uses Amazon AWS signing protocol version 2, as described at |
2132
|
|
|
|
|
|
|
http://docs.amazonwebservices.com/AWSEC2/latest/UserGuide/index.html?using-query-api.html. |
2133
|
|
|
|
|
|
|
It uses the HmacSHA256 signature method, which is the most secure |
2134
|
|
|
|
|
|
|
method currently available. For additional security, use "https" for |
2135
|
|
|
|
|
|
|
the communications endpoint: |
2136
|
|
|
|
|
|
|
|
2137
|
|
|
|
|
|
|
$ec2 = VM::EC2->new(-endpoint=>'https://ec2.amazonaws.com'); |
2138
|
|
|
|
|
|
|
|
2139
|
|
|
|
|
|
|
=head2 Subclassing VM::EC2 objects |
2140
|
|
|
|
|
|
|
|
2141
|
|
|
|
|
|
|
To subclass VM::EC2 objects (or implement your own from scratch) you |
2142
|
|
|
|
|
|
|
will need to override the object dispatch mechanism. Fortunately this |
2143
|
|
|
|
|
|
|
is very easy. After "use VM::EC2" call |
2144
|
|
|
|
|
|
|
VM::EC2::Dispatch->register() one or more times: |
2145
|
|
|
|
|
|
|
|
2146
|
|
|
|
|
|
|
VM::EC2::Dispatch->register($call_name => $dispatch). |
2147
|
|
|
|
|
|
|
|
2148
|
|
|
|
|
|
|
The first argument, $call_name, is name of the Amazon API call, such as "DescribeImages". |
2149
|
|
|
|
|
|
|
|
2150
|
|
|
|
|
|
|
The second argument, $dispatch, instructs VM::EC2::Dispatch how to |
2151
|
|
|
|
|
|
|
create objects from the parsed XML. There are three possible syntaxes: |
2152
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
1) A CODE references, such as an anonymous subroutine. |
2154
|
|
|
|
|
|
|
|
2155
|
|
|
|
|
|
|
In this case the code reference will be invoked to handle the |
2156
|
|
|
|
|
|
|
parsed XML returned from the request. The code will receive |
2157
|
|
|
|
|
|
|
two arguments consisting of the parsed |
2158
|
|
|
|
|
|
|
content of the response, and the VM::EC2 object used to generate the |
2159
|
|
|
|
|
|
|
request. |
2160
|
|
|
|
|
|
|
|
2161
|
|
|
|
|
|
|
2) A VM::EC2::Dispatch method name, optionally followed by its arguments |
2162
|
|
|
|
|
|
|
delimited by commas. Example: |
2163
|
|
|
|
|
|
|
|
2164
|
|
|
|
|
|
|
"fetch_items,securityGroupInfo,VM::EC2::SecurityGroup" |
2165
|
|
|
|
|
|
|
|
2166
|
|
|
|
|
|
|
This tells Dispatch to invoke its fetch_items() method with |
2167
|
|
|
|
|
|
|
the following arguments: |
2168
|
|
|
|
|
|
|
|
2169
|
|
|
|
|
|
|
$dispatch->fetch_items($parsed_xml,$ec2,'securityGroupInfo','VM::EC2::SecurityGroup') |
2170
|
|
|
|
|
|
|
|
2171
|
|
|
|
|
|
|
The fetch_items() method is used for responses in which a |
2172
|
|
|
|
|
|
|
list of objects is embedded within a series of - tags.
|
2173
|
|
|
|
|
|
|
See L for more information. |
2174
|
|
|
|
|
|
|
|
2175
|
|
|
|
|
|
|
Other commonly-used methods are "fetch_one", and "boolean". |
2176
|
|
|
|
|
|
|
|
2177
|
|
|
|
|
|
|
3) A class name, such as 'MyVolume' |
2178
|
|
|
|
|
|
|
|
2179
|
|
|
|
|
|
|
In this case, class MyVolume is loaded and then its new() method |
2180
|
|
|
|
|
|
|
is called with the four arguments ($parsed_xml,$ec2,$xmlns,$requestid), |
2181
|
|
|
|
|
|
|
where $parsed_xml is the parsed XML response, $ec2 is the VM::EC2 |
2182
|
|
|
|
|
|
|
object that generated the request, $xmlns is the XML namespace |
2183
|
|
|
|
|
|
|
of the XML response, and $requestid is the AWS-generated ID for the |
2184
|
|
|
|
|
|
|
request. Only the first two arguments are really useful. |
2185
|
|
|
|
|
|
|
|
2186
|
|
|
|
|
|
|
I suggest you inherit from VM::EC2::Generic and use the inherited new() |
2187
|
|
|
|
|
|
|
method to store the parsed XML object and other arguments. |
2188
|
|
|
|
|
|
|
|
2189
|
|
|
|
|
|
|
Dispatch tries each of (1), (2) and (3), in order. This means that |
2190
|
|
|
|
|
|
|
class names cannot collide with method names. |
2191
|
|
|
|
|
|
|
|
2192
|
|
|
|
|
|
|
The parsed content is the result of passing the raw XML through a |
2193
|
|
|
|
|
|
|
XML::Simple object created with: |
2194
|
|
|
|
|
|
|
|
2195
|
|
|
|
|
|
|
XML::Simple->new(ForceArray => ['item'], |
2196
|
|
|
|
|
|
|
KeyAttr => ['key'], |
2197
|
|
|
|
|
|
|
SuppressEmpty => undef); |
2198
|
|
|
|
|
|
|
|
2199
|
|
|
|
|
|
|
In general, this will give you a hash of hashes. Any tag named 'item' |
2200
|
|
|
|
|
|
|
will be forced to point to an array reference, and any tag named "key" |
2201
|
|
|
|
|
|
|
will be flattened as described in the XML::Simple documentation. |
2202
|
|
|
|
|
|
|
|
2203
|
|
|
|
|
|
|
A simple way to examine the raw parsed XML is to invoke any |
2204
|
|
|
|
|
|
|
VM::EC2::Generic's as_string() method: |
2205
|
|
|
|
|
|
|
|
2206
|
|
|
|
|
|
|
my ($i) = $ec2->describe_instances; |
2207
|
|
|
|
|
|
|
print $i->as_string; |
2208
|
|
|
|
|
|
|
|
2209
|
|
|
|
|
|
|
This will give you a Data::Dumper representation of the XML after it |
2210
|
|
|
|
|
|
|
has been parsed. |
2211
|
|
|
|
|
|
|
|
2212
|
|
|
|
|
|
|
The suggested way to override the dispatch table is from within a |
2213
|
|
|
|
|
|
|
subclass of VM::EC2: |
2214
|
|
|
|
|
|
|
|
2215
|
|
|
|
|
|
|
package 'VM::EC2New'; |
2216
|
|
|
|
|
|
|
use base 'VM::EC2'; |
2217
|
|
|
|
|
|
|
sub new { |
2218
|
|
|
|
|
|
|
my $self=shift; |
2219
|
|
|
|
|
|
|
VM::EC2::Dispatch->register('call_name_1'=>\&subroutine1). |
2220
|
|
|
|
|
|
|
VM::EC2::Dispatch->register('call_name_2'=>\&subroutine2). |
2221
|
|
|
|
|
|
|
$self->SUPER::new(@_); |
2222
|
|
|
|
|
|
|
} |
2223
|
|
|
|
|
|
|
|
2224
|
|
|
|
|
|
|
See L for a working example of subclassing VM::EC2 |
2225
|
|
|
|
|
|
|
and one of its object classes. |
2226
|
|
|
|
|
|
|
|
2227
|
|
|
|
|
|
|
=head1 DEVELOPING |
2228
|
|
|
|
|
|
|
|
2229
|
|
|
|
|
|
|
The git source for this library can be found at https://github.com/lstein/LibVM-EC2-Perl, |
2230
|
|
|
|
|
|
|
To contribute to development, please obtain a github account and then either: |
2231
|
|
|
|
|
|
|
|
2232
|
|
|
|
|
|
|
1) Fork a copy of the repository, make your changes against this repository, |
2233
|
|
|
|
|
|
|
and send a pull request to me to incorporate your changes. |
2234
|
|
|
|
|
|
|
|
2235
|
|
|
|
|
|
|
2) Contact me by email and ask for push privileges on the repository. |
2236
|
|
|
|
|
|
|
|
2237
|
|
|
|
|
|
|
See http://help.github.com/ for help getting started. |
2238
|
|
|
|
|
|
|
|
2239
|
|
|
|
|
|
|
=head1 SEE ALSO |
2240
|
|
|
|
|
|
|
|
2241
|
|
|
|
|
|
|
L |
2242
|
|
|
|
|
|
|
L |
2243
|
|
|
|
|
|
|
L |
2244
|
|
|
|
|
|
|
L |
2245
|
|
|
|
|
|
|
L |
2246
|
|
|
|
|
|
|
L |
2247
|
|
|
|
|
|
|
L |
2248
|
|
|
|
|
|
|
L |
2249
|
|
|
|
|
|
|
L |
2250
|
|
|
|
|
|
|
L |
2251
|
|
|
|
|
|
|
L |
2252
|
|
|
|
|
|
|
L |
2253
|
|
|
|
|
|
|
L |
2254
|
|
|
|
|
|
|
L |
2255
|
|
|
|
|
|
|
L |
2256
|
|
|
|
|
|
|
L |
2257
|
|
|
|
|
|
|
L |
2258
|
|
|
|
|
|
|
L |
2259
|
|
|
|
|
|
|
L |
2260
|
|
|
|
|
|
|
L |
2261
|
|
|
|
|
|
|
L |
2262
|
|
|
|
|
|
|
L |
2263
|
|
|
|
|
|
|
L |
2264
|
|
|
|
|
|
|
L |
2265
|
|
|
|
|
|
|
L |
2266
|
|
|
|
|
|
|
L |
2267
|
|
|
|
|
|
|
L |
2268
|
|
|
|
|
|
|
L |
2269
|
|
|
|
|
|
|
L |
2270
|
|
|
|
|
|
|
L |
2271
|
|
|
|
|
|
|
L |
2272
|
|
|
|
|
|
|
|
2273
|
|
|
|
|
|
|
=head1 AUTHOR |
2274
|
|
|
|
|
|
|
|
2275
|
|
|
|
|
|
|
Lincoln Stein Elincoln.stein@gmail.comE. |
2276
|
|
|
|
|
|
|
|
2277
|
|
|
|
|
|
|
Copyright (c) 2011 Ontario Institute for Cancer Research |
2278
|
|
|
|
|
|
|
|
2279
|
|
|
|
|
|
|
This package and its accompanying libraries is free software; you can |
2280
|
|
|
|
|
|
|
redistribute it and/or modify it under the terms of the GPL (either |
2281
|
|
|
|
|
|
|
version 1, or at your option, any later version) or the Artistic |
2282
|
|
|
|
|
|
|
License 2.0. Refer to LICENSE for the full license text. In addition, |
2283
|
|
|
|
|
|
|
please see DISCLAIMER.txt for disclaimers of warranty. |
2284
|
|
|
|
|
|
|
|
2285
|
|
|
|
|
|
|
=cut |
2286
|
|
|
|
|
|
|
|
2287
|
|
|
|
|
|
|
|
2288
|
|
|
|
|
|
|
1; |