File Coverage

lib/VM/EC2.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


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   7961 use strict;
  7         45  
  7         274  
571              
572 7     7   4561 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.27';
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;