VM-EC2-1.23000755001751001751 012100273360 12303 5ustar00lsteinlstein000000000000VM-EC2-1.23/MANIFEST.SKIP000444001751001751 21512100273360 14314 0ustar00lsteinlstein000000000000^blib foo.* rename_plan\.txt ~$ ^[^/]+\.pl$ \.bak$ _SKIP$ ^\. ^_build ^MYMETA.yml$ ^Build$ \.xml$ \.dat$ ^MYMETA\.json$ \.tar.gz$ \# ^TO-FIX VM-EC2-1.23/Changes000444001751001751 1704112100273360 13756 0ustar00lsteinlstein0000000000001.23 Thu Jan 24 12:51:07 EST 2013 - migrate-ebs-image.pl now supports HVM images, including Microsoft Windows and Linux Cluster instances. 1.22 Mon Jan 7 09:43:50 EST 2013 - Allow arbitrary arguments to be passed to rsync in VM::EC2::Staging::Manager. - Add support for autoscaling groups and launch configs (Patch from Miguel Ruiz; see https://github.com/miquelruiz/LibVM-EC2-Perl). - Implement CopySnapshot API call - Take advantage of CopySnapshot API in migrate_ebs_image.pl script. - Implement placement group API calls - Update to API 2012-12-01 1.21 Tue Dec 11 11:29:57 EST 2012 - fix BadParameterValue when passing -private_ip_address to run_instances(). (thanks to Makoto Milda for bug report and patch). - Distinguish current_state() from current_status() in VM::EC2::Spot::InstanceRequest. - Report errors encountered while committing firewall rules to security groups. - URI unescape fields in VM::EC2::Instance::Metadata (not documented to be needed, but apparently so for at least some fields). - Support for retrieving IAM temporary security token from instance metadata from those instances that have an IAM role. 1.20 Wed Nov 28 07:07:10 EST 2012 - better detection of corresponding kernels when transferring images among zones (requires String::Approx). - fix staging manager pv support (patch from Misha Dragojevic) - fix broken staging volume mount command when staging server uses /dev/xvd* device names. - add progress reporting to rsync-based file transfers in staging server. - correctly transfer images with ephemeral block devices. - documentation fixes to Snapshot.pm 1.19 Tue Sep 25 21:32:02 EDT 2012 - fix Instance.pm valid_fields(): add groupSet, - fix typo in instanceLifeCycle, put in same order as docs - Add back robust ramdisk matching in staging manager (commit apparently lost during VPN patch) 1.18 Thu Sep 13 06:14:59 EDT 2012 - Lance Kinley contributed major update to support Network ACL, VPN and all Elastic Load Balancing functions. - Added status reporting when performing dd() between staging manager volumes. FEATURE ENHANCEMENTS - Add -volume_type, -iops arguments to create_volume() - Update API version to 2012-07-20 now that all provisioned IO functions appear complete - Add Network ACL functions - Add VPC VPN functions - Add all Elastic Load Balancing functions (API 2012-06-01) FIXES - References to 'iol' volume type corrected to 'io1' in EC2.pm and Volume.pm - Add missing object methods to to valid_fields() in Instance.pm - Fix minor documentation errors in Instance.pm - Add up_time() function to Instance.pm as it is used in documentation but did not exist (alias to upTime) - Fix minor documentation error in SecurityGroup.pm - Fix minor documentation error in VPC/RouteTable/Association.pm - Fix missing semicolon in VPC/Subnet.pm 1.17 Wed Sep 5 21:34:50 EDT 2012 - Add missing library files to MANIFEST. - Fixed error message reporting in migrate-ebs-image.pl to give informative messages rather than obscure "Can't use string as HASH". 1.16 Tue Aug 21 07:34:35 EDT 2012 - Added support for most VPC-related calls (VPCs, subnets, routes, network interfaces). - Added support for elastic network interfaces. - Added support for high-IOPS volumes. - Update requirements to indicate that File::Path 2.08 is needed. 1.15 Tue Aug 14 07:18:04 EDT 2012 - Allow ephemeral storage to be specified in migrate-ebs-image.pl using the -b argument. - Add -block_device_mapping option to create_image(). - Add volumeType() and iops() methods to VM::EC2::Volume. 1.14 Fri Aug 10 07:19:44 EDT 2012 - Fix bug in snapshot creation that was causing migrate-ebs-image.pl to fail on last step. - Make ascertainment of filesystem type more robust. 1.13 Mon Aug 6 10:31:42 EDT 2012 - Fix API version in perldoc DESCRIPTION. - Fix bugs that occurred when working with staging volumes that were attached to stopped server instances. - No longer assign automatic labels to new staging volumes. 1.12 Fri Aug 3 23:48:46 EDT 2012 - Tests no longer prompt for input when running under smoker. 1.11 Thu Aug 2 07:03:12 EDT 2012 - API supported updated to AWS 2012-06-15 - Add support for DescribeInstanceStatus call. - Add support for DescribeVolumeStatus, DescribeVolumeAttribute and ModifyVolumeAttribute calls. - Add support for product codes in Instance, Image and Snapshot. - Add support for enabling volume I/O on degraded volumes and auto enabling I/O. - Add support for temporary security tokens (see VM::EC2->get_federation_user()) - Add support for IAM security policies for restricting EC2 actions that federation users can perform (see VM::EC2::Security::Policy). 1.10 Sat Jul 28 15:59:41 EDT 2012 - Add new high level framework for managing servers and volumes (see VM::EC2::Staging::Manager). - Add missing documentation, including removing spot instance methods from "unsupported" list. - Document fact that VM::EC2->instance_metadata() can be called as a class method. - Add "platform" to valid_fields function in Instance.pm - Fix SignatureDoesNotMatch breakage under HTTP::Request::Common version 6.03 (see https://rt.cpan.org/Ticket/Display.html?id=75359). - Automatically base64 encode userdata passed to spot instance requests (see https://rt.cpan.org/Public/Bug/Display.html?id=77116). 1.09 Tue Oct 4 19:04:52 EDT 2011 - Fixed return value from delete_security_group(). - Added a detailed example script, bin/sync_to_snapshot.pl 1.08 - Fix broken call to VM::EC2::Snapshot->register_image(), which was failing with a message about not providing all required arguments. - Add VM::EC2::Snapshot->size() as an alias to volumeSize(). - Fix documentation formatting bugs in VM::EC2::Instance::Metadata. 1.07 Wed Sep 21 11:54:22 EDT 2011 - Add full support for spot instances. - wait_for_attachments(), wait_for_instances(), and wait_for_volumes() will now timeout after a set interval, which can be adjusted with wait_for_timeout(). 1.06 Wed Sep 14 15:53:55 EDT 2011 - Added ability to change deleteOnTerminate flag for volumes attached on instances after instance launch. Facility is provided through VM::EC2, VM::EC2::BlockDevice::Mapping, VM::EC2::Volume, and VM::EC2::BlockDevice::Attachment. - Add timeouts to VM::EC2->wait_for_*() methods so that methods won't wait forever. 1.05 Sun Sep 4 22:17:33 EDT 2011 - Add wait_for_snapshots(), wait_for_volumes(), and wait_for_attachments() methods, as well as a generic wait_for_terminal_state() method. 1.04 Wed Aug 10 15:56:36 EDT 2011 - Document -availability_zone argument to run_instances(). Was formerly misdocumented as -placement_zone. Both work now, and -zone works as well. 1.03 Tue Aug 2 16:55:15 EDT 2011 - Tests will skip rather than fail if user fails to provide Amazon credentials. 1.02 Thu Jul 28 17:23:51 EDT 2011 - Added support for filters with multiple values. - Improved subclassing documentation. 1.01 Thu Jul 28 10:32:52 EDT 2011 - Add -print_error argument to VM::EC2->new. - Support for reserved instances. - Fix test 05 to avoid leaving dangling 1 GB snapshots. 1.00 Tue Jul 26 23:07:47 EDT 2011 -Core API fully implemented 0.10 -Partial implementation of API. VM-EC2-1.23/MANIFEST000444001751001751 636612100273360 13604 0ustar00lsteinlstein000000000000bin/migrate-ebs-image.pl bin/sync_to_snapshot.pl Build.PL Changes DISCLAIMER.txt lib/VM/EC2.pm lib/VM/EC2/AvailabilityZone.pm lib/VM/EC2/BlockDevice.pm lib/VM/EC2/BlockDevice/Attachment.pm lib/VM/EC2/BlockDevice/EBS.pm lib/VM/EC2/BlockDevice/Mapping.pm lib/VM/EC2/BlockDevice/Mapping/EBS.pm lib/VM/EC2/Dispatch.pm lib/VM/EC2/ElasticAddress.pm lib/VM/EC2/ELB.pm lib/VM/EC2/ELB/BackendServerDescription.pm lib/VM/EC2/ELB/HealthCheck.pm lib/VM/EC2/ELB/InstanceState.pm lib/VM/EC2/ELB/Listener.pm lib/VM/EC2/ELB/ListenerDescription.pm lib/VM/EC2/ELB/Policies.pm lib/VM/EC2/ELB/Policies/AppCookieStickinessPolicy.pm lib/VM/EC2/ELB/Policies/LBCookieStickinessPolicy.pm lib/VM/EC2/ELB/PolicyAttribute.pm lib/VM/EC2/ELB/PolicyAttributeType.pm lib/VM/EC2/ELB/PolicyDescription.pm lib/VM/EC2/ELB/PolicyTypeDescription.pm lib/VM/EC2/Error.pm lib/VM/EC2/Generic.pm lib/VM/EC2/Group.pm lib/VM/EC2/Image.pm lib/VM/EC2/Image/LaunchPermission.pm lib/VM/EC2/Instance.pm lib/VM/EC2/Instance/ConsoleOutput.pm lib/VM/EC2/Instance/IamProfile.pm lib/VM/EC2/Instance/Metadata.pm lib/VM/EC2/Instance/MonitoringState.pm lib/VM/EC2/Instance/PasswordData.pm lib/VM/EC2/Instance/Placement.pm lib/VM/EC2/Instance/Set.pm lib/VM/EC2/Instance/State.pm lib/VM/EC2/Instance/State/Change.pm lib/VM/EC2/Instance/State/Reason.pm lib/VM/EC2/Instance/Status.pm lib/VM/EC2/Instance/Status/Details.pm lib/VM/EC2/Instance/Status/Event.pm lib/VM/EC2/Instance/StatusItem.pm lib/VM/EC2/KeyPair.pm lib/VM/EC2/NetworkInterface.pm lib/VM/EC2/NetworkInterface/Association.pm lib/VM/EC2/NetworkInterface/Attachment.pm lib/VM/EC2/NetworkInterface/PrivateIpAddress.pm lib/VM/EC2/ProductCode.pm lib/VM/EC2/Region.pm lib/VM/EC2/ReservationSet.pm lib/VM/EC2/ReservedInstance.pm lib/VM/EC2/ReservedInstance/Offering.pm lib/VM/EC2/Security/Credentials.pm lib/VM/EC2/Security/FederatedUser.pm lib/VM/EC2/Security/Policy.pm lib/VM/EC2/Security/Token.pm lib/VM/EC2/SecurityGroup.pm lib/VM/EC2/SecurityGroup/GroupPermission.pm lib/VM/EC2/SecurityGroup/IpPermission.pm lib/VM/EC2/Snapshot.pm lib/VM/EC2/Snapshot/CreateVolumePermission.pm lib/VM/EC2/Spot/DatafeedSubscription.pm lib/VM/EC2/Spot/InstanceRequest.pm lib/VM/EC2/Spot/LaunchSpecification.pm lib/VM/EC2/Spot/PriceHistory.pm lib/VM/EC2/Spot/Status.pm lib/VM/EC2/Staging/Manager.pm lib/VM/EC2/Staging/Server.pm lib/VM/EC2/Staging/Volume.pm lib/VM/EC2/Tag.pm lib/VM/EC2/Volume.pm lib/VM/EC2/Volume/Status.pm lib/VM/EC2/Volume/Status/Action.pm lib/VM/EC2/Volume/Status/Details.pm lib/VM/EC2/Volume/Status/Event.pm lib/VM/EC2/Volume/StatusItem.pm lib/VM/EC2/VPC.pm lib/VM/EC2/VPC/CustomerGateway.pm lib/VM/EC2/VPC/DhcpOptions.pm lib/VM/EC2/VPC/InternetGateway.pm lib/VM/EC2/VPC/InternetGateway/Attachment.pm lib/VM/EC2/VPC/NetworkAcl.pm lib/VM/EC2/VPC/NetworkAcl/Association.pm lib/VM/EC2/VPC/NetworkAcl/Entry.pm lib/VM/EC2/VPC/Route.pm lib/VM/EC2/VPC/RouteTable.pm lib/VM/EC2/VPC/RouteTable/Association.pm lib/VM/EC2/VPC/Subnet.pm lib/VM/EC2/VPC/VpnConnection.pm lib/VM/EC2/VPC/VpnGateway.pm lib/VM/EC2/VPC/VpnGateway/Attachment.pm lib/VM/EC2/VPC/VpnTunnelTelemetry.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.json META.yml README t/01.describe.t t/02.keypairs.t t/03.securitygroup.t t/04.volume.t t/05.spot_instance.t t/06.security_token.t t/07.instance.t t/08.staging.t t/lib/EC2TestSupport.pm VM-EC2-1.23/META.json000444001751001751 3055112100273360 14105 0ustar00lsteinlstein000000000000{ "abstract" : "Control the Amazon EC2 and Eucalyptus Clouds", "author" : [ "Lincoln Stein " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.38, CPAN::Meta::Converter version 2.112150", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "VM-EC2", "prereqs" : { "configure" : { "requires" : { "Module::Build" : 0 } }, "runtime" : { "recommends" : { "JSON" : 0 }, "requires" : { "Digest::SHA" : "5.47", "File::Path" : "2.08", "LWP" : "5.835", "MIME::Base64" : "3.08", "String::Approx" : "3.26", "URI::URL" : "5.03", "XML::Simple" : "2.18" } } }, "provides" : { "VM::EC2" : { "file" : "lib/VM/EC2.pm", "version" : "1.23" }, "VM::EC2::AvailabilityZone" : { "file" : "lib/VM/EC2/AvailabilityZone.pm", "version" : 0 }, "VM::EC2::BlockDevice" : { "file" : "lib/VM/EC2/BlockDevice.pm", "version" : 0 }, "VM::EC2::BlockDevice::Attachment" : { "file" : "lib/VM/EC2/BlockDevice/Attachment.pm", "version" : 0 }, "VM::EC2::BlockDevice::EBS" : { "file" : "lib/VM/EC2/BlockDevice/EBS.pm", "version" : 0 }, "VM::EC2::BlockDevice::Mapping" : { "file" : "lib/VM/EC2/BlockDevice/Mapping.pm", "version" : 0 }, "VM::EC2::BlockDevice::Mapping::EBS" : { "file" : "lib/VM/EC2/BlockDevice/Mapping/EBS.pm", "version" : 0 }, "VM::EC2::Dispatch" : { "file" : "lib/VM/EC2/Dispatch.pm", "version" : 0 }, "VM::EC2::ELB" : { "file" : "lib/VM/EC2/ELB.pm", "version" : 0 }, "VM::EC2::ELB::BackendServerDescription" : { "file" : "lib/VM/EC2/ELB/BackendServerDescription.pm", "version" : 0 }, "VM::EC2::ELB::HealthCheck" : { "file" : "lib/VM/EC2/ELB/HealthCheck.pm", "version" : 0 }, "VM::EC2::ELB::InstanceState" : { "file" : "lib/VM/EC2/ELB/InstanceState.pm", "version" : 0 }, "VM::EC2::ELB::Listener" : { "file" : "lib/VM/EC2/ELB/Listener.pm", "version" : 0 }, "VM::EC2::ELB::ListenerDescription" : { "file" : "lib/VM/EC2/ELB/ListenerDescription.pm", "version" : 0 }, "VM::EC2::ELB::Policies" : { "file" : "lib/VM/EC2/ELB/Policies.pm", "version" : 0 }, "VM::EC2::ELB::Policies::AppCookieStickinessPolicy" : { "file" : "lib/VM/EC2/ELB/Policies/AppCookieStickinessPolicy.pm", "version" : 0 }, "VM::EC2::ELB::Policies::LBCookieStickinessPolicy" : { "file" : "lib/VM/EC2/ELB/Policies/LBCookieStickinessPolicy.pm", "version" : 0 }, "VM::EC2::ELB::PolicyAttribute" : { "file" : "lib/VM/EC2/ELB/PolicyAttribute.pm", "version" : 0 }, "VM::EC2::ELB::PolicyAttributeType" : { "file" : "lib/VM/EC2/ELB/PolicyAttributeType.pm", "version" : 0 }, "VM::EC2::ELB::PolicyDescription" : { "file" : "lib/VM/EC2/ELB/PolicyDescription.pm", "version" : 0 }, "VM::EC2::ELB::PolicyTypeDescription" : { "file" : "lib/VM/EC2/ELB/PolicyTypeDescription.pm", "version" : 0 }, "VM::EC2::ElasticAddress" : { "file" : "lib/VM/EC2/ElasticAddress.pm", "version" : 0 }, "VM::EC2::Error" : { "file" : "lib/VM/EC2/Error.pm", "version" : 0 }, "VM::EC2::Generic" : { "file" : "lib/VM/EC2/Generic.pm", "version" : 0 }, "VM::EC2::Group" : { "file" : "lib/VM/EC2/Group.pm", "version" : 0 }, "VM::EC2::Image" : { "file" : "lib/VM/EC2/Image.pm", "version" : 0 }, "VM::EC2::Image::LaunchPermission" : { "file" : "lib/VM/EC2/Image/LaunchPermission.pm", "version" : 0 }, "VM::EC2::Instance" : { "file" : "lib/VM/EC2/Instance.pm", "version" : 0 }, "VM::EC2::Instance::ConsoleOutput" : { "file" : "lib/VM/EC2/Instance/ConsoleOutput.pm", "version" : 0 }, "VM::EC2::Instance::IamProfile" : { "file" : "lib/VM/EC2/Instance/IamProfile.pm", "version" : 0 }, "VM::EC2::Instance::Metadata" : { "file" : "lib/VM/EC2/Instance/Metadata.pm", "version" : 0 }, "VM::EC2::Instance::MonitoringState" : { "file" : "lib/VM/EC2/Instance/MonitoringState.pm", "version" : 0 }, "VM::EC2::Instance::PasswordData" : { "file" : "lib/VM/EC2/Instance/PasswordData.pm", "version" : 0 }, "VM::EC2::Instance::Placement" : { "file" : "lib/VM/EC2/Instance/Placement.pm", "version" : 0 }, "VM::EC2::Instance::Set" : { "file" : "lib/VM/EC2/Instance/Set.pm", "version" : 0 }, "VM::EC2::Instance::State" : { "file" : "lib/VM/EC2/Instance/State.pm", "version" : 0 }, "VM::EC2::Instance::State::Change" : { "file" : "lib/VM/EC2/Instance/State/Change.pm", "version" : 0 }, "VM::EC2::Instance::Status" : { "file" : "lib/VM/EC2/Instance/Status.pm", "version" : 0 }, "VM::EC2::Instance::Status::Details" : { "file" : "lib/VM/EC2/Instance/Status/Details.pm", "version" : 0 }, "VM::EC2::Instance::Status::Event" : { "file" : "lib/VM/EC2/Instance/Status/Event.pm", "version" : 0 }, "VM::EC2::Instance::StatusItem" : { "file" : "lib/VM/EC2/Instance/StatusItem.pm", "version" : 0 }, "VM::EC2::KeyPair" : { "file" : "lib/VM/EC2/KeyPair.pm", "version" : 0 }, "VM::EC2::NetworkInterface" : { "file" : "lib/VM/EC2/NetworkInterface.pm", "version" : 0 }, "VM::EC2::NetworkInterface::Association" : { "file" : "lib/VM/EC2/NetworkInterface/Association.pm", "version" : 0 }, "VM::EC2::NetworkInterface::Attachment" : { "file" : "lib/VM/EC2/NetworkInterface/Attachment.pm", "version" : 0 }, "VM::EC2::NetworkInterface::PrivateIpAddress" : { "file" : "lib/VM/EC2/NetworkInterface/PrivateIpAddress.pm", "version" : 0 }, "VM::EC2::ProductCode" : { "file" : "lib/VM/EC2/ProductCode.pm", "version" : 0 }, "VM::EC2::Region" : { "file" : "lib/VM/EC2/Region.pm", "version" : 0 }, "VM::EC2::ReservationSet" : { "file" : "lib/VM/EC2/ReservationSet.pm", "version" : 0 }, "VM::EC2::ReservedInstance" : { "file" : "lib/VM/EC2/ReservedInstance.pm", "version" : 0 }, "VM::EC2::ReservedInstance::Offering" : { "file" : "lib/VM/EC2/ReservedInstance/Offering.pm", "version" : 0 }, "VM::EC2::Security::Credentials" : { "file" : "lib/VM/EC2/Security/Credentials.pm", "version" : 0 }, "VM::EC2::Security::FederatedUser" : { "file" : "lib/VM/EC2/Security/FederatedUser.pm", "version" : 0 }, "VM::EC2::Security::Policy" : { "file" : "lib/VM/EC2/Security/Policy.pm", "version" : 0 }, "VM::EC2::Security::Token" : { "file" : "lib/VM/EC2/Security/Token.pm", "version" : 0 }, "VM::EC2::SecurityGroup" : { "file" : "lib/VM/EC2/SecurityGroup.pm", "version" : 0 }, "VM::EC2::SecurityGroup::GroupPermission" : { "file" : "lib/VM/EC2/SecurityGroup/GroupPermission.pm", "version" : 0 }, "VM::EC2::SecurityGroup::IpPermission" : { "file" : "lib/VM/EC2/SecurityGroup/IpPermission.pm", "version" : 0 }, "VM::EC2::Snapshot" : { "file" : "lib/VM/EC2/Snapshot.pm", "version" : 0 }, "VM::EC2::Snapshot::CreateVolumePermission" : { "file" : "lib/VM/EC2/Snapshot/CreateVolumePermission.pm", "version" : 0 }, "VM::EC2::Spot::DatafeedSubscription" : { "file" : "lib/VM/EC2/Spot/DatafeedSubscription.pm", "version" : 0 }, "VM::EC2::Spot::InstanceRequest" : { "file" : "lib/VM/EC2/Spot/InstanceRequest.pm", "version" : 0 }, "VM::EC2::Spot::LaunchSpecification" : { "file" : "lib/VM/EC2/Spot/LaunchSpecification.pm", "version" : 0 }, "VM::EC2::Spot::PriceHistory" : { "file" : "lib/VM/EC2/Spot/PriceHistory.pm", "version" : 0 }, "VM::EC2::Spot::Status" : { "file" : "lib/VM/EC2/Spot/Status.pm", "version" : 0 }, "VM::EC2::Staging::Manager" : { "file" : "lib/VM/EC2/Staging/Manager.pm", "version" : 0 }, "VM::EC2::Staging::Server" : { "file" : "lib/VM/EC2/Staging/Server.pm", "version" : 0 }, "VM::EC2::Staging::Volume" : { "file" : "lib/VM/EC2/Staging/Volume.pm", "version" : 0 }, "VM::EC2::State::Reason" : { "file" : "lib/VM/EC2/Instance/State/Reason.pm", "version" : 0 }, "VM::EC2::Tag" : { "file" : "lib/VM/EC2/Tag.pm", "version" : 0 }, "VM::EC2::VPC" : { "file" : "lib/VM/EC2/VPC.pm", "version" : 0 }, "VM::EC2::VPC::CustomerGateway" : { "file" : "lib/VM/EC2/VPC/CustomerGateway.pm", "version" : 0 }, "VM::EC2::VPC::DhcpOptions" : { "file" : "lib/VM/EC2/VPC/DhcpOptions.pm", "version" : 0 }, "VM::EC2::VPC::InternetGateway" : { "file" : "lib/VM/EC2/VPC/InternetGateway.pm", "version" : 0 }, "VM::EC2::VPC::InternetGateway::Attachment" : { "file" : "lib/VM/EC2/VPC/InternetGateway/Attachment.pm", "version" : 0 }, "VM::EC2::VPC::NetworkAcl" : { "file" : "lib/VM/EC2/VPC/NetworkAcl.pm", "version" : 0 }, "VM::EC2::VPC::NetworkAcl::Association" : { "file" : "lib/VM/EC2/VPC/NetworkAcl/Association.pm", "version" : 0 }, "VM::EC2::VPC::NetworkAcl::Entry" : { "file" : "lib/VM/EC2/VPC/NetworkAcl/Entry.pm", "version" : 0 }, "VM::EC2::VPC::Route" : { "file" : "lib/VM/EC2/VPC/Route.pm", "version" : 0 }, "VM::EC2::VPC::RouteTable" : { "file" : "lib/VM/EC2/VPC/RouteTable.pm", "version" : 0 }, "VM::EC2::VPC::RouteTable::Association" : { "file" : "lib/VM/EC2/VPC/RouteTable/Association.pm", "version" : 0 }, "VM::EC2::VPC::Subnet" : { "file" : "lib/VM/EC2/VPC/Subnet.pm", "version" : 0 }, "VM::EC2::VPC::VpnConnection" : { "file" : "lib/VM/EC2/VPC/VpnConnection.pm", "version" : 0 }, "VM::EC2::VPC::VpnGateway" : { "file" : "lib/VM/EC2/VPC/VpnGateway.pm", "version" : 0 }, "VM::EC2::VPC::VpnGateway::Attachment" : { "file" : "lib/VM/EC2/VPC/VpnGateway/Attachment.pm", "version" : 0 }, "VM::EC2::VPC::VpnTunnelTelemetry" : { "file" : "lib/VM/EC2/VPC/VpnTunnelTelemetry.pm", "version" : 0 }, "VM::EC2::Volume" : { "file" : "lib/VM/EC2/Volume.pm", "version" : 0 }, "VM::EC2::Volume::Status" : { "file" : "lib/VM/EC2/Volume/Status.pm", "version" : 0 }, "VM::EC2::Volume::Status::Action" : { "file" : "lib/VM/EC2/Volume/Status/Action.pm", "version" : 0 }, "VM::EC2::Volume::Status::Details" : { "file" : "lib/VM/EC2/Volume/Status/Details.pm", "version" : 0 }, "VM::EC2::Volume::Status::Event" : { "file" : "lib/VM/EC2/Volume/Status/Event.pm", "version" : 0 }, "VM::EC2::Volume::StatusItem" : { "file" : "lib/VM/EC2/Volume/StatusItem.pm", "version" : 0 } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "1.23" } VM-EC2-1.23/README000444001751001751 663212100273360 13327 0ustar00lsteinlstein000000000000This is an interface to Amazon EC2 REST tools that follows the 2012-12-01 API. I created it because I needed access to the Tag and TagSet interfaces, and neither euca2ools nor Net::Amazon::EC2 provided this functionality. Almost all of the Amazon API is supported, but API calls for VM/volume import, bundle task management, reserved instance marketplace, and cluster placement groups are not currently implemented. The module provides an extensible object-oriented interface as illustrated by the following code: # get new EC2 object my $ec2 = VM::EC2->new(-access_key => 'access key id', -secret_key => 'aws_secret_key', -endpoint => 'http://ec2.amazonaws.com'); # fetch an image by its ID my $image = $ec2->describe_images('ami-12345'); # get some information about the image my $architecture = $image->architecture; my $description = $image->description; my @devices = $image->blockDeviceMapping; for my $d (@devices) { print $d->deviceName,"\n"; print $d->snapshotId,"\n"; print $d->volumeSize,"\n"; } # run two instances my @instances = $image->run_instances(-key_name =>'My_key', -security_group=>'default', -min_count =>2, -instance_type => 't1.micro') or die $ec2->error_str; # wait for both instances to reach "running" or other terminal state $ec2->wait_for_instances(@instances); # print out both instance's current state and DNS name for my $i (@instances) { my $status = $i->current_status; my $dns = $i->dnsName; print "$i: [$status] $dns\n"; } # tag both instances with Role "server" foreach (@instances) {$_->add_tag(Role=>'server'); # stop both instances foreach (@instances) {$_->stop} $ec2->wait_for_instances(@instances); # wait till they stop # create an image from both instance, tag them, and make them public for my $i (@instances) { my $img = $i->create_image("Autoimage from $i","Test image"); $img->add_tags(Name => "Autoimage from $i", Role => 'Server', Status=> 'Production'); $img->make_public(1); } Copying AMIs Between Regions ---------------------------- This library provides a command-line script that makes it easy to move an EBS-backed Amazon Machine Image (AMI) from one region to another. migrate-ebs-image.pl --from us-east-1 --to ap-southeast-1 ami-123456 This script will be installed for you when you install the library. Development and bug reports --------------------------- This module is supported using GitHub at https://github.com/lstein/LibVM-EC2-Perl. To report a bug please open the Issues tag and file a bug report using the "New Issue" button. To contribute to development of this module, please obtain a github account for yourself and then either: 1) Fork a copy of the repository, make your changes against this repository, and send a pull request to me to incorporate your changes. 2) Contact me by email and ask for push privileges on the repository. See http://help.github.com/ for help getting started. Credits ------- Many thanks to Lance Kinley, who contributed support for Network ACLs, VPC VPNs, Elastic Load Balancing, and many smaller feature enhancements as well as bug and documentation fixes. Author ------ Lincoln D. Stein 13 September 2012 VM-EC2-1.23/DISCLAIMER.txt000444001751001751 220312100273360 14612 0ustar00lsteinlstein000000000000The VM::EC2 package and all associated files are Copyright (c) 2011-2012 Ontario Institute for Cancer Research (OICR). This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See the Artistic License file in the main Perl distribution for specific terms and conditions of use. In addition, the following disclaimers apply: OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT. By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE. If publications result from research using this SOFTWARE, we ask that OICR be acknowledged and/or credit be given to OICR scientists, as scientifically appropriate. VM-EC2-1.23/Makefile.PL000444001751001751 226312100273360 14415 0ustar00lsteinlstein000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.3800 unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; Module::Build::Compat->run_build_pl(args => \@ARGV); my $build_script = 'Build'; $build_script .= '.com' if $^O eq 'VMS'; exit(0) unless(-e $build_script); # cpantesters convention require Module::Build; Module::Build::Compat->write_makefile(build_class => 'Module::Build'); VM-EC2-1.23/META.yml000444001751001751 2112512100273360 13732 0ustar00lsteinlstein000000000000--- abstract: 'Control the Amazon EC2 and Eucalyptus Clouds' author: - 'Lincoln Stein ' build_requires: {} configure_requires: Module::Build: 0 dynamic_config: 1 generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.112150' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: VM-EC2 provides: VM::EC2: file: lib/VM/EC2.pm version: 1.23 VM::EC2::AvailabilityZone: file: lib/VM/EC2/AvailabilityZone.pm version: 0 VM::EC2::BlockDevice: file: lib/VM/EC2/BlockDevice.pm version: 0 VM::EC2::BlockDevice::Attachment: file: lib/VM/EC2/BlockDevice/Attachment.pm version: 0 VM::EC2::BlockDevice::EBS: file: lib/VM/EC2/BlockDevice/EBS.pm version: 0 VM::EC2::BlockDevice::Mapping: file: lib/VM/EC2/BlockDevice/Mapping.pm version: 0 VM::EC2::BlockDevice::Mapping::EBS: file: lib/VM/EC2/BlockDevice/Mapping/EBS.pm version: 0 VM::EC2::Dispatch: file: lib/VM/EC2/Dispatch.pm version: 0 VM::EC2::ELB: file: lib/VM/EC2/ELB.pm version: 0 VM::EC2::ELB::BackendServerDescription: file: lib/VM/EC2/ELB/BackendServerDescription.pm version: 0 VM::EC2::ELB::HealthCheck: file: lib/VM/EC2/ELB/HealthCheck.pm version: 0 VM::EC2::ELB::InstanceState: file: lib/VM/EC2/ELB/InstanceState.pm version: 0 VM::EC2::ELB::Listener: file: lib/VM/EC2/ELB/Listener.pm version: 0 VM::EC2::ELB::ListenerDescription: file: lib/VM/EC2/ELB/ListenerDescription.pm version: 0 VM::EC2::ELB::Policies: file: lib/VM/EC2/ELB/Policies.pm version: 0 VM::EC2::ELB::Policies::AppCookieStickinessPolicy: file: lib/VM/EC2/ELB/Policies/AppCookieStickinessPolicy.pm version: 0 VM::EC2::ELB::Policies::LBCookieStickinessPolicy: file: lib/VM/EC2/ELB/Policies/LBCookieStickinessPolicy.pm version: 0 VM::EC2::ELB::PolicyAttribute: file: lib/VM/EC2/ELB/PolicyAttribute.pm version: 0 VM::EC2::ELB::PolicyAttributeType: file: lib/VM/EC2/ELB/PolicyAttributeType.pm version: 0 VM::EC2::ELB::PolicyDescription: file: lib/VM/EC2/ELB/PolicyDescription.pm version: 0 VM::EC2::ELB::PolicyTypeDescription: file: lib/VM/EC2/ELB/PolicyTypeDescription.pm version: 0 VM::EC2::ElasticAddress: file: lib/VM/EC2/ElasticAddress.pm version: 0 VM::EC2::Error: file: lib/VM/EC2/Error.pm version: 0 VM::EC2::Generic: file: lib/VM/EC2/Generic.pm version: 0 VM::EC2::Group: file: lib/VM/EC2/Group.pm version: 0 VM::EC2::Image: file: lib/VM/EC2/Image.pm version: 0 VM::EC2::Image::LaunchPermission: file: lib/VM/EC2/Image/LaunchPermission.pm version: 0 VM::EC2::Instance: file: lib/VM/EC2/Instance.pm version: 0 VM::EC2::Instance::ConsoleOutput: file: lib/VM/EC2/Instance/ConsoleOutput.pm version: 0 VM::EC2::Instance::IamProfile: file: lib/VM/EC2/Instance/IamProfile.pm version: 0 VM::EC2::Instance::Metadata: file: lib/VM/EC2/Instance/Metadata.pm version: 0 VM::EC2::Instance::MonitoringState: file: lib/VM/EC2/Instance/MonitoringState.pm version: 0 VM::EC2::Instance::PasswordData: file: lib/VM/EC2/Instance/PasswordData.pm version: 0 VM::EC2::Instance::Placement: file: lib/VM/EC2/Instance/Placement.pm version: 0 VM::EC2::Instance::Set: file: lib/VM/EC2/Instance/Set.pm version: 0 VM::EC2::Instance::State: file: lib/VM/EC2/Instance/State.pm version: 0 VM::EC2::Instance::State::Change: file: lib/VM/EC2/Instance/State/Change.pm version: 0 VM::EC2::Instance::Status: file: lib/VM/EC2/Instance/Status.pm version: 0 VM::EC2::Instance::Status::Details: file: lib/VM/EC2/Instance/Status/Details.pm version: 0 VM::EC2::Instance::Status::Event: file: lib/VM/EC2/Instance/Status/Event.pm version: 0 VM::EC2::Instance::StatusItem: file: lib/VM/EC2/Instance/StatusItem.pm version: 0 VM::EC2::KeyPair: file: lib/VM/EC2/KeyPair.pm version: 0 VM::EC2::NetworkInterface: file: lib/VM/EC2/NetworkInterface.pm version: 0 VM::EC2::NetworkInterface::Association: file: lib/VM/EC2/NetworkInterface/Association.pm version: 0 VM::EC2::NetworkInterface::Attachment: file: lib/VM/EC2/NetworkInterface/Attachment.pm version: 0 VM::EC2::NetworkInterface::PrivateIpAddress: file: lib/VM/EC2/NetworkInterface/PrivateIpAddress.pm version: 0 VM::EC2::ProductCode: file: lib/VM/EC2/ProductCode.pm version: 0 VM::EC2::Region: file: lib/VM/EC2/Region.pm version: 0 VM::EC2::ReservationSet: file: lib/VM/EC2/ReservationSet.pm version: 0 VM::EC2::ReservedInstance: file: lib/VM/EC2/ReservedInstance.pm version: 0 VM::EC2::ReservedInstance::Offering: file: lib/VM/EC2/ReservedInstance/Offering.pm version: 0 VM::EC2::Security::Credentials: file: lib/VM/EC2/Security/Credentials.pm version: 0 VM::EC2::Security::FederatedUser: file: lib/VM/EC2/Security/FederatedUser.pm version: 0 VM::EC2::Security::Policy: file: lib/VM/EC2/Security/Policy.pm version: 0 VM::EC2::Security::Token: file: lib/VM/EC2/Security/Token.pm version: 0 VM::EC2::SecurityGroup: file: lib/VM/EC2/SecurityGroup.pm version: 0 VM::EC2::SecurityGroup::GroupPermission: file: lib/VM/EC2/SecurityGroup/GroupPermission.pm version: 0 VM::EC2::SecurityGroup::IpPermission: file: lib/VM/EC2/SecurityGroup/IpPermission.pm version: 0 VM::EC2::Snapshot: file: lib/VM/EC2/Snapshot.pm version: 0 VM::EC2::Snapshot::CreateVolumePermission: file: lib/VM/EC2/Snapshot/CreateVolumePermission.pm version: 0 VM::EC2::Spot::DatafeedSubscription: file: lib/VM/EC2/Spot/DatafeedSubscription.pm version: 0 VM::EC2::Spot::InstanceRequest: file: lib/VM/EC2/Spot/InstanceRequest.pm version: 0 VM::EC2::Spot::LaunchSpecification: file: lib/VM/EC2/Spot/LaunchSpecification.pm version: 0 VM::EC2::Spot::PriceHistory: file: lib/VM/EC2/Spot/PriceHistory.pm version: 0 VM::EC2::Spot::Status: file: lib/VM/EC2/Spot/Status.pm version: 0 VM::EC2::Staging::Manager: file: lib/VM/EC2/Staging/Manager.pm version: 0 VM::EC2::Staging::Server: file: lib/VM/EC2/Staging/Server.pm version: 0 VM::EC2::Staging::Volume: file: lib/VM/EC2/Staging/Volume.pm version: 0 VM::EC2::State::Reason: file: lib/VM/EC2/Instance/State/Reason.pm version: 0 VM::EC2::Tag: file: lib/VM/EC2/Tag.pm version: 0 VM::EC2::VPC: file: lib/VM/EC2/VPC.pm version: 0 VM::EC2::VPC::CustomerGateway: file: lib/VM/EC2/VPC/CustomerGateway.pm version: 0 VM::EC2::VPC::DhcpOptions: file: lib/VM/EC2/VPC/DhcpOptions.pm version: 0 VM::EC2::VPC::InternetGateway: file: lib/VM/EC2/VPC/InternetGateway.pm version: 0 VM::EC2::VPC::InternetGateway::Attachment: file: lib/VM/EC2/VPC/InternetGateway/Attachment.pm version: 0 VM::EC2::VPC::NetworkAcl: file: lib/VM/EC2/VPC/NetworkAcl.pm version: 0 VM::EC2::VPC::NetworkAcl::Association: file: lib/VM/EC2/VPC/NetworkAcl/Association.pm version: 0 VM::EC2::VPC::NetworkAcl::Entry: file: lib/VM/EC2/VPC/NetworkAcl/Entry.pm version: 0 VM::EC2::VPC::Route: file: lib/VM/EC2/VPC/Route.pm version: 0 VM::EC2::VPC::RouteTable: file: lib/VM/EC2/VPC/RouteTable.pm version: 0 VM::EC2::VPC::RouteTable::Association: file: lib/VM/EC2/VPC/RouteTable/Association.pm version: 0 VM::EC2::VPC::Subnet: file: lib/VM/EC2/VPC/Subnet.pm version: 0 VM::EC2::VPC::VpnConnection: file: lib/VM/EC2/VPC/VpnConnection.pm version: 0 VM::EC2::VPC::VpnGateway: file: lib/VM/EC2/VPC/VpnGateway.pm version: 0 VM::EC2::VPC::VpnGateway::Attachment: file: lib/VM/EC2/VPC/VpnGateway/Attachment.pm version: 0 VM::EC2::VPC::VpnTunnelTelemetry: file: lib/VM/EC2/VPC/VpnTunnelTelemetry.pm version: 0 VM::EC2::Volume: file: lib/VM/EC2/Volume.pm version: 0 VM::EC2::Volume::Status: file: lib/VM/EC2/Volume/Status.pm version: 0 VM::EC2::Volume::Status::Action: file: lib/VM/EC2/Volume/Status/Action.pm version: 0 VM::EC2::Volume::Status::Details: file: lib/VM/EC2/Volume/Status/Details.pm version: 0 VM::EC2::Volume::Status::Event: file: lib/VM/EC2/Volume/Status/Event.pm version: 0 VM::EC2::Volume::StatusItem: file: lib/VM/EC2/Volume/StatusItem.pm version: 0 recommends: JSON: 0 requires: Digest::SHA: 5.47 File::Path: 2.08 LWP: 5.835 MIME::Base64: 3.08 String::Approx: 3.26 URI::URL: 5.03 XML::Simple: 2.18 resources: license: http://dev.perl.org/licenses/ version: 1.23 VM-EC2-1.23/Build.PL000444001751001751 131612100273360 13735 0ustar00lsteinlstein000000000000#!/usr/bin/perl use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'VM-EC2', license => 'perl', dist_version_from => 'lib/VM/EC2.pm', dist_author => 'Lincoln Stein ', configure_requires => { 'Module::Build' => 0 }, requires => { 'LWP' => 5.835, 'MIME::Base64' => '3.08', 'Digest::SHA' => '5.47', 'URI::URL' => '5.03', 'XML::Simple' => '2.18', 'File::Path' => '2.08', 'String::Approx' => '3.26', }, recommends => { 'JSON' => 0, }, build_class => 'Module::Build', ); $build->create_build_script; exit 0; VM-EC2-1.23/LICENSE000444001751001751 5660112100273360 13475 0ustar00lsteinlstein000000000000a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License 2.0" ---------------------------------------------------------------------------- The General Public License (GPL) Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS ---------------------------------------------------------------------------- Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. VM-EC2-1.23/bin000755001751001751 012100273360 13053 5ustar00lsteinlstein000000000000VM-EC2-1.23/bin/migrate-ebs-image.pl000555001751001751 1440312100273360 17051 0ustar00lsteinlstein000000000000#!/usr/bin/perl =head1 NAME migrate-ebs-image.pl Copy an EBS-backed Amazon Image from one region to another =head1 SYNOPSYS % migrate-ebs-image.pl --from us-east-1 --to ap-southeast-1 ami-123456 =head1 DESCRIPTION This script copies an EBS-backed Unix/Linux/windows AMI located in the EC2 region indicated by --from to the region indicated by --to. All associated volume snapshots, including LVM and RAID volumes, are migrated as well. If --from is omitted, then the source region is derived from the endpoint URL contained in the EC2_URL environment variable. The --to option is required. This script works with any EBS backed image, including Linux PVM, Linux HVM (cluster) and Windows images. It will B work with any instance-store backed image. To migrate such instances, please see one of the recipes listed online, for example: http://www.dowdandassociates.com/content/howto-move-ec2-instance-store-ami-one-region-another =head1 COMMAND-LINE OPTIONS Options can be abbreviated. For example, you can use -l for --list-regions and -b for --block-device-mapping: --from Region in which the AMI is currently located (e.g. "us-east-1") --to Region to which the AMI is to be copied (e.g. "us-west-1") REQUIRED --access_key EC2 access key --secret_key EC2 secret key --block_device_mapping Add additional block devices to the image. --endpoint EC2 URL (defaults to http://ec2.amazonaws.com/) --kernel Force assignment of kernel in destination image. --ramdisk Force assignment of ramdisk in destination image. --quiet Quench status messages --list_regions List the EC2 regions The --block-device-mapping (-b) option is used to add ephemeral storage to the destination image. Amazon's API doesn't describe ephemeral volumes that are associated with images, and so this information is not copied from the source to the destination image, requiring you to add it back manually. The value of the argument is a block device mapping string in the same format as described for the command line program ec2-register: migrate-ebs-image.pl -f us-east-1 -t ap-southeast-1 \ -b /dev/sdy=ephemeral0 \ ami-123456 Ordinarily the script attempts to guess the correct matching kernel and ramdisk for the destination image based on approximate string matching. You can override these values by manually specifying the kernel and/or ramdisk ID in the destination region. Note that no checking is performed that the values you provide are correct. =head1 ENVIRONMENT VARIABLES The following environment variables are used if the corresponding options are not present: EC2_ACCESS_KEY your access key EC2_SECRET_KEY your secret key EC2_URL the desired region endpoint =head1 INSTALLING THIS SCRIPT This script is part of the Perl VM::EC2 package. To install from the command line: % perl -MCPAN -e 'install VM::EC2' % migrate-ebs-image.pl --from us-east-1 --to ap-southeast-1 ami-123456 =head1 IMPORTANT CAVEATS This script launches two "m1.small" instances, one each in the source and destination regions. It also creates transient volumes in both regions to hold the root volume and all other EBS snapshots associated with the image. Running it will incur charges for instance run time and data storage. In addition, this script will transfer data from one region to another across the internet, incurring internet data out fees on the source side, and internet data in fees on the destination side. Volumes that contain a filesystem, such as ext4 or ntfs, are copied from source to destination using rsync. Volumes that are part of a RAID or LVM volume are copied at the block level using gzip and dd via the secure shell. In general, rsync will be much faster and parsimonious of network bandwidth than block copying! =head1 SEE ALSO L, L =head1 AUTHOR Lincoln Stein, lincoln.stein@gmail.com Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use lib '../lib'; use VM::EC2::Staging::Manager; use File::Basename 'basename'; use Getopt::Long; my($From,$To,$Access_key,$Secret_key,$Endpoint,$Quiet,$List,$Kernel,$Ramdisk,@Block_devices); my $Program_name = basename($0); GetOptions('from=s' => \$From, 'to=s' => \$To, 'access_key|access-key=s' => \$Access_key, 'secret_key|secret-key=s' => \$Secret_key, 'endpoint=s' => \$Endpoint, 'quiet' => \$Quiet, 'list_regions|list-regions' => \$List, 'block_device_mapping|block-device-mapping=s' => \@Block_devices, 'kernel' => \$Kernel, 'ramdisk' => \$Ramdisk, ) or exec 'perldoc',$0; #setup defaults $ENV{EC2_ACCESS_KEY} = $Access_key if defined $Access_key; $ENV{EC2_SECRET_KEY} = $Secret_key if defined $Secret_key; $ENV{EC2_URL} = $Endpoint if defined $Endpoint; $Quiet ||= 0; my $ec2 = VM::EC2->new(); if ($List) { print join("\n",sort $ec2->describe_regions),"\n"; exit 0; } my $ami = shift or exec 'perldoc',$0; $To or exec 'perldoc',$0; $From ||= $ec2->region; unless ($From) { my $endpoint = $ec2->endpoint; ($From) = grep {$_->endpoint eq $ec2->endpoint} $ec2->describe_regions; } my $source = eval {VM::EC2->new(-region => $From)->staging_manager(-on_exit=>'terminate', -quiet => $Quiet)} or die $@; my $dest = eval {VM::EC2->new(-region => $To)->staging_manager(-on_exit=>'terminate', -quiet => $Quiet)} or die $@; my @extra = @Block_devices ? (-block_devices=>\@Block_devices) : (); push @extra,(-kernel_id => $Kernel) if $Kernel; push @extra,(-ramdisk_id => $Ramdisk) if $Ramdisk; my $img = $source->copy_image($ami => $dest,@extra); undef $source; undef $dest; print "New snapshot is now located in $To under $img.\n"; exit 0; VM-EC2-1.23/bin/sync_to_snapshot.pl000555001751001751 2304412100273360 17170 0ustar00lsteinlstein000000000000#!/usr/bin/perl # An example of creating a data snapshots # Steps: # 1. Provision a new server. # 2. Create new data volume, attach and mount it. # 3. Rsync the indicated data over # 4. Unmount the volume, detach it. # 5. Save the snapshot. # 6. Delete the volume # 7. Terminate the server. use strict; use VM::EC2; use Getopt::Long; use File::Find; use File::Basename 'basename'; use constant GB => 1_073_741_824; $SIG{INT}=$SIG{TERM}= sub {cleanup(); exit 0}; my $Program_name = basename($0); $Program_name =~ s/\.pl$//; my($Snapshot_name,$Filesystem,$Image,$Type,$Username,$Access_key,$Secret_key); GetOptions('snapshot=s' => \$Snapshot_name, 'filesystem=s' => \$Filesystem, 'image=s' => \$Image, 'username=s' => \$Username, 'type=s' => \$Type, 'access_key=s' => \$Access_key, 'secret_key=s' => \$Secret_key) or die <new() or die "Can't create new VM::EC2"; # find how large a volume we'll need. print STDERR "Calculating needed size of staging volume...\n"; my $bytes_needed = 0; find(sub {$bytes_needed += -s $_},@locations); # add 15% overhead for filesystem $bytes_needed *= 1.15; # and convert to GB my $gb = int(0.5+$bytes_needed/GB); $gb = 1 if $gb < 1; die "Required volume exceeds EC2 1TB limit" if $gb > 1024; # Provision the volume print STDERR "Provisioning a $gb GB volume...\n"; my($volume,$needs_mkfs,$needs_resize) = provision_volume($gb,$Snapshot_name); $Volume = $volume; # Create a temporary key for ssh'ing print STDERR "Creating a temporary ssh key...\n"; my $keypairname = "${Program_name}_$$"; $KeyFile = File::Spec->catfile(File::Spec->tmpdir,"$keypairname.pem"); $KeyPair = $ec2->create_key_pair($keypairname); my $private_key = $KeyPair->privateKey; open my $k,'>',$KeyFile or die "Couldn't create $KeyFile: $!"; chmod 0600,$KeyFile or die "Couldn't chmod $KeyFile: $!"; print $k $private_key; close $k; # Create a temporary security group for ssh'ing print STDERR "Creating a temporary security group with ssh enabled...\n"; $Group = $ec2->create_security_group(-name => "${Program_name}_$$", -description => "Temporary security group created by $Program_name" ) or die $ec2->error_str; $Group->authorize_incoming(-protocol => 'tcp', -port => 'ssh'); $Group->update or die $ec2->error_str; # Provision an instance in the same availability zone print STDERR "Provisioning staging instance...\n"; my $zone = $Volume->availabilityZone; $Instance = $ec2->run_instances(-image_id => $Image, -zone => $zone, -key_name => $KeyPair, -instance_type => $Type, -security_group_id => $Group) or die $ec2->error_str; $Instance->add_tag(Name => "Staging instance for snapshot $Snapshot_name created by $Program_name"); # wait until the instance is running and the ssh daemon is responding... print STDERR "Waiting for instance to come up. This may take a while...\n"; $ec2->wait_for_instances($Instance); $Instance->current_status eq 'running' or die "Instance $Instance, status = ",$Instance->current_status; wait_for_ssh_daemon(); # we may die on this step my $device = eval{unused_device()} or die "Couldn't find suitable device to attach"; # attach and initialize volume print STDERR "Attaching staging volume...\n"; my $s = $Instance->attach_volume($Volume=>$device) or die "Couldn't attach $Volume to $Instance via $device"; $ec2->wait_for_attachments($s) or die "Couldn't attach $Volume to $Instance via $device"; $s->current_status eq 'attached' or die "Couldn't attach $Volume to $Instance via $device"; if ($needs_resize) { die "Sorry, but can only resize ext volumes " unless $Filesystem =~ /^ext/; print STDERR "Resizing previously-snapshotted volume to $gb GB...\n"; ssh("sudo /sbin/resize2fs $device"); } elsif ($needs_mkfs) { print STDERR "Making $Filesystem filesystem on staging volume...\n"; ssh("sudo /sbin/mkfs.$Filesystem $device"); } # do the rsync print STDERR "Mounting staging volume...\n"; ssh("sudo mkdir -p /mnt/transfer; sudo mount $device /mnt/transfer; sudo chown $Username /mnt/transfer"); print STDERR "Beginning rsync...\n"; my $Host = $Instance->dnsName; system "rsync -Ravz -e'ssh -o \"StrictHostKeyChecking no\" -i $KeyFile -l $Username' @locations $Host:/mnt/transfer"; ssh('sudo umount /mnt/transfer'); $Instance->detach_volume($Volume); # snapshot stuff my $version = 1; if (my $snap = $Volume->from_snapshot) { $version = $snap->tags->{Version} || 0; $version++; } print STDERR "Creating snapshot $Snapshot_name version $version...\n"; my $snap = $Volume->create_snapshot($Snapshot_name); $snap->add_tags(Version => $version); $snap->add_tags(Name => $Snapshot_name); print "Created snap $snap\n"; }; warn $@ if $@; cleanup(); exit 0; sub ssh { my @cmd = @_; $Instance or die "Remote instance not set up correctly"; my $host = $Instance->dnsName; my $pid = open my $kid,"-|"; #this does a fork die "Couldn't fork: $!" unless defined $pid; if ($pid) { my @results; while (<$kid>) { push @results,$_; } close $kid; die "ssh failed with status ",$?>>8 unless $?==0; if (wantarray) { chomp(@results); return @results; } else { return join '',@results; } } # in child exec '/usr/bin/ssh','-o','CheckHostIP no','-o','StrictHostKeyChecking no','-i',$KeyFile,'-l',$Username,$host,@cmd; } sub unused_device { my %devices = map {$_=>1} ssh('ls /dev/*d[a-z][0-9]*'); my $base = $devices{'/dev/sda1'} ? '/dev/sd' :$devices{'/dev/xvda1'} ? '/dev/xvd' :die "can't figure out whether to use /dev/sd or /dev/xvd"; for my $major ('f'..'p') { for my $minor (1..15) { my $candidate = $base.$major.$minor; return $candidate unless $devices{$candidate}; } } } sub provision_volume { my ($size,$snapshot_name) = @_; my @zones = $ec2->describe_availability_zones({state=>'available'}); my $zone = $zones[rand @zones]; my @snaps = sort {$b->startTime cmp $a->startTime} $ec2->describe_snapshots(-owner => $ec2->account_id, -filter => {description=>$snapshot_name}); my ($vol,$needs_mkfs,$needs_resize); if (@snaps) { my $snap = $snaps[0]; print STDERR "Reusing existing snapshot $snap...\n"; my $s = $size > $snap->volumeSize ? $size : $snap->volumeSize; $vol = $snap->create_volume(-availability_zone=>$zone, -size => $s); $needs_resize = $snap->volumeSize < $s; } else { $vol = $ec2->create_volume(-availability_zone=>$zone, -size =>$size); $needs_mkfs++; } return unless $vol; $vol->add_tag(Name=>"Staging volume for snapshot $snapshot_name created by $Program_name"); return ($vol,$needs_mkfs,$needs_resize); } sub wait_for_ssh_daemon { open SAVERR,">&STDERR"; open STDERR,">/dev/null"; # inhibit error messages temporarily eval { local $SIG{ALRM} = sub {die 'timeout'}; alarm(60); # do not wait more than one minute while (!eval{ssh('echo running')}) {sleep 2; } alarm(0); }; open STDERR,">&SAVERR"; if ($@ =~ /timeout/) { die "Timed out while waiting for ssh daemon to come up"; } } sub cleanup { return unless $ec2; print STDERR "Deleting temporary keypair...\n"; $ec2->delete_key_pair($KeyPair) if $KeyPair; unlink $KeyFile if -e $KeyFile; print STDERR "Deleting staging volume...\n"; $ec2->delete_volume($Volume) if $Volume; print STDERR "Terminating staging instance...\n"; $Instance->terminate() if $Instance; if ($Group) { print STDERR "Waiting for staging instance to terminate...\n"; $ec2->wait_for_instances($Instance); print STDERR "Deleting temporary security group...\n"; $ec2->delete_security_group($Group); } undef $KeyPair; undef $Instance; undef $Volume; undef $KeyFile; undef $Group; } END { cleanup(); } VM-EC2-1.23/lib000755001751001751 012100273360 13051 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM000755001751001751 012100273360 13373 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2.pm000444001751001751 104577512100273360 14542 0ustar00lsteinlstein000000000000package VM::EC2; =head1 NAME VM::EC2 - Control the Amazon EC2 and Eucalyptus Clouds =head1 SYNOPSIS # set environment variables EC2_ACCESS_KEY, EC2_SECRET_KEY and/or EC2_URL # to fill in arguments automatically ## IMAGE AND INSTANCE MANAGEMENT # get new EC2 object my $ec2 = VM::EC2->new(-access_key => 'access key id', -secret_key => 'aws_secret_key', -endpoint => 'http://ec2.amazonaws.com'); # fetch an image by its ID my $image = $ec2->describe_images('ami-12345'); # get some information about the image my $architecture = $image->architecture; my $description = $image->description; my @devices = $image->blockDeviceMapping; for my $d (@devices) { print $d->deviceName,"\n"; print $d->snapshotId,"\n"; print $d->volumeSize,"\n"; } # run two instances my @instances = $image->run_instances(-key_name =>'My_key', -security_group=>'default', -min_count =>2, -instance_type => 't1.micro') or die $ec2->error_str; # wait for both instances to reach "running" or other terminal state $ec2->wait_for_instances(@instances); # print out both instance's current state and DNS name for my $i (@instances) { my $status = $i->current_status; my $dns = $i->dnsName; print "$i: [$status] $dns\n"; } # tag both instances with Role "server" foreach (@instances) {$_->add_tag(Role=>'server'); # stop both instances foreach (@instances) {$_->stop} # find instances tagged with Role=Server that are # stopped, change the user data and restart. @instances = $ec2->describe_instances({'tag:Role' => 'Server', 'instance-state-name' => 'stopped'}); for my $i (@instances) { $i->userData('Secure-mode: off'); $i->start or warn "Couldn't start $i: ",$i->error_str; } # create an image from both instance, tag them, and make # them public for my $i (@instances) { my $img = $i->create_image("Autoimage from $i","Test image"); $img->add_tags(Name => "Autoimage from $i", Role => 'Server', Status=> 'Production'); $img->make_public(1); } ## KEY MANAGEMENT # retrieve the name and fingerprint of the first instance's # key pair my $kp = $instances[0]->keyPair; print $instances[0], ": keypair $kp=",$kp->fingerprint,"\n"; # create a new key pair $kp = $ec2->create_key_pair('My Key'); # get the private key from this key pair and write it to a disk file # in ssh-compatible format my $private_key = $kp->private_key; open (my $f,'>MyKeypair.rsa') or die $!; print $f $private_key; close $f; # Import a preexisting SSH key my $public_key = 'ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC8o...'; $key = $ec2->import_key_pair('NewKey',$public_key); ## SECURITY GROUPS AND FIREWALL RULES # Create a new security group my $group = $ec2->create_security_group(-name => 'NewGroup', -description => 'example'); # Add a firewall rule $group->authorize_incoming(-protocol => 'tcp', -port => 80, -source_ip => ['192.168.2.0/24','192.168.2.1/24'}); # Write rules back to Amazon $group->update; # Print current firewall rules print join ("\n",$group->ipPermissions),"\n"; ## VOLUME && SNAPSHOT MANAGEMENT # find existing volumes that are available my @volumes = $ec2->describe_volumes({status=>'available'}); # back 'em all up to snapshots foreach (@volumes) {$_->snapshot('Backup on '.localtime)} # find a stopped instance in first volume's availability zone and # attach the volume to the instance using /dev/sdg my $vol = $volumes[0]; my $zone = $vol->availabilityZone; @instances = $ec2->describe_instances({'availability-zone'=> $zone, 'run-state-name' => $stopped); $instances[0]->attach_volume($vol=>'/dev/sdg') if @instances; # create a new 20 gig volume $vol = $ec2->create_volume(-availability_zone=> 'us-east-1a', -size => 20); $ec2->wait_for_volumes($vol); print "Volume $vol is ready!\n" if $vol->current_status eq 'available'; # create a new elastic address and associate it with an instance my $address = $ec2->allocate_address(); $instances[0]->associate_address($address); =head1 DESCRIPTION This is an interface to the 2012-12-01 version of the Amazon AWS API (http://aws.amazon.com/ec2). It was written provide access to the new tag and metadata interface that is not currently supported by Net::Amazon::EC2, as well as to provide developers with an extension mechanism for the API. This library will also support the Eucalyptus open source cloud (http://open.eucalyptus.com). The main interface is the VM::EC2 object, which provides methods for interrogating the Amazon EC2, launching instances, and managing instance lifecycle. These methods return the following major object classes which act as specialized interfaces to AWS: VM::EC2::BlockDevice -- A block device VM::EC2::BlockDevice::Attachment -- Attachment of a block device to an EC2 instance VM::EC2::BlockDevice::EBS -- An elastic block device VM::EC2::BlockDevice::Mapping -- Mapping of a virtual storage device to a block device VM::EC2::BlockDevice::Mapping::EBS -- Mapping of a virtual storage device to an EBS block device VM::EC2::Group -- Security groups VM::EC2::Image -- Amazon Machine Images (AMIs) VM::EC2::Instance -- Virtual machine instances VM::EC2::Instance::Metadata -- Access to runtime metadata from running instances VM::EC2::Region -- Availability regions VM::EC2::Snapshot -- EBS snapshots VM::EC2::Tag -- Metadata tags In addition, there is a high level interface for interacting with EC2 servers and volumes, including file transfer and remote shell facilities: VM::EC2::Staging::Manager -- Manage a set of servers and volumes. VM::EC2::Staging::Server -- A staging server, with remote shell and file transfer facilities. VM::EC2::Staging::Volume -- A staging volume with the ability to copy itself between availability zones and regions. and a few specialty classes: VM::EC2::Security::Token -- Temporary security tokens for granting EC2 access to non-AWS account holders. VM::EC2::Security::Credentials -- Credentials for use by temporary account holders. VM::EC2::Security::Policy -- Policies that restrict what temporary account holders can do with EC2 resources. VM::EC2::Security::FederatedUser -- Account name information for temporary account holders. Lastly, there are several utility classes: VM::EC2::Generic -- Base class for all AWS objects VM::EC2::Error -- Error messages VM::EC2::Dispatch -- Maps AWS XML responses onto perl object classes VM::EC2::ReservationSet -- Hidden class used for describe_instances() request; The reservation Ids are copied into the Instance object. There is also a high-level API called "VM::EC2::Staging::Manager" for managing groups of staging servers and volumes which greatly simplifies the task of creating and updating instances that mount multiple volumes. The API also provides a one-line command for migrating EBS-backed AMIs from one zone to another. See L. The interface provided by these modules is based on that described at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/. The following caveats apply: 1) Not all of the Amazon API is currently implemented. Specifically, a handful calls dealing with cluster management and VM importing are missing. See L for a list of all the unimplemented API calls. Volunteers to fill in these gaps are most welcome! 2) For consistency with common Perl coding practices, method calls are lowercase and words in long method names are separated by underscores. The Amazon API prefers mixed case. So in the Amazon API the call to fetch instance information is "DescribeInstances", while in VM::EC2, the method is "describe_instances". To avoid annoyance, if you use the mixed case form for a method name, the Perl autoloader will automatically translate it to underscores for you, and vice-versa; this means you can call either $ec2->describe_instances() or $ec2->DescribeInstances(). 3) Named arguments passed to methods are all lowercase, use underscores to separate words and start with hyphens. In other words, if the AWS API calls for an argument named "InstanceId" to be passed to the "DescribeInstances" call, then the corresponding Perl function will look like: $instance = $ec2->describe_instances(-instance_id=>'i-12345') In most cases automatic case translation will be performed for you on arguments. So in the previous example, you could use -InstanceId as well as -instance_id. The exception is when an absurdly long argument name was replaced with an abbreviated one as described below. In this case, you must use the documented argument name. In a small number of cases, when the parameter name was absurdly long, it has been abbreviated. For example, the "Placement.AvailabilityZone" parameter has been represented as -placement_zone and not -placement_availability_zone. See the documentation for these cases. 4) For each of the describe_foo() methods (where "foo" is a type of resource such as "instance"), you can fetch the resource by using their IDs either with the long form: $ec2->describe_foo(-foo_id=>['a','b','c']), or a shortcut form: $ec2->describe_foo('a','b','c'); Both forms are listed in the headings in the documentation. 5) When the API calls for a list of arguments named Arg.1, Arg.2, then the Perl interface allows you to use an anonymous array for the consecutive values. For example to call describe_instances() with multiple instance IDs, use: @i = $ec2->describe_instances(-instance_id=>['i-12345','i-87654']) 6) All Filter arguments are represented as a -filter argument whose value is an anonymous hash: @i = $ec2->describe_instances(-filter=>{architecture=>'i386', 'tag:Name' =>'WebServer'}) If there are no other arguments you wish to pass, you can omit the -filter argument and just pass a hashref: @i = $ec2->describe_instances({architecture=>'i386', 'tag:Name' =>'WebServer'}) For any filter, you may represent multiple OR arguments as an arrayref: @i = $ec2->describe-instances({'instance-state-name'=>['stopped','terminated']}) When adding or removing tags, the -tag argument uses the same syntax. 7) The tagnames of each XML object returned from AWS are converted into methods with the same name and typography. So the tag in a DescribeInstancesResponse, becomes: $instance->privateIpAddress You can also use the more Perlish form -- this is equivalent: $instance->private_ip_address Methods that correspond to complex objects in the XML hierarchy return the appropriate Perl object. For example, an instance's blockDeviceMapping() method returns an object of type VM::EC2::BlockDevice::Mapping. All objects have a fields() method that will return the XML tagnames listed in the AWS specifications. @fields = sort $instance->fields; # 'amiLaunchIndex', 'architecture', 'blockDeviceMapping', ... 8) Whenever an object has a unique ID, string overloading is used so that the object interpolates the ID into the string. For example, when you print a VM::EC2::Volume object, or use it in another string context, then it will appear as the string "vol-123456". Nevertheless, it will continue to be usable for method calls. ($v) = $ec2->describe_volumes(); print $v,"\n"; # prints as "vol-123456" $zone = $v->availabilityZone; # acts like an object 9) Many objects have convenience methods that invoke the AWS API on your behalf. For example, instance objects have a current_status() method that returns the run status of the object, as well as start(), stop() and terminate() methods that control the instance's lifecycle. if ($instance->current_status eq 'running') { $instance->stop; } 10) Calls to AWS that have failed for one reason or another (invalid arguments, communications problems, service interruptions) will return undef and set the VM::EC2->is_error() method to true. The error message and its code can then be recovered by calling VM::EC2->error. $i = $ec2->describe_instance('i-123456'); unless ($i) { warn 'Got no instance. Message was: ',$ec2->error; } You may also elect to raise an exception when an error occurs. See the new() method for details. =head1 EXAMPLE SCRIPT The script sync_to_snapshot.pl, distributed with this module, illustrates a relatively complex set of steps on EC2 that does something useful. Given a list of directories or files on the local filesystem it copies the files into an EBS snapshot with the desired name by executing the following steps: 1. Provisions a new EBS volume on EC2 large enough to hold the data. 2. Spins up a staging instance to manage the network transfer of data from the local machine to the staging volume. 3. Creates a temporary ssh keypair and a security group that allows an rsync-over-ssh. 4. Formats and mounts the volume if necessary. 5. Initiates an rsync-over-ssh for the designated files and directories. 6. Unmounts and snapshots the volume. 7. Cleans up. If a snapshot of the same name already exists, then it is used to create the staging volume, enabling network-efficient synchronization of the files. A snapshot tag named "Version" is incremented each time you synchronize. =head1 CORE METHODS This section describes the VM::EC2 constructor, accessor methods, and methods relevant to error handling. =cut use strict; use LWP::UserAgent; use HTTP::Request::Common; use MIME::Base64 qw(encode_base64 decode_base64); use Digest::SHA qw(hmac_sha256 sha1_hex); use POSIX 'strftime'; use URI; use URI::Escape; use VM::EC2::Dispatch; use VM::EC2::Error; use Carp 'croak','carp'; our $VERSION = '1.23'; our $AUTOLOAD; our @CARP_NOT = qw(VM::EC2::Image VM::EC2::Volume VM::EC2::Snapshot VM::EC2::Instance VM::EC2::ReservedInstance); # hard-coded timeout for several wait_for_terminal_state() calls. use constant WAIT_FOR_TIMEOUT => 600; sub AUTOLOAD { my $self = shift; my ($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/; return if $func_name eq 'DESTROY'; my $proper = VM::EC2->canonicalize($func_name); $proper =~ s/^-//; if ($self->can($proper)) { eval "sub $pack\:\:$func_name {shift->$proper(\@_)}"; $self->$func_name(@_); } else { croak "Can't locate object method \"$func_name\" via package \"$pack\""; } } =head2 $ec2 = VM::EC2->new(-access_key=>$id,-secret_key=>$key,-endpoint=>$url) Create a new Amazon access object. Required arguments are: -access_key Access ID for an authorized user -secret_key Secret key corresponding to the Access ID -security_token Temporary security token obtained through a call to the AWS Security Token Service -endpoint The URL for making API requests -region The region to receive the API requests -raise_error If true, throw an exception. -print_error If true, print errors to STDERR. One or more of -access_key or -secret_key can be omitted if the environment variables EC2_ACCESS_KEY and EC2_SECRET_KEY are defined. If no endpoint is specified, then the environment variable EC2_URL is consulted; otherwise the generic endpoint http://ec2.amazonaws.com/ is used. You can also select the endpoint by specifying one of the Amazon regions, such as "us-west-2", with the -region argument. The endpoint specified by -region will override -endpoint. -security_token is used in conjunction with temporary security tokens returned by $ec2->get_federation_token() and $ec2->get_session_token() to grant restricted, time-limited access to some or all your EC2 resources to users who do not have access to your account. If you pass either a VM::EC2::Security::Token object, or the VM::EC2::Security::Credentials object contained within the token object, then new() does not need the -access_key or -secret_key arguments. You may also pass a session token string scalar to -security_token, in which case you must also pass the access key ID and secret keys generated at the same time the session token was created. See http://docs.amazonwebservices.com/AWSEC2/latest/UserGuide/UsingIAM.html and L. To use a Eucalyptus cloud, please provide the appropriate endpoint URL. By default, when the Amazon API reports an error, such as attempting to perform an invalid operation on an instance, the corresponding method will return empty and the error message can be recovered from $ec2->error(). However, if you pass -raise_error=>1 to new(), the module will instead raise a fatal error, which you can trap with eval{} and report with $@: eval { $ec2->some_dangerous_operation(); $ec2->another_dangerous_operation(); }; print STDERR "something bad happened: $@" if $@; The error object can be retrieved with $ec2->error() as before. =cut sub new { my $self = shift; my %args = @_; my ($id,$secret,$token); if (ref $args{-security_token} && $args{-security_token}->can('access_key_id')) { $id = $args{-security_token}->accessKeyId; $secret = $args{-security_token}->secretAccessKey; $token = $args{-security_token}->sessionToken; } $id ||= $args{-access_key} || $ENV{EC2_ACCESS_KEY} or croak "Please provide -access_key parameter or define environment variable EC2_ACCESS_KEY"; $secret ||= $args{-secret_key} || $ENV{EC2_SECRET_KEY} or croak "Please provide -secret_key or define environment variable EC2_SECRET_KEY"; $token ||= $args{-security_token}; my $endpoint_url = $args{-endpoint} || $ENV{EC2_URL} || 'http://ec2.amazonaws.com/'; $endpoint_url .= '/' unless $endpoint_url =~ m!/$!; $endpoint_url = "http://".$endpoint_url unless $endpoint_url =~ m!https?://!; my $raise_error = $args{-raise_error}; my $print_error = $args{-print_error}; my $obj = bless { id => $id, secret => $secret, security_token => $token, endpoint => $endpoint_url, idempotent_seed => sha1_hex(rand()), raise_error => $raise_error, print_error => $print_error, },ref $self || $self; if ($args{-region}) { my $region = eval{$obj->describe_regions($args{-region})}; my $endpoint = $region ? $region->regionEndpoint :"ec2.$args{-region}.amazonaws.com"; $obj->endpoint($endpoint); } return $obj; } =head2 $access_key = $ec2->access_key([$new_access_key]) Get or set the ACCESS KEY. In this and all similar get/set methods, call the method with no arguments to get the current value, and with a single argument to change the value: $current_key = $ec2->access_key; $ec2->access_key('XYZZY'); In the case of setting the value, these methods will return the old value as their result: $old_key = $ec2->access_key($new_key); =cut sub access_key {shift->id(@_)} sub id { my $self = shift; my $d = $self->{id}; $self->{id} = shift if @_; $d; } =head2 $secret = $ec2->secret([$new_secret]) Get or set the SECRET KEY =cut sub secret { my $self = shift; my $d = $self->{secret}; $self->{secret} = shift if @_; $d; } =head2 $secret = $ec2->security_token([$new_token]) Get or set the temporary security token. See L. =cut sub security_token { my $self = shift; my $d = $self->{security_token}; $self->{security_token} = shift if @_; $d; } =head2 $endpoint = $ec2->endpoint([$new_endpoint]) Get or set the ENDPOINT URL. =cut sub endpoint { my $self = shift; my $d = $self->{endpoint}; if (@_) { my $new_endpoint = shift; $new_endpoint = 'http://'.$new_endpoint unless $new_endpoint =~ /^https?:/; $self->{endpoint} = $new_endpoint; } $d; } =head2 $region = $ec2->region([$new_region]) Get or set the EC2 region manipulated by this module. This has the side effect of changing the endpoint. =cut sub region { my $self = shift; my $d = $self->{endpoint}; $d =~ s!^https?://!!; $d =~ s!/$!!; my @regions = $self->describe_regions; my ($current_region) = grep {$_->regionEndpoint eq $d} @regions; if (@_) { my $new_region = shift; my ($region) = grep {/$new_region/} @regions; $region or croak "unknown region $new_region"; $self->endpoint($region->regionEndpoint); } return $current_region; } =head2 $ec2->raise_error($boolean) Change the handling of error conditions. Pass a true value to cause Amazon API errors to raise a fatal error. Pass false to make methods return undef. In either case, you can detect the error condition by calling is_error() and fetch the error message using error(). This method will also return the current state of the raise error flag. =cut sub raise_error { my $self = shift; my $d = $self->{raise_error}; $self->{raise_error} = shift if @_; $d; } =head2 $ec2->print_error($boolean) Change the handling of error conditions. Pass a true value to cause Amazon API errors to print error messages to STDERR. Pass false to cancel this behavior. =cut sub print_error { my $self = shift; my $d = $self->{print_error}; $self->{print_error} = shift if @_; $d; } =head2 $boolean = $ec2->is_error If a method fails, it will return undef. However, some methods, such as describe_images(), will also return undef if no resources matches your search criteria. Call is_error() to distinguish the two eventualities: @images = $ec2->describe_images(-owner=>'29731912785'); unless (@images) { die "Error: ",$ec2->error if $ec2->is_error; print "No appropriate images found\n"; } =cut sub is_error { defined shift->error(); } =head2 $err = $ec2->error If the most recently-executed method failed, $ec2->error() will return the error code and other descriptive information. This method will return undef if the most recently executed method was successful. The returned object is actually an AWS::Error object, which has two methods named code() and message(). If used in a string context, its operator overloading returns the composite string "$message [$code]". =cut sub error { my $self = shift; my $d = $self->{error}; $self->{error} = shift if @_; $d; } =head2 $err = $ec2->error_str Same as error() except it returns the string representation, not the object. This works better in debuggers and exception handlers. =cut sub error_str { my $e = shift->{error}; $e ||= ''; return "$e"; } =head2 $account_id = $ec2->account_id Looks up the account ID corresponding to the credentials provided when the VM::EC2 instance was created. The way this is done is to fetch the "default" security group, which is guaranteed to exist, and then return its groupId field. The result is cached so that subsequent accesses are fast. =head2 $account_id = $ec2->userId Same as above, for convenience. =cut sub account_id { my $self = shift; return $self->{account_id} if exists $self->{account_id}; my $sg = $self->describe_security_groups(-group_name=>'default') or return; return $self->{account_id} ||= $sg->ownerId; } sub userId { shift->account_id } =head2 $new_ec2 = $ec2->clone This method creates an identical copy of the EC2 object. It is used occasionally internally for creating an EC2 object in a different AWS region: $singapore = $ec2->clone; $singapore->region('ap-souteast-1'); =cut sub clone { my $self = shift; my %contents = %$self; return bless \%contents,ref $self; } =head1 EC2 REGIONS AND AVAILABILITY ZONES This section describes methods that allow you to fetch information on EC2 regions and availability zones. These methods return objects of type L and L. =head2 @regions = $ec2->describe_regions(@list) =head2 @regions = $ec2->describe_regions(-region_name=>\@list) Describe regions and return a list of VM::EC2::Region objects. Call with no arguments to return all regions. You may provide a list of regions in either of the two forms shown above in order to restrict the list returned. Glob-style wildcards, such as "*east") are allowed. =cut sub describe_regions { my $self = shift; my %args = $self->args('-region_name',@_); my @params = $self->list_parm('RegionName',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeRegions',@params); } =head2 @zones = $ec2->describe_availability_zones(@names) =head2 @zones = $ec2->describe_availability_zones(-zone_name=>\@names,-filter=>\%filters) Describe availability zones and return a list of VM::EC2::AvailabilityZone objects. Call with no arguments to return all availability regions. You may provide a list of zones in either of the two forms shown above in order to restrict the list returned. Glob-style wildcards, such as "*east") are allowed. If you provide a single argument consisting of a hashref, it is treated as a -filter argument. In other words: $ec2->describe_availability_zones({state=>'available'}) is equivalent to $ec2->describe_availability_zones(-filter=>{state=>'available'}) Availability zone filters are described at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeAvailabilityZones.html =cut sub describe_availability_zones { my $self = shift; my %args = $self->args('-zone_name',@_); my @params = $self->list_parm('ZoneName',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeAvailabilityZones',@params); } =head1 EC2 INSTANCES The methods in this section allow you to retrieve information about EC2 instances, launch new instances, control the instance lifecycle (e.g. starting and stopping them), and fetching the console output from instances. The primary object manipulated by these methods is L. Please see the L manual page for additional methods that allow you to attach and detach volumes, modify an instance's attributes, and convert instances into images. =head2 @instances = $ec2->describe_instances(@instance_ids) =head2 @instances = $ec2->describe_instances(\%filters) =head2 @instances = $ec2->describe_instances(-instance_id=>\@ids,-filter=>\%filters) Return a series of VM::EC2::Instance objects. Optional arguments are: -instance_id ID of the instance(s) to return information on. This can be a string scalar, or an arrayref. -filter Tags and other filters to apply. The filter argument is a hashreference in which the keys are the filter names, and the values are the match strings. Some filters accept wildcards. A typical filter example: $ec2->describe_instances( -filter => {'block-device-mapping.device-name'=>'/dev/sdh', 'architecture' => 'i386', 'tag:Role' => 'Server' }); You may omit the -filter argument name if there are no other arguments: $ec2->describe_instances({'block-device-mapping.device-name'=>'/dev/sdh', 'architecture' => 'i386', 'tag:Role' => 'Server'}); There are a large number of filters, which are listed in full at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeInstances.html. Here is a alpha-sorted list of filter names: architecture, availability-zone, block-device-mapping.attach-time, block-device-mapping.delete-on-termination, block-device-mapping.device-name, block-device-mapping.status, block-device-mapping.volume-id, client-token, dns-name, group-id, group-name, hypervisor, image-id, instance-id, instance-lifecycle, instance-state-code, instance-state-name, instance-type, instance.group-id, instance.group-name, ip-address, kernel-id, key-name, launch-index, launch-time, monitoring-state, owner-id, placement-group-name, platform, private-dns-name, private-ip-address, product-code, ramdisk-id, reason, requester-id, reservation-id, root-device-name, root-device-type, source-dest-check, spot-instance-request-id, state-reason-code, state-reason-message, subnet-id, tag-key, tag-value, tag:key, virtualization-type, vpc-id. Note that the objects returned from this method are the instances themselves, and not a reservation set. The reservation ID can be retrieved from each instance by calling its reservationId() method. =cut sub describe_instances { my $self = shift; my %args = $self->args('-instance_id',@_); my @params = $self->list_parm('InstanceId',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeInstances',@params); } =head2 @i = $ec2->run_instances($ami_id) =head2 @i = $ec2->run_instances(-image_id=>$id,%other_args) This method will provision and launch one or more instances given an AMI ID. If successful, the method returns a series of VM::EC2::Instance objects. If called with a single argument this will be interpreted as the AMI to launch, and all other arguments will take their defaults. Otherwise, the arguments will be taken as a -parameter=>$argument list. =over 4 =item Required arguments: -image_id ID of an AMI to launch =item Optional arguments: -min_count Minimum number of instances to launch [1] -max_count Maximum number of instances to launch [1] -key_name Name of the keypair to use -security_group_id Security group ID to use for this instance. Use an arrayref for multiple group IDs -security_group Security group name to use for this instance. Use an arrayref for multiple values. -user_data User data to pass to the instances. Do NOT base64 encode this. It will be done for you. -instance_type Type of the instance to use. See below for a list. -availability_zone The availability zone you want to launch the instance into. Call $ec2->regions for a list. -zone Short version of -availability_aone. -placement_zone Deprecated version of -availability_zone. -placement_group An existing placement group to launch the instance into. Applicable to cluster instances only. -placement_tenancy Specify 'dedicated' to launch the instance on a dedicated server. Only applicable for VPC instances. -kernel_id ID of the kernel to use for the instances, overriding the kernel specified in the image. -ramdisk_id ID of the ramdisk to use for the instances, overriding the ramdisk specified in the image. -block_devices Specify block devices to map onto the instances, overriding the values specified in the image. See below for the syntax of this argument. -block_device_mapping Alias for -block_devices. -monitoring Pass a true value to enable detailed monitoring. -subnet_id ID of the subnet to launch the instance into. Only applicable for VPC instances. -termination_protection Pass true to lock the instance so that it cannot be terminated using the API. Use modify_instance() to unset this if youu wish to terminate the instance later. -disable_api_termination -- Same as above. -shutdown_behavior Pass "stop" (the default) to stop the instance and save its disk state when "shutdown" is called from within the instance. Stopped instances can be restarted later. Pass "terminate" to instead terminate the instance and discard its state completely. -instance_initiated_shutdown_behavior -- Same as above. -private_ip_address Assign the instance to a specific IP address from a VPC subnet (VPC only). -client_token Unique identifier that you can provide to ensure idempotency of the request. You can use $ec2->token() to generate a suitable identifier. See http://docs.amazonwebservices.com/AWSEC2/ latest/UserGuide/Run_Instance_Idempotency.html -network_interfaces A single network interface specification string or a list of them as an array reference (VPC only). These are described in more detail below. -iam_arn The Amazon resource name (ARN) of the IAM Instance Profile (IIP) to associate with the instances. -iam_name The name of the IAM instance profile (IIP) to associate with the instances. -ebs_optimized Boolean. If true, create an EBS-optimized instance (valid only for certain instance types. =item Instance types The following is the list of instance types currently allowed by Amazon: m1.small c1.medium m2.xlarge cc1.4xlarge cg1.4xlarge t1.micro m1.large c1.xlarge m2.2xlarge m1.xlarge m2.4xlarge =item Block device syntax The syntax of -block_devices is identical to what is used by the ec2-run-instances command-line tool. Borrowing from the manual page of that tool: The format is '=', where 'block-device' can be one of the following: - 'none': indicates that a block device that would be exposed at the specified device should be suppressed. For example: '/dev/sdb=none' - 'ephemeral[0-3]': indicates that the Amazon EC2 ephemeral store (instance local storage) should be exposed at the specified device. For example: '/dev/sdc=ephemeral0'. - 'vol-12345678': A volume ID will attempt to attach the given volume to the instance, contingent on volume state and availability zone. - 'none': Suppress this block device, even if it is mapped in the AMI. - '[][:[:[:[:]]]]': indicates that an Amazon EBS volume, created from the specified Amazon EBS snapshot, should be exposed at the specified device. The following combinations are supported: - '': the ID of an Amazon EBS snapshot, which must be owned by or restorable by the caller. May be left out if a is specified, creating an empty Amazon EBS volume of the specified size. - '': the size (GiBs) of the Amazon EBS volume to be created. If a snapshot was specified, this may not be smaller than the size of the snapshot itself. - '': indicates whether the Amazon EBS volume should be deleted on instance termination. If not specified, this will default to 'true' and the volume will be deleted. - '': The volume type. One of "standard" or "io1". - '': The number of I/O operations per second (IOPS) that the volume suports. A number between 100 to 2000. Only valid for volumes of type "io1". Examples: -block_devices => '/dev/sdb=snap-7eb96d16' -block_devices => '/dev/sdc=snap-7eb96d16:80:false' -block_devices => '/dev/sdd=:120' -block_devices => '/dev/sdc=:120:true:io1:500' To provide multiple mappings, use an array reference. In this example, we launch two 'm1.small' instance in which /dev/sdb is mapped to ephemeral storage and /dev/sdc is mapped to a new 100 G EBS volume: @i=$ec2->run_instances(-image_id => 'ami-12345', -min_count => 2, -block_devices => ['/dev/sdb=ephemeral0', '/dev/sdc=:100:true'] ) =item Network interface syntax Each instance has a single primary network interface and private IP address that is ordinarily automatically assigned by Amazon. When you are running VPC instances, however, you can add additional elastic network interfaces (ENIs) to the instance and add secondary private IP addresses to one or more of these ENIs. ENIs can exist independently of instances, and be detached and reattached in much the same way as EBS volumes. This is explained in detail at http://docs.amazonwebservices.com/AWSEC2/latest/UserGuide/using-instance-addressing.html. The network configuration can be specified using the -network_interface parameter: -network_interfaces => ['eth0=10.10.0.12:subnet-1234567:sg-1234567:true:My Custom Eth0', 'eth1=10.10.1.12,10.10.1.13:subnet-999999:sg-1234567:true:My Custom Eth1', The format is '='. The device is an ethernet interface name such as eth0, eth1, eth2, etc. The specification has up to five fields, each separated by the ":" character. All fields are optional and can be left blank. If missing, AWS will choose a default. 10.10.1.12,10.10.1.13:subnet-999999:sg-1234567:true:My Custom Eth1 B<1. IP address(es)>: A single IP address in standard dot form, or a list of IP addresses separated by commas. The first address in the list will become the primary private IP address for the interface. Subsequent addresses will become secondary private addresses. You may specify "auto" or leave the field blank to have AWS choose an address automatically from within the subnetwork. To allocate several secondary IP addresses and have AWS pick the addresses automatically, give the count of secondary addresses you wish to allocate as an integer following the primary IP address. For example, "auto,3" will allocate an automatic primary IP address and three automatic secondary addresses, while "10.10.1.12,3" will force the primary address to be 10.10.1.12 and create three automatic secondary addresses. B<2. Subnetwork ID>: The ID of the VPC subnetwork in which the ENI resides. An instance may have several ENIs associated with it, and each ENI may be attached to a different subnetwork. B<3. Security group IDs>: A comma-delimited list of the security group IDs to associate with this ENI. B<4. DeleteOnTerminate>: True if this ENI should be automatically deleted when the instance terminates. B<5. Description>: A human-readable description of the ENI. As an alternative syntax, you may specify the ID of an existing ENI in lieu of the primary IP address and other fields. The ENI will be attached to the instance if its permissions allow: -network_interfaces => 'eth0=eni-123456' =item Return value On success, this method returns a list of VM::EC2::Instance objects. If called in a scalar context AND only one instance was requested, it will return a single instance object (rather than returning a list of size one which is then converted into numeric "1", as would be the usual Perl behavior). Note that this behavior is different from the Amazon API, which returns a ReservationSet. In this API, ask the instances for the the reservation, owner, requester, and group information using reservationId(), ownerId(), requesterId() and groups() methods. =item Tips 1. If you have a VM::EC2::Image object returned from Describe_images(), you may run it using run_instances(): my $image = $ec2->describe_images(-image_id => 'ami-12345'); $image->run_instances( -min_count => 10, -block_devices => ['/dev/sdb=ephemeral0', '/dev/sdc=:100:true'] ) 2. It may take a short while for a newly-launched instance to be returned by describe_instances(). You may need to sleep for 1-2 seconds before current_status() returns the correct value. 3. Each instance object has a current_status() method which will return the current run state of the instance. You may poll this method to wait until the instance is running: my $instance = $ec2->run_instances(...); sleep 1; while ($instance->current_status ne 'running') { sleep 5; } 4. The utility method wait_for_instances() will wait until all passed instances are in the 'running' or other terminal state. my @instances = $ec2->run_instances(...); $ec2->wait_for_instances(@instances); =back =cut sub run_instances { my $self = shift; my %args = $self->args('-image_id',@_); $args{-image_id} or croak "run_instances(): -image_id argument missing"; $args{-min_count} ||= 1; $args{-max_count} ||= $args{-min_count}; $args{-availability_zone} ||= $args{-zone}; $args{-availability_zone} ||= $args{-placement_zone}; my @p = map {$self->single_parm($_,\%args) } qw(ImageId MinCount MaxCount KeyName KernelId RamdiskId PrivateIpAddress InstanceInitiatedShutdownBehavior ClientToken SubnetId InstanceType); push @p,map {$self->list_parm($_,\%args)} qw(SecurityGroup SecurityGroupId); push @p,('UserData' =>encode_base64($args{-user_data},'')) if $args{-user_data}; push @p,('Placement.AvailabilityZone'=>$args{-availability_zone}) if $args{-availability_zone}; push @p,('Placement.GroupName'=>$args{-placement_group}) if $args{-placement_group}; push @p,('Placement.Tenancy'=>$args{-tenancy}) if $args{-placement_tenancy}; push @p,('Monitoring.Enabled' =>'true') if $args{-monitoring}; push @p,('DisableApiTermination'=>'true') if $args{-termination_protection}; push @p,('EbsOptimized'=>'true') if $args{-ebs_optimized}; push @p,('InstanceInitiatedShutdownBehavior'=>$args{-shutdown_behavior}) if $args{-shutdown_behavior}; push @p,$self->block_device_parm($args{-block_devices}||$args{-block_device_mapping}); push @p,$self->network_interface_parm(\%args); push @p,$self->iam_parm(\%args); return $self->call('RunInstances',@p); } =head2 @s = $ec2->start_instances(@instance_ids) =head2 @s = $ec2->start_instances(-instance_id=>\@instance_ids) Start the instances named by @instance_ids and return one or more VM::EC2::Instance::State::Change objects. To wait for the all the instance ids to reach their final state ("running" unless an error occurs), call wait_for_instances(). Example: # find all stopped instances @instances = $ec2->describe_instances(-filter=>{'instance-state-name'=>'stopped'}); # start them $ec2->start_instances(@instances) # pause till they are running (or crashed) $ec2->wait_for_instances(@instances) You can also start an instance by calling the object's start() method: $instances[0]->start('wait'); # start instance and wait for it to # be running The objects returned by calling start_instances() indicate the current and previous states of the instance. The previous state is typically "stopped" and the current state is usually "pending." This information is only current to the time that the start_instances() method was called. To get the current run state of the instance, call its status() method: die "ouch!" unless $instances[0]->current_status eq 'running'; =cut sub start_instances { my $self = shift; my @instance_ids = $self->instance_parm(@_) or croak "usage: start_instances(\@instance_ids)"; my $c = 1; my @params = map {'InstanceId.'.$c++,$_} @instance_ids; return $self->call('StartInstances',@params); } =head2 @s = $ec2->stop_instances(@instance_ids) =head2 @s = $ec2->stop_instances(-instance_id=>\@instance_ids,-force=>1) Stop the instances named by @instance_ids and return one or more VM::EC2::Instance::State::Change objects. In the named parameter version of this method, you may optionally provide a -force argument, which if true, forces the instance to halt without giving it a chance to run its shutdown procedure (the equivalent of pulling a physical machine's plug). To wait for instances to reach their final state, call wait_for_instances(). Example: # find all running instances @instances = $ec2->describe_instances(-filter=>{'instance-state-name'=>'running'}); # stop them immediately and wait for confirmation $ec2->stop_instances(-instance_id=>\@instances,-force=>1); $ec2->wait_for_instances(@instances); You can also stop an instance by calling the object's start() method: $instances[0]->stop('wait'); # stop first instance and wait for it to # stop completely =cut sub stop_instances { my $self = shift; my (@instance_ids,$force); if ($_[0] =~ /^-/) { my %argv = @_; @instance_ids = ref $argv{-instance_id} ? @{$argv{-instance_id}} : $argv{-instance_id}; $force = $argv{-force}; } else { @instance_ids = @_; } @instance_ids or croak "usage: stop_instances(\@instance_ids)"; my $c = 1; my @params = map {'InstanceId.'.$c++,$_} @instance_ids; push @params,Force=>1 if $force; return $self->call('StopInstances',@params); } =head2 @s = $ec2->terminate_instances(@instance_ids) =head2 @s = $ec2->terminate_instances(-instance_id=>\@instance_ids) Terminate the instances named by @instance_ids and return one or more VM::EC2::Instance::State::Change objects. This method will fail for any instances whose termination protection field is set. To wait for the all the instances to reach their final state, call wait_for_instances(). Example: # find all instances tagged as "Version 0.5" @instances = $ec2->describe_instances({'tag:Version'=>'0.5'}); # terminate them $ec2->terminate_instances(@instances); You can also terminate an instance by calling its terminate() method: $instances[0]->terminate; =cut sub terminate_instances { my $self = shift; my @instance_ids = $self->instance_parm(@_) or croak "usage: start_instances(\@instance_ids)"; my $c = 1; my @params = map {'InstanceId.'.$c++,$_} @instance_ids; return $self->call('TerminateInstances',@params); } =head2 @s = $ec2->reboot_instances(@instance_ids) =head2 @s = $ec2->reboot_instances(-instance_id=>\@instance_ids) Reboot the instances named by @instance_ids and return one or more VM::EC2::Instance::State::Change objects. To wait for the all the instances to reach their final state, call wait_for_instances(). You can also reboot an instance by calling its terminate() method: $instances[0]->reboot; =cut sub reboot_instances { my $self = shift; my @instance_ids = $self->instance_parm(@_) or croak "Usage: reboot_instances(\@instance_ids)"; my $c = 1; my @params = map {'InstanceId.'.$c++,$_} @instance_ids; return $self->call('RebootInstances',@params); } =head2 $boolean = $ec2->confirm_product_instance($instance_id,$product_code) Return "true" if the instance indicated by $instance_id is associated with the given product code. =cut sub confirm_product_instance { my $self = shift; @_ == 1 or croak "Usage: confirm_product_instance(\$instance_id,\$product_code)"; my ($instance_id,$product_code) = @_; my @params = (InstanceId=>$instance_id, ProductCode=>$product_code); return $self->call('ConfirmProductInstance',@params); } =head2 $password_data = $ec2->get_password_data($instance_id); =head2 $password_data = $ec2->get_password_data(-instance_id=>$id); For Windows instances, get the administrator's password as a L object. =cut sub get_password_data { my $self = shift; my %args = $self->args(-instance_id=>@_); $args{-instance_id} or croak "Usage: get_password_data(-instance_id=>\$id)"; my @params = $self->single_parm('InstanceId',\%args); return $self->call('GetPasswordData',@params); } =head2 $output = $ec2->get_console_output(-instance_id=>'i-12345') =head2 $output = $ec2->get_console_output('i-12345'); Return the console output of the indicated instance. The output is actually a VM::EC2::ConsoleOutput object, but it is overloaded so that when treated as a string it will appear as a large text string containing the console output. When treated like an object it provides instanceId() and timestamp() methods. =cut sub get_console_output { my $self = shift; my %args = $self->args(-instance_id=>@_); $args{-instance_id} or croak "Usage: get_console_output(-instance_id=>\$id)"; my @params = $self->single_parm('InstanceId',\%args); return $self->call('GetConsoleOutput',@params); } =head2 @monitoring_state = $ec2->monitor_instances(@list_of_instanceIds) =head2 @monitoring_state = $ec2->monitor_instances(-instance_id=>\@instanceIds) This method enables monitoring for the listed instances and returns a list of VM::EC2::Instance::MonitoringState objects. You can later use these objects to activate and inactivate monitoring. =cut sub monitor_instances { my $self = shift; my %args = $self->args('-instance_id',@_); my @params = $self->list_parm('InstanceId',\%args); return $self->call('MonitorInstances',@params); } =head2 @monitoring_state = $ec2->unmonitor_instances(@list_of_instanceIds) =head2 @monitoring_state = $ec2->unmonitor_instances(-instance_id=>\@instanceIds) This method disables monitoring for the listed instances and returns a list of VM::EC2::Instance::MonitoringState objects. You can later use these objects to activate and inactivate monitoring. =cut sub unmonitor_instances { my $self = shift; my %args = $self->args('-instance_id',@_); my @params = $self->list_parm('InstanceId',\%args); return $self->call('UnmonitorInstances',@params); } =head2 $meta = VM::EC2->instance_metadata =head2 $meta = $ec2->instance_metadata B This method returns a VM::EC2::Instance::Metadata object that will return information about the currently running instance using the HTTP:// metadata fields described at http://docs.amazonwebservices.com/AWSEC2/latest/UserGuide/index.html?instancedata-data-categories.html. This is usually fastest way to get runtime information on the current instance. Note that this method can be called as either an instance or a class method. =cut sub instance_metadata { VM::EC2::Dispatch::load_module('VM::EC2::Instance::Metadata'); return VM::EC2::Instance::Metadata->new(); } =head2 @data = $ec2->describe_instance_attribute($instance_id,$attribute) This method returns instance attributes. Only one attribute can be retrieved at a time. The following is the list of attributes that can be retrieved: instanceType -- scalar kernel -- scalar ramdisk -- scalar userData -- scalar disableApiTermination -- scalar instanceInitiatedShutdownBehavior -- scalar rootDeviceName -- scalar blockDeviceMapping -- list of hashref sourceDestCheck -- scalar groupSet -- list of scalar All of these values can be retrieved more conveniently from the L object returned from describe_instances(), so there is no attempt to parse the results of this call into Perl objects. Therefore, some of the attributes, in particular 'blockDeviceMapping' will be returned as raw hashrefs. =cut sub describe_instance_attribute { my $self = shift; @_ == 2 or croak "Usage: describe_instance_attribute(\$instance_id,\$attribute_name)"; my ($instance_id,$attribute) = @_; my @param = (InstanceId=>$instance_id,Attribute=>$attribute); my $result = $self->call('DescribeInstanceAttribute',@param); return $result && $result->attribute($attribute); } =head2 $boolean = $ec2->modify_instance_attribute($instance_id,-$attribute_name=>$value) This method changes instance attributes. It can only be applied to stopped instances. The following is the list of attributes that can be set: -instance_type -- type of instance, e.g. "m1.small" -kernel -- kernel id -ramdisk -- ramdisk id -user_data -- user data -termination_protection -- true to prevent termination from the console -disable_api_termination -- same as the above -shutdown_behavior -- "stop" or "terminate" -instance_initiated_shutdown_behavior -- same as above -root_device_name -- root device name -source_dest_check -- enable NAT (VPC only) -group_id -- VPC security group -block_devices -- Specify block devices to change deleteOnTermination flag -block_device_mapping -- Alias for -block_devices Only one attribute can be changed in a single request. For example: $ec2->modify_instance_attribute('i-12345',-kernel=>'aki-f70657b2'); The result code is true if the attribute was successfully modified, false otherwise. In the latter case, $ec2->error() will provide the error message. The ability to change the deleteOnTermination flag for attached block devices is not documented in the official Amazon API documentation, but appears to work. The syntax is: # turn on deleteOnTermination $ec2->modify_instance_attribute(-block_devices=>'/dev/sdf=v-12345') # turn off deleteOnTermination $ec2->modify_instance_attribute(-block_devices=>'/dev/sdf=v-12345') The syntax is slightly different from what is used by -block_devices in run_instances(), and is "device=volumeId:boolean". Multiple block devices can be specified using an arrayref. =cut sub modify_instance_attribute { my $self = shift; my $instance_id = shift or croak "Usage: modify_instance_attribute(\$instanceId,%param)"; my %args = @_; my @param = (InstanceId=>$instance_id); push @param,$self->value_parm($_,\%args) foreach qw(InstanceType Kernel Ramdisk UserData DisableApiTermination InstanceInitiatedShutdownBehavior SourceDestCheck); push @param,$self->list_parm('GroupId',\%args); push @param,('DisableApiTermination.Value'=>'true') if $args{-termination_protection}; push @param,('InstanceInitiatedShutdownBehavior.Value'=>$args{-shutdown_behavior}) if $args{-shutdown_behavior}; my $block_devices = $args{-block_devices} || $args{-block_device_mapping}; push @param,$self->block_device_parm($block_devices); return $self->call('ModifyInstanceAttribute',@param); } =head2 $boolean = $ec2->reset_instance_attribute($instance_id,$attribute) This method resets an attribute of the given instance to its default value. Valid attributes are "kernel", "ramdisk" and "sourceDestCheck". The result code is true if the reset was successful. =cut sub reset_instance_attribute { my $self = shift; @_ == 2 or croak "Usage: reset_instance_attribute(\$instanceId,\$attribute_name)"; my ($instance_id,$attribute) = @_; my %valid = map {$_=>1} qw(kernel ramdisk sourceDestCheck); $valid{$attribute} or croak "attribute to reset must be one of 'kernel', 'ramdisk', or 'sourceDestCheck'"; return $self->call('ResetInstanceAttribute',InstanceId=>$instance_id,Attribute=>$attribute); } =head2 @status_list = $ec2->describe_instance_status(@instance_ids); =head2 @status_list = $ec2->describe_instance_status(-instance_id=>\@ids,-filter=>\%filters,%other_args); =head2 @status_list = $ec2->describe_instance_status(\%filters); This method returns a list of VM::EC2::Instance::Status objects corresponding to status checks and scheduled maintenance events on the instances of interest. You may provide a list of instances to return information on, a set of filters, or both. The filters are described at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeInstanceStatus.html. The brief list is: availability-zone, event.code, event.description, event.not-after, event.not-before, instance-state-name, instance-state-code, system-status.status, system-status.reachability, instance-status.status, instance-status.reachability. Request arguments are: -instance_id Scalar or array ref containing the instance ID(s) to return information about (optional). -filter Filters to apply (optional). -include_all_instances If true, include all instances, including those that are stopped, pending and shutting down. Otherwise, returns the status of running instances only. -max_results An integer corresponding to the number of instance items per response (must be greater than 5). If -max_results is specified, then the call will return at most the number of instances you requested. You may see whether there are additional results by calling more_instance_status(), and then retrieve the next set of results with additional call(s) to describe_instance_status(): my @results = $ec2->describe_instance_status(-max_results => 10); do_something(\@results); while ($ec2->more_instance_status) { @results = $ec2->describe_instance_status; do_something(\@results); } NOTE: As of 29 July 2012, passing -include_all_instances causes an EC2 "unknown parameter" error, indicating some mismatch between the documented API and the actual one. =cut sub more_instance_status { my $self = shift; return $self->{instance_status_token} && !$self->{instance_status_stop}; } sub describe_instance_status { my $self = shift; my @parms; if (!@_ && $self->{instance_status_token} && $self->{instance_status_args}) { @parms = (@{$self->{instance_status_args}},NextToken=>$self->{instance_status_token}); } else { my %args = $self->args('-instance_id',@_); push @parms,$self->list_parm('InstanceId',\%args); push @parms,$self->filter_parm(\%args); push @parms,$self->boolean_parm('IncludeAllInstances',\%args); push @parms,$self->single_parm('MaxResults',\%args); if ($args{-max_results}) { $self->{instance_status_token} = 'xyzzy'; # dummy value $self->{instance_status_args} = \@parms; } } return $self->call('DescribeInstanceStatus',@parms); } =head2 $t = $ec2->token Return a client token for use with start_instances(). =cut sub token { my $self = shift; my $seed = $self->{idempotent_seed}; $self->{idempotent_seed} = sha1_hex($seed); $seed =~ s/(.{6})/$1-/g; return $seed; } =head1 Waiting for State Changes The methods in this section allow your script to wait in an efficient manner for desired state changes in instances, volumes and other objects. =head2 $ec2->wait_for_instances(@instances) Wait for all members of the provided list of instances to reach some terminal state ("running", "stopped" or "terminated"), and then return a hash reference that maps each instance ID to its final state. Typical usage: my @instances = $image->run_instances(-key_name =>'My_key', -security_group=>'default', -min_count =>2, -instance_type => 't1.micro') or die $ec2->error_str; my $status = $ec2->wait_for_instances(@instances); my @failed = grep {$status->{$_} ne 'running'} @instances; print "The following failed: @failed\n"; If no terminal state is reached within a set timeout, then this method returns undef and sets $ec2->error_str() to a suitable message. The timeout, which defaults to 10 minutes (600 seconds), can be get or set with $ec2->wait_for_timeout(). =cut sub wait_for_instances { my $self = shift; $self->wait_for_terminal_state(\@_, ['running','stopped','terminated'], $self->wait_for_timeout); } =head2 $ec2->wait_for_snapshots(@snapshots) Wait for all members of the provided list of snapshots to reach some terminal state ("completed", "error"), and then return a hash reference that maps each snapshot ID to its final state. This method may potentially wait forever. It has no set timeout. Wrap it in an eval{} and set alarm() if you wish to timeout. =cut sub wait_for_snapshots { my $self = shift; $self->wait_for_terminal_state(\@_, ['completed','error'], 0); # no timeout on snapshots -- they may take days } =head2 $ec2->wait_for_volumes(@volumes) Wait for all members of the provided list of volumes to reach some terminal state ("available", "in-use", "deleted" or "error"), and then return a hash reference that maps each volume ID to its final state. If no terminal state is reached within a set timeout, then this method returns undef and sets $ec2->error_str() to a suitable message. The timeout, which defaults to 10 minutes (600 seconds), can be get or set with $ec2->wait_for_timeout(). =cut sub wait_for_volumes { my $self = shift; $self->wait_for_terminal_state(\@_, ['available','in-use','deleted','error'], $self->wait_for_timeout); } =head2 $ec2->wait_for_attachments(@attachment) Wait for all members of the provided list of VM::EC2::BlockDevice::Attachment objects to reach some terminal state ("attached" or "detached"), and then return a hash reference that maps each attachment to its final state. Typical usage: my $i = 0; my $instance = 'i-12345'; my @attach; foreach (@volume) { push @attach,$_->attach($instance,'/dev/sdf'.$i++; } my $s = $ec2->wait_for_attachments(@attach); my @failed = grep($s->{$_} ne 'attached'} @attach; warn "did not attach: ",join ', ',@failed; If no terminal state is reached within a set timeout, then this method returns undef and sets $ec2->error_str() to a suitable message. The timeout, which defaults to 10 minutes (600 seconds), can be get or set with $ec2->wait_for_timeout(). =cut sub wait_for_attachments { my $self = shift; $self->wait_for_terminal_state(\@_, ['attached','detached'], $self->wait_for_timeout); } =head2 $ec2->wait_for_terminal_state(\@objects,['list','of','states'] [,$timeout]) Generic version of the last four methods. Wait for all members of the provided list of Amazon objects instances to reach some terminal state listed in the second argument, and then return a hash reference that maps each object ID to its final state. If a timeout is provided, in seconds, then the method will abort after waiting the indicated time and return undef. =cut sub wait_for_terminal_state { my $self = shift; my ($objects,$terminal_states,$timeout) = @_; my %terminal_state = map {$_=>1} @$terminal_states; my %status = (); my @pending = grep {defined $_} @$objects; # in case we're passed an undef my $status = eval { local $SIG{ALRM}; if ($timeout && $timeout > 0) { $SIG{ALRM} = sub {die "timeout"}; alarm($timeout); } while (@pending) { sleep 3; $status{$_} = $_->current_status foreach @pending; @pending = grep { !$terminal_state{$status{$_}} } @pending; } alarm(0); \%status; }; if ($@ =~ /timeout/) { $self->error('timeout waiting for terminal state'); return; } return $status; } =head2 $timeout = $ec2->wait_for_timeout([$new_timeout]); Get or change the timeout for wait_for_instances(), wait_for_attachments(), and wait_for_volumes(). The timeout is given in seconds, and defaults to 600 (10 minutes). You can set this to 0 to wait forever. =cut sub wait_for_timeout { my $self = shift; $self->{wait_for_timeout} = WAIT_FOR_TIMEOUT unless defined $self->{wait_for_timeout}; my $d = $self->{wait_for_timeout}; $self->{wait_for_timeout} = shift if @_; return $d; } =head1 EC2 AMAZON MACHINE IMAGES The methods in this section allow you to query and manipulate Amazon machine images (AMIs). See L. =head2 @i = $ec2->describe_images(@image_ids) =head2 @i = $ec2->describe_images(-image_id=>\@id,-executable_by=>$id, -owner=>$id, -filter=>\%filters) Return a series of VM::EC2::Image objects, each describing an AMI. Optional arguments: -image_id The id of the image, either a string scalar or an arrayref. -executable_by Filter by images executable by the indicated user account, or one of the aliases "self" or "all". -owner Filter by owner account number or one of the aliases "self", "aws-marketplace", "amazon" or "all". -filter Tags and other filters to apply If there are no other arguments, you may omit the -filter argument name and call describe_images() with a single hashref consisting of the search filters you wish to apply. The full list of image filters can be found at: http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeImages.html =cut sub describe_images { my $self = shift; my %args = $self->args(-image_id=>@_); my @params; push @params,$self->list_parm($_,\%args) foreach qw(ExecutableBy ImageId Owner); push @params,$self->filter_parm(\%args); return $self->call('DescribeImages',@params); } =head2 $image = $ec2->create_image(-instance_id=>$id,-name=>$name,%other_args) Create an image from an EBS-backed instance and return a VM::EC2::Image object. The instance must be in the "stopped" or "running" state. In the latter case, Amazon will stop the instance, create the image, and then restart it unless the -no_reboot argument is provided. Arguments: -instance_id ID of the instance to create an image from. (required) -name Name for the image that will be created. (required) -description Description of the new image. -no_reboot If true, don't reboot the instance. -block_device_mapping Block device mapping as a scalar or array ref. See run_instances() for the syntax. -block_devices Alias of the above =cut sub create_image { my $self = shift; my %args = @_; $args{-instance_id} && $args{-name} or croak "Usage: create_image(-instance_id=>\$id,-name=>\$name)"; $args{-block_device_mapping} ||= $args{-block_devices}; my @param = $self->single_parm('InstanceId',\%args); push @param,$self->single_parm('Name',\%args); push @param,$self->single_parm('Description',\%args); push @param,$self->boolean_parm('NoReboot',\%args); push @param,$self->block_device_parm($args{-block_device_mapping}); return $self->call('CreateImage',@param); } =head2 $image = $ec2->register_image(-name=>$name,%other_args) Register an image, creating an AMI. This can be used to create an AMI from a S3-backed instance-store bundle, or to create an AMI from a snapshot of an EBS-backed root volume. Required arguments: -name Name for the image that will be created. Arguments required for an EBS-backed image: -root_device_name The root device name, e.g. /dev/sda1 -block_device_mapping The block device mapping strings, including the snapshot ID for the root volume. This can be either a scalar string or an arrayref. See run_instances() for a description of the syntax. -block_devices Alias of the above. Arguments required for an instance-store image: -image_location Full path to the AMI manifest in Amazon S3 storage. Common optional arguments: -description Description of the AMI -architecture Architecture of the image ("i386" or "x86_64") -kernel_id ID of the kernel to use -ramdisk_id ID of the RAM disk to use While you do not have to specify the kernel ID, it is strongly recommended that you do so. Otherwise the kernel will have to be specified for run_instances(). Note: Immediately after registering the image you can add tags to it and use modify_image_attribute to change launch permissions, etc. =cut sub register_image { my $self = shift; my %args = @_; $args{-name} or croak "register_image(): -name argument required"; $args{-block_device_mapping} ||= $args{-block_devices}; if (!$args{-image_location}) { $args{-root_device_name} && $args{-block_device_mapping} or croak "register_image(): either provide -image_location to create an instance-store AMI\nor both the -root_device_name && -block_device_mapping arguments to create an EBS-backed AMI."; } my @param; for my $a (qw(Name RootDeviceName ImageLocation Description Architecture KernelId RamdiskId)) { push @param,$self->single_parm($a,\%args); } push @param,$self->block_device_parm($args{-block_devices} || $args{-block_device_mapping}); return $self->call('RegisterImage',@param); } =head2 $result = $ec2->deregister_image($image_id) Deletes the registered image and returns true if successful. =cut sub deregister_image { my $self = shift; my %args = $self->args(-image_id => @_); my @param = $self->single_parm(ImageId=>\%args); return $self->call('DeregisterImage',@param); } =head2 @data = $ec2->describe_image_attribute($image_id,$attribute) This method returns image attributes. Only one attribute can be retrieved at a time. The following is the list of attributes that can be retrieved: description -- scalar kernel -- scalar ramdisk -- scalar launchPermission -- list of scalar productCodes -- array blockDeviceMapping -- list of hashref All of these values can be retrieved more conveniently from the L object returned from describe_images(), so there is no attempt to parse the results of this call into Perl objects. In particular, 'blockDeviceMapping' is returned as a raw hashrefs (there also seems to be an AWS bug that causes fetching this attribute to return an AuthFailure error). Please see the VM::EC2::Image launchPermissions() and blockDeviceMapping() methods for more convenient ways to get this data. =cut sub describe_image_attribute { my $self = shift; @_ == 2 or croak "Usage: describe_image_attribute(\$instance_id,\$attribute_name)"; my ($instance_id,$attribute) = @_; my @param = (ImageId=>$instance_id,Attribute=>$attribute); my $result = $self->call('DescribeImageAttribute',@param); return $result && $result->attribute($attribute); } =head2 $boolean = $ec2->modify_image_attribute($image_id,-$attribute_name=>$value) This method changes image attributes. The first argument is the image ID, and this is followed by the attribute name and the value to change it to. The following is the list of attributes that can be set: -launch_add_user -- scalar or arrayref of UserIds to grant launch permissions to -launch_add_group -- scalar or arrayref of Groups to remove launch permissions from (only currently valid value is "all") -launch_remove_user -- scalar or arrayref of UserIds to remove from launch permissions -launch_remove_group -- scalar or arrayref of Groups to remove from launch permissions -product_code -- scalar or array of product codes to add -description -- scalar new description You can abbreviate the launch permission arguments to -add_user, -add_group, -remove_user, -remove_group, etc. Only one attribute can be changed in a single request. For example: $ec2->modify_image_attribute('i-12345',-product_code=>['abcde','ghijk']); The result code is true if the attribute was successfully modified, false otherwise. In the latter case, $ec2->error() will provide the error message. To make an image public, specify -launch_add_group=>'all': $ec2->modify_image_attribute('i-12345',-launch_add_group=>'all'); Also see L for shortcut methods. For example: $image->add_authorized_users(1234567,999991); =cut sub modify_image_attribute { my $self = shift; my $image_id = shift or croak "Usage: modify_image_attribute(\$imageId,%param)"; my %args = @_; # shortcuts foreach (qw(add_user remove_user add_group remove_group)) { $args{"-launch_$_"} ||= $args{"-$_"}; } my @param = (ImageId=>$image_id); push @param,$self->value_parm('Description',\%args); push @param,$self->list_parm('ProductCode',\%args); push @param,$self->launch_perm_parm('Add','UserId', $args{-launch_add_user}); push @param,$self->launch_perm_parm('Remove','UserId',$args{-launch_remove_user}); push @param,$self->launch_perm_parm('Add','Group', $args{-launch_add_group}); push @param,$self->launch_perm_parm('Remove','Group', $args{-launch_remove_group}); return $self->call('ModifyImageAttribute',@param); } =head2 $boolean = $ec2->reset_image_attribute($image_id,$attribute_name) This method resets an attribute of the given snapshot to its default value. The valid attributes are: launchPermission =cut sub reset_image_attribute { my $self = shift; @_ == 2 or croak "Usage: reset_image_attribute(\$imageId,\$attribute_name)"; my ($image_id,$attribute) = @_; my %valid = map {$_=>1} qw(launchPermission); $valid{$attribute} or croak "attribute to reset must be one of ",join(' ',map{"'$_'"} keys %valid); return $self->call('ResetImageAttribute', ImageId => $image_id, Attribute => $attribute); } =head1 EC2 VOLUMES AND SNAPSHOTS The methods in this section allow you to query and manipulate EC2 EBS volumes and snapshots. See L and L for additional functionality provided through the object interface. =head2 @v = $ec2->describe_volumes(-volume_id=>\@ids,-filter=>\%filters) =head2 @v = $ec2->describe_volumes(@volume_ids) Return a series of VM::EC2::Volume objects. Optional arguments: -volume_id The id of the volume to fetch, either a string scalar or an arrayref. -filter One or more filters to apply to the search The -filter argument name can be omitted if there are no other arguments you wish to pass. The full list of volume filters can be found at: http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeVolumes.html =cut sub describe_volumes { my $self = shift; my %args = $self->args(-volume_id=>@_); my @params; push @params,$self->list_parm('VolumeId',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeVolumes',@params); } =head2 $v = $ec2->create_volume(-availability_zone=>$zone,-snapshot_id=>$snapshotId,-size=>$size) Create a volume in the specified availability zone and return information about it. Arguments: -availability_zone -- An availability zone from describe_availability_zones (required) -snapshot_id -- ID of a snapshot to use to build volume from. -size -- Size of the volume, in GB (between 1 and 1024). One or both of -snapshot_id or -size are required. For convenience, you may abbreviate -availability_zone as -zone, and -snapshot_id as -snapshot. Optional Arguments: -volume_type -- The volume type. standard or io1, default is standard -iops -- The number of I/O operations per second (IOPS) that the volume supports. Range is 100 to 2000. Required when volume type is io1. The returned object is a VM::EC2::Volume object. =cut sub create_volume { my $self = shift; my %args = @_; my $zone = $args{-availability_zone} || $args{-zone} or croak "-availability_zone argument is required"; my $snap = $args{-snapshot_id} || $args{-snapshot}; my $size = $args{-size}; $snap || $size or croak "One or both of -snapshot_id or -size are required"; if (exists $args{-volume_type} && $args{-volume_type} eq 'io1') { $args{-iops} or croak "Argument -iops required when -volume_type is 'io1'"; } elsif ($args{-iops}) { croak "Argument -iops cannot be used when volume type is 'standard'"; } my @params = (AvailabilityZone => $zone); push @params,(SnapshotId => $snap) if $snap; push @params,(Size => $size) if $size; push @params,$self->single_parm('VolumeType',\%args); push @params,$self->single_parm('Iops',\%args); return $self->call('CreateVolume',@params); } =head2 $result = $ec2->delete_volume($volume_id); Deletes the specified volume. Returns a boolean indicating success of the delete operation. Note that a volume will remain in the "deleting" state for some time after this call completes. =cut sub delete_volume { my $self = shift; my %args = $self->args(-volume_id => @_); my @param = $self->single_parm(VolumeId=>\%args); return $self->call('DeleteVolume',@param); } =head2 $attachment = $ec2->attach_volume($volume_id,$instance_id,$device); =head2 $attachment = $ec2->attach_volume(-volume_id=>$volume_id,-instance_id=>$instance_id,-device=>$device); Attaches the specified volume to the instance using the indicated device. All arguments are required: -volume_id -- ID of the volume to attach. The volume must be in "available" state. -instance_id -- ID of the instance to attach to. Both instance and attachment must be in the same availability zone. -device -- How the device is exposed to the instance, e.g. '/dev/sdg'. The result is a VM::EC2::BlockDevice::Attachment object which you can monitor by calling current_status(): my $a = $ec2->attach_volume('vol-12345','i-12345','/dev/sdg'); while ($a->current_status ne 'attached') { sleep 2; } print "volume is ready to go\n"; or more simply my $a = $ec2->attach_volume('vol-12345','i-12345','/dev/sdg'); $ec2->wait_for_attachments($a); =cut sub attach_volume { my $self = shift; my %args; if ($_[0] !~ /^-/ && @_ == 3) { @args{qw(-volume_id -instance_id -device)} = @_; } else { %args = @_; } $args{-volume_id} && $args{-instance_id} && $args{-device} or croak "-volume_id, -instance_id and -device arguments must all be specified"; my @param = $self->single_parm(VolumeId=>\%args); push @param,$self->single_parm(InstanceId=>\%args); push @param,$self->single_parm(Device=>\%args); return $self->call('AttachVolume',@param); } =head2 $attachment = $ec2->detach_volume($volume_id) =head2 $attachment = $ec2->detach_volume(-volume_id=>$volume_id,-instance_id=>$instance_id, -device=>$device, -force=>$force); Detaches the specified volume from an instance. -volume_id -- ID of the volume to detach. (required) -instance_id -- ID of the instance to detach from. (optional) -device -- How the device is exposed to the instance. (optional) -force -- Force detachment, even if previous attempts were unsuccessful. (optional) The result is a VM::EC2::BlockDevice::Attachment object which you can monitor by calling current_status(): my $a = $ec2->detach_volume('vol-12345'); while ($a->current_status ne 'detached') { sleep 2; } print "volume is ready to go\n"; Or more simply: my $a = $ec2->detach_volume('vol-12345'); $ec2->wait_for_attachments($a); print "volume is ready to go\n" if $a->current_status eq 'detached'; =cut sub detach_volume { my $self = shift; my %args = $self->args(-volume_id => @_); my @param = $self->single_parm(VolumeId=>\%args); push @param,$self->single_parm(InstanceId=>\%args); push @param,$self->single_parm(Device=>\%args); push @param,$self->single_parm(Force=>\%args); return $self->call('DetachVolume',@param); } =head2 @v = $ec2->describe_volume_status(@volume_ids) =head2 @v = $ec2->describe_volume_status(\%filters) =head2 @v = $ec2->describe_volume_status(-volume_id=>\@ids,-filter=>\%filters) Return a series of VM::EC2::Volume::StatusItem objects. Optional arguments: -volume_id The id of the volume to fetch, either a string scalar or an arrayref. -filter One or more filters to apply to the search -max_results Maximum number of items to return (must be more than 5). The -filter argument name can be omitted if there are no other arguments you wish to pass. The full list of volume filters can be found at: http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeVolumeStatus.html If -max_results is specified, then the call will return at most the number of volume status items you requested. You may see whether there are additional results by calling more_volume_status(), and then retrieve the next set of results with additional call(s) to describe_volume_status(): my @results = $ec2->describe_volume_status(-max_results => 10); do_something(\@results); while ($ec2->more_volume_status) { @results = $ec2->describe_volume_status; do_something(\@results); } =cut sub more_volume_status { my $self = shift; return $self->{volume_status_token} && !$self->{volume_status_stop}; } sub describe_volume_status { my $self = shift; my @parms; if (!@_ && $self->{volume_status_token} && $self->{volume_status_args}) { @parms = (@{$self->{volume_status_args}},NextToken=>$self->{volume_status_token}); } else { my %args = $self->args('-volume_id',@_); push @parms,$self->list_parm('VolumeId',\%args); push @parms,$self->filter_parm(\%args); push @parms,$self->single_parm('MaxResults',\%args); if ($args{-max_results}) { $self->{volume_status_token} = 'xyzzy'; # dummy value $self->{volume_status_args} = \@parms; } } return $self->call('DescribeVolumeStatus',@parms); } =head2 @data = $ec2->describe_volume_attribute($volume_id,$attribute) This method returns volume attributes. Only one attribute can be retrieved at a time. The following is the list of attributes that can be retrieved: autoEnableIO -- boolean productCodes -- list of scalar These values can be retrieved more conveniently from the L object returned from describe_volumes(): $volume->auto_enable_io(1); @codes = $volume->product_codes; =cut sub describe_volume_attribute { my $self = shift; @_ == 2 or croak "Usage: describe_volume_attribute(\$instance_id,\$attribute_name)"; my ($instance_id,$attribute) = @_; my @param = (VolumeId=>$instance_id,Attribute=>$attribute); my $result = $self->call('DescribeVolumeAttribute',@param); return $result && $result->attribute($attribute); } sub modify_volume_attribute { my $self = shift; my $volume_id = shift or croak "Usage: modify_volume_attribute(\$volumeId,%param)"; my %args = @_; my @param = (VolumeId=>$volume_id); push @param,('AutoEnableIO.Value'=>$args{-auto_enable_io} ? 'true':'false'); return $self->call('ModifyVolumeAttribute',@param); } =head2 $boolean = $ec2->enable_volume_io($volume_id) =head2 $boolean = $ec2->enable_volume_io(-volume_id=>$volume_id) Given the ID of a volume whose I/O has been disabled (e.g. due to hardware degradation), this method will reenable the I/O and return true if successful. =cut sub enable_volume_io { my $self = shift; my %args = $self->args('-volume_id',@_); $args{-volume_id} or croak "Usage: enable_volume_io(\$volume_id)"; my @param = $self->single_parm('VolumeId',\%args); return $self->call('EnableVolumeIO',@param); } =head2 @snaps = $ec2->describe_snapshots(@snapshot_ids) =head2 @snaps = $ec2->describe_snapshots(-snapshot_id=>\@ids,%other_args) Returns a series of VM::EC2::Snapshot objects. All arguments are optional: -snapshot_id ID of the snapshot -owner Filter by owner ID -restorable_by Filter by IDs of a user who is allowed to restore the snapshot -filter Tags and other filters The -filter argument name can be omitted if there are no other arguments you wish to pass. The full list of applicable filters can be found at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeSnapshots.html =cut sub describe_snapshots { my $self = shift; my %args = $self->args('-snapshot_id',@_); my @params; push @params,$self->list_parm('SnapshotId',\%args); push @params,$self->list_parm('Owner',\%args); push @params,$self->list_parm('RestorableBy',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeSnapshots',@params); } =head2 @data = $ec2->describe_snapshot_attribute($snapshot_id,$attribute) This method returns snapshot attributes. The first argument is the snapshot ID, and the second is the name of the attribute to fetch. Currently Amazon defines two attributes: createVolumePermission -- return a list of user Ids who are allowed to create volumes from this snapshot. productCodes -- product codes for this snapshot The result is a raw hash of attribute values. Please see L for a more convenient way of accessing and modifying snapshot attributes. =cut sub describe_snapshot_attribute { my $self = shift; @_ == 2 or croak "Usage: describe_snapshot_attribute(\$instance_id,\$attribute_name)"; my ($snapshot_id,$attribute) = @_; my @param = (SnapshotId=>$snapshot_id,Attribute=>$attribute); my $result = $self->call('DescribeSnapshotAttribute',@param); return $result && $result->attribute($attribute); } =head2 $boolean = $ec2->modify_snapshot_attribute($snapshot_id,-$argument=>$value) This method changes snapshot attributes. The first argument is the snapshot ID, and this is followed by an attribute modification command and the value to change it to. Currently the only attribute that can be changed is the createVolumeAttribute. This is done through the following arguments -createvol_add_user -- scalar or arrayref of UserIds to grant create volume permissions to -createvol_add_group -- scalar or arrayref of Groups to remove create volume permissions from (only currently valid value is "all") -createvol_remove_user -- scalar or arrayref of UserIds to remove from create volume permissions -createvol_remove_group -- scalar or arrayref of Groups to remove from create volume permissions You can abbreviate these to -add_user, -add_group, -remove_user, -remove_group, etc. See L for more convenient methods for interrogating and modifying the create volume permissions. =cut sub modify_snapshot_attribute { my $self = shift; my $snapshot_id = shift or croak "Usage: modify_snapshot_attribute(\$snapshotId,%param)"; my %args = @_; # shortcuts foreach (qw(add_user remove_user add_group remove_group)) { $args{"-createvol_$_"} ||= $args{"-$_"}; } my @param = (SnapshotId=>$snapshot_id); push @param,$self->create_volume_perm_parm('Add','UserId', $args{-createvol_add_user}); push @param,$self->create_volume_perm_parm('Remove','UserId',$args{-createvol_remove_user}); push @param,$self->create_volume_perm_parm('Add','Group', $args{-createvol_add_group}); push @param,$self->create_volume_perm_parm('Remove','Group', $args{-createvol_remove_group}); return $self->call('ModifySnapshotAttribute',@param); } =head2 $boolean = $ec2->reset_snapshot_attribute($snapshot_id,$attribute) This method resets an attribute of the given snapshot to its default value. The only valid attribute at this time is "createVolumePermission." =cut sub reset_snapshot_attribute { my $self = shift; @_ == 2 or croak "Usage: reset_snapshot_attribute(\$snapshotId,\$attribute_name)"; my ($snapshot_id,$attribute) = @_; my %valid = map {$_=>1} qw(createVolumePermission); $valid{$attribute} or croak "attribute to reset must be 'createVolumePermission'"; return $self->call('ResetSnapshotAttribute', SnapshotId => $snapshot_id, Attribute => $attribute); } =head2 $snapshot = $ec2->create_snapshot($volume_id) =head2 $snapshot = $ec2->create_snapshot(-volume_id=>$vol,-description=>$desc) Snapshot the EBS volume and store it to S3 storage. To ensure a consistent snapshot, the volume should be unmounted prior to initiating this operation. Arguments: -volume_id -- ID of the volume to snapshot (required) -description -- A description to add to the snapshot (optional) The return value is a VM::EC2::Snapshot object that can be queried through its current_status() interface to follow the progress of the snapshot operation. Another way to accomplish the same thing is through the VM::EC2::Volume interface: my $volume = $ec2->describe_volumes(-filter=>{'tag:Name'=>'AccountingData'}); $s = $volume->create_snapshot("Backed up at ".localtime); while ($s->current_status eq 'pending') { print "Progress: ",$s->progress,"% done\n"; } print "Snapshot status: ",$s->current_status,"\n"; =cut sub create_snapshot { my $self = shift; my %args = $self->args('-volume_id',@_); my @params = $self->single_parm('VolumeId',\%args); push @params,$self->single_parm('Description',\%args); return $self->call('CreateSnapshot',@params); } =head2 $boolean = $ec2->delete_snapshot($snapshot_id) Delete the indicated snapshot and return true if the request was successful. =cut sub delete_snapshot { my $self = shift; my %args = $self->args('-snapshot_id',@_); my @params = $self->single_parm('SnapshotId',\%args); return $self->call('DeleteSnapshot',@params); } =head2 $snapshot = $ec2->copy_snapshot(-source_region=>$region,-source_snapshot_id=>$id,-description=>$desc) Copies an existing snapshot within the same region or from one region to another. Required arguments: -region -- The region the existing snapshot to copy resides in -snapshot_id -- The snapshot ID of the snapshot to copy Optional arguments: -description -- A description of the new snapshot The return value is a VM::EC2::Snapshot object that can be queried through its current_status() interface to follow the progress of the snapshot operation. =cut sub copy_snapshot { my $self = shift; my %args = @_; $args{-description} ||= $args{-desc}; $args{-source_region} ||= $args{-region}; $args{-source_snapshot_id} ||= $args{-snapshot_id}; $args{-source_region} or croak "copy_snapshot(): -source_region argument required"; $args{-source_snapshot_id} or croak "copy_snapshot(): -source_snapshot_id argument required"; # As of 2012-12-22, sourceRegion, sourceSnapshotId are not recognized even though API docs specify those as the parameters # The initial 's' must be capitalized. This has been reported to AWS as an inconsistency in the docs and API. my @params = $self->single_parm('SourceRegion',\%args); push @params, $self->single_parm('SourceSnapshotId',\%args); push @params, $self->single_parm('Description',\%args); my $snap_id = $self->call('CopySnapshot',@params); return $snap_id && $self->describe_snapshots($snap_id); } =head1 SECURITY GROUPS AND KEY PAIRS The methods in this section allow you to query and manipulate security groups (firewall rules) and SSH key pairs. See L and L for functionality that is available through these objects. =head2 @sg = $ec2->describe_security_groups(@group_ids) =head2 @sg = $ec2->describe_security_groups(%args); =head2 @sg = $ec2->describe_security_groups(\%filters); Searches for security groups (firewall rules) matching the provided filters and return a series of VM::EC2::SecurityGroup objects. In the named-argument form you can provide the following optional arguments: -group_name A single group name or an arrayref containing a list of names -name Shorter version of -group_name -group_id A single group id (i.e. 'sg-12345') or an arrayref containing a list of ids -filter Filter on tags and other attributes. The -filter argument name can be omitted if there are no other arguments you wish to pass. The full list of security group filters can be found at: http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeSecurityGroups.html =cut sub describe_security_groups { my $self = shift; my %args = $self->args(-group_id=>@_); $args{-group_name} ||= $args{-name}; my @params = map { $self->list_parm($_,\%args) } qw(GroupName GroupId); push @params,$self->filter_parm(\%args); return $self->call('DescribeSecurityGroups',@params); } =head2 $group = $ec2->create_security_group(-group_name=>$name, -group_description=>$description, -vpc_id => $vpc_id ) Create a security group. Arguments are: -group_name Name of the security group (required) -group_description Description of the security group (required) -vpc_id Virtual private cloud security group ID (required for VPC security groups) For convenience, you may use -name and -description as aliases for -group_name and -group_description respectively. If succcessful, the method returns an object of type L. =cut sub create_security_group { my $self = shift; my %args = @_; $args{-group_name} ||= $args{-name}; $args{-group_description} ||= $args{-description}; $args{-group_name} && $args{-group_description} or croak "create_security_group() requires -group_name and -group_description arguments"; my @param; push @param,$self->single_parm($_=>\%args) foreach qw(GroupName GroupDescription VpcId); my $g = $self->call('CreateSecurityGroup',@param) or return; return $self->describe_security_groups($g); } =head2 $boolean = $ec2->delete_security_group($group_id) =head2 $boolean = $ec2->delete_security_group(-group_id => $group_id, -group_name => $name); Delete a security group. Arguments are: -group_name Name of the security group -group_id ID of the security group Either -group_name or -group_id is required. In the single-argument form, the method deletes the security group given by its id. If succcessful, the method returns true. =cut sub delete_security_group { my $self = shift; my %args = $self->args(-group_id=>@_); $args{-group_name} ||= $args{-name}; my @param = $self->single_parm(GroupName=>\%args); push @param,$self->single_parm(GroupId=>\%args); return $self->call('DeleteSecurityGroup',@param); } =head2 $boolean = $ec2->update_security_group($security_group) Add one or more incoming firewall rules to a security group. The rules to add are stored in a L which is created either by describe_security_groups() or create_security_group(). This method combines the actions AuthorizeSecurityGroupIngress, AuthorizeSecurityGroupEgress, RevokeSecurityGroupIngress, and RevokeSecurityGroupEgress. For details, see L. Here is a brief summary: $sg = $ec2->create_security_group(-name=>'MyGroup',-description=>'Example group'); # TCP on port 80 for the indicated address ranges $sg->authorize_incoming(-protocol => 'tcp', -port => 80, -source_ip => ['192.168.2.0/24','192.168.2.1/24'}); # TCP on ports 22 and 23 from anyone $sg->authorize_incoming(-protocol => 'tcp', -port => '22..23', -source_ip => '0.0.0.0/0'); # ICMP on echo (ping) port from anyone $sg->authorize_incoming(-protocol => 'icmp', -port => 0, -source_ip => '0.0.0.0/0'); # TCP to port 25 (mail) from instances belonging to # the "Mail relay" group belonging to user 12345678. $sg->authorize_incoming(-protocol => 'tcp', -port => 25, -group => '12345678/Mail relay'); $result = $ec2->update_security_group($sg); or more simply: $result = $sg->update(); =cut sub update_security_group { my $self = shift; my $sg = shift; my $group_id = $sg->groupId; my $result = 1; for my $action (qw(Authorize Revoke)) { for my $direction (qw(Ingress Egress)) { my @permissions = $sg->_uncommitted_permissions($action,$direction) or next; my $call = "${action}SecurityGroup${direction}"; my @param = (GroupId=>$group_id); push @param,$self->_security_group_parm(\@permissions); my $r = $self->call($call=>@param); $result &&= $r; } } return $result; } sub _security_group_parm { my $self = shift; my $permissions = shift; my @param; for (my $i=0;$i<@$permissions;$i++) { my $perm = $permissions->[$i]; my $n = $i+1; push @param,("IpPermissions.$n.IpProtocol"=>$perm->ipProtocol); push @param,("IpPermissions.$n.FromPort" => $perm->fromPort); push @param,("IpPermissions.$n.ToPort" => $perm->toPort); my @cidr = $perm->ipRanges; for (my $i=0;$i<@cidr;$i++) { my $m = $i+1; push @param,("IpPermissions.$n.IpRanges.$m.CidrIp"=>$cidr[$i]); } my @groups = $perm->groups; for (my $i=0;$i<@groups;$i++) { my $m = $i+1; my $group = $groups[$i]; if (defined $group->groupId) { push @param,("IpPermissions.$n.Groups.$m.GroupId" => $group->groupId); } else { push @param,("IpPermissions.$n.Groups.$m.UserId" => $group->userId); push @param,("IpPermissions.$n.Groups.$m.GroupName"=> $group->groupName); } } } return @param; } =head2 @keys = $ec2->describe_key_pairs(@names); =head2 @keys = $ec2->describe_key_pairs(\%filters); =head2 @keys = $ec2->describe_key_pairs(-key_name => \@names, -filter => \%filters); Searches for ssh key pairs matching the provided filters and return a series of VM::EC2::KeyPair objects. Optional arguments: -key_name A single key name or an arrayref containing a list of names -filter Filter on tags and other attributes. The full list of key filters can be found at: http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeKeyPairs.html =cut sub describe_key_pairs { my $self = shift; my %args = $self->args(-key_name=>@_); my @params = $self->list_parm('KeyName',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeKeyPairs',@params); } =head2 $key = $ec2->create_key_pair($name) Create a new key pair with the specified name (required). If the key pair already exists, returns undef. The contents of the new keypair, including the PEM-encoded private key, is contained in the returned VM::EC2::KeyPair object: my $key = $ec2->create_key_pair('My Keypair'); if ($key) { print $key->fingerprint,"\n"; print $key->privateKey,"\n"; } =cut sub create_key_pair { my $self = shift; my $name = shift or croak "Usage: create_key_pair(\$name)"; $name =~ /^[\w _-]+$/ or croak "Invalid keypair name: must contain only alphanumerics, spaces, dashes and underscores"; my @params = (KeyName=>$name); $self->call('CreateKeyPair',@params); } =head2 $key = $ec2->import_key_pair($name,$public_key) =head2 $key = $ec2->import_key_pair(-key_name => $name, -public_key_material => $public_key) Imports a preexisting public key into AWS under the specified name. If successful, returns a VM::EC2::KeyPair. The public key must be an RSA key of length 1024, 2048 or 4096. The method can be called with two unnamed arguments consisting of the key name and the public key material, or in a named argument form with the following argument names: -key_name -- desired name for the imported key pair (required) -name -- shorter version of -key_name -public_key_material -- public key data (required) -public_key -- shorter version of the above This example uses Net::SSH::Perl::Key to generate a new keypair, and then uploads the public key to Amazon. use Net::SSH::Perl::Key; my $newkey = Net::SSH::Perl::Key->keygen('RSA',1024); $newkey->write_private('.ssh/MyKeypair.rsa'); # save private parts my $key = $ec2->import_key_pair('My Keypair' => $newkey->dump_public) or die $ec2->error; print "My Keypair added with fingerprint ",$key->fingerprint,"\n"; Several different formats are accepted for the key, including SSH "authorized_keys" format (generated by L and Net::SSH::Perl::Key), the SSH public keys format, and DER format. You do not need to base64-encode the key or perform any other pre-processing. Note that the algorithm used by Amazon to calculate its key fingerprints differs from the one used by the ssh library, so don't try to compare the key fingerprints returned by Amazon to the ones produced by ssh-keygen or Net::SSH::Perl::Key. =cut sub import_key_pair { my $self = shift; my %args; if (@_ == 2 && $_[0] !~ /^-/) { %args = (-key_name => shift, -public_key_material => shift); } else { %args = @_; } my $name = $args{-key_name} || $args{-name} or croak "-key_name argument required"; my $pkm = $args{-public_key_material}|| $args{-public_key} or croak "-public_key_material argument required"; my @params = (KeyName => $name,PublicKeyMaterial=>encode_base64($pkm)); $self->call('ImportKeyPair',@params); } =head2 $result = $ec2->delete_key_pair($name) Deletes the key pair with the specified name (required). Returns true if successful. =cut sub delete_key_pair { my $self = shift; my $name = shift or croak "Usage: delete_key_pair(\$name)"; $name =~ /^[\w _-]+$/ or croak "Invalid keypair name: must contain only alphanumerics, spaces, dashes and underscores"; my @params = (KeyName=>$name); $self->call('DeleteKeyPair',@params); } =head1 TAGS These methods allow you to create, delete and fetch resource tags. You may find that you rarely need to use these methods directly because every object produced by VM::EC2 supports a simple tag interface: $object = $ec2->describe_volumes(-volume_id=>'vol-12345'); # e.g. $tags = $object->tags(); $name = $tags->{Name}; $object->add_tags(Role => 'Web Server', Status=>'development); $object->delete_tags(Name=>undef); See L for a full description of the uniform object tagging interface. These methods are most useful when creating and deleting tags for multiple resources simultaneously. =head2 @t = $ec2->describe_tags(-filter=>\%filters); Return a series of VM::EC2::Tag objects, each describing an AMI. A single optional -filter argument is allowed. Available filters are: key, resource-id, resource-type and value. See http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeTags.html =cut sub describe_tags { my $self = shift; my %args = @_; my @params = $self->filter_parm(\%args); return $self->call('DescribeTags',@params); } =head2 $bool = $ec2->create_tags(-resource_id=>\@ids,-tag=>{key1=>value1...}) Tags the resource indicated by -resource_id with the tag(s) in in the hashref indicated by -tag. You may specify a single resource by passing a scalar resourceId to -resource_id, or multiple resources using an anonymous array. Returns a true value if tagging was successful. The method name "add_tags()" is an alias for create_tags(). You may find it more convenient to tag an object retrieved with any of the describe() methods using the built-in add_tags() method: @snap = $ec2->describe_snapshots(-filter=>{status=>'completed'}); foreach (@snap) {$_->add_tags(ReadyToUse => 'true')} but if there are many snapshots to tag simultaneously, this will be faster: @snap = $ec2->describe_snapshots(-filter=>{status=>'completed'}); $ec2->add_tags(-resource_id=>\@snap,-tag=>{ReadyToUse=>'true'}); Note that you can tag volumes, snapshots and images owned by other people. Only you will be able to see these tags. =cut sub create_tags { my $self = shift; my %args = @_; $args{-resource_id} or croak "create_tags() -resource_id argument required"; $args{-tag} or croak "create_tags() -tag argument required"; my @params = $self->list_parm('ResourceId',\%args); push @params,$self->tagcreate_parm(\%args); return $self->call('CreateTags',@params); } sub add_tags { shift->create_tags(@_) } =head2 $bool = $ec2->delete_tags(-resource_id=>$id1,-tag=>{key1=>value1...}) Delete the indicated tags from the indicated resource. Pass an arrayref to operate on several resources at once. The tag syntax is a bit tricky. Use a value of undef to delete the tag unconditionally: -tag => { Role => undef } # deletes any Role tag Any scalar value will cause the tag to be deleted only if its value exactly matches the specified value: -tag => { Role => 'Server' } # only delete the Role tag # if it currently has the value "Server" An empty string value ('') will only delete the tag if its value is an empty string, which is probably not what you want. Pass an array reference of tag names to delete each of the tag names unconditionally (same as passing a value of undef): $ec2->delete_tags(['Name','Role','Description']); You may find it more convenient to delete tags from objects using their delete_tags() method: @snap = $ec2->describe_snapshots(-filter=>{status=>'completed'}); foreach (@snap) {$_->delete_tags(Role => undef)} =cut sub delete_tags { my $self = shift; my %args = @_; $args{-resource_id} or croak "create_tags() -resource_id argument required"; $args{-tag} or croak "create_tags() -tag argument required"; my @params = $self->list_parm('ResourceId',\%args); push @params,$self->tagdelete_parm(\%args); return $self->call('DeleteTags',@params); } =head1 ELASTIC IP ADDRESSES The methods in this section allow you to allocate elastic IP addresses, attach them to instances, and delete them. See L. =head2 @addr = $ec2->describe_addresses(@public_ips) =head2 @addr = $ec2->describe_addresses(-public_ip=>\@addr,-allocation_id=>\@id,-filter->\%filters) Queries AWS for a list of elastic IP addresses already allocated to you. All arguments are optional: -public_ip -- An IP address (in dotted format) or an arrayref of addresses to return information about. -allocation_id -- An allocation ID or arrayref of such IDs. Only applicable to VPC addresses. -filter -- A hashref of tag=>value pairs to filter the response on. The list of applicable filters can be found at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeAddresses.html. This method returns a list of L. =cut sub describe_addresses { my $self = shift; my %args = $self->args(-public_ip=>@_); my @param; push @param,$self->list_parm('PublicIp',\%args); push @param,$self->list_parm('AllocationId',\%args); push @param,$self->filter_parm(\%args); return $self->call('DescribeAddresses',@param); } =head2 $address_info = $ec2->allocate_address([-vpc=>1]) Request an elastic IP address. Pass -vpc=>1 to allocate a VPC elastic address. The return object is a VM::EC2::ElasticAddress. =cut sub allocate_address { my $self = shift; my %args = @_; my @param = $args{-vpc} ? (Domain=>'vpc') : (); return $self->call('AllocateAddress',@param); } =head2 $boolean = $ec2->release_address($addr) Release an elastic IP address. For non-VPC addresses, you may provide either an IP address string, or a VM::EC2::ElasticAddress. For VPC addresses, you must obtain a VM::EC2::ElasticAddress first (e.g. with describe_addresses) and then pass that to the method. =cut sub release_address { my $self = shift; my $addr = shift or croak "Usage: release_address(\$addr)"; my @param = (PublicIp=>$addr); if (my $allocationId = eval {$addr->allocationId}) { push @param,(AllocatonId=>$allocationId); } return $self->call('ReleaseAddress',@param); } =head2 $result = $ec2->associate_address($elastic_addr => $instance_id) Associate an elastic address with an instance id. Both arguments are mandatory. If you are associating a VPC elastic IP address with the instance, the result code will indicate the associationId. Otherwise it will be a simple perl truth value ("1") if successful, undef if false. If this is an ordinary EC2 Elastic IP address, the first argument may either be an ordinary string (xx.xx.xx.xx format) or a VM::EC2::ElasticAddress object. However, if it is a VPC elastic IP address, then the argument must be a VM::EC2::ElasticAddress as returned by describe_addresses(). The reason for this is that the allocationId must be retrieved from the object in order to use in the call. =cut sub associate_address { my $self = shift; @_ == 2 or croak "Usage: associate_address(\$elastic_addr => \$instance_id)"; my ($addr,$instance) = @_; my @param = (InstanceId=>$instance); push @param,eval {$addr->domain eq 'vpc'} ? (AllocationId => $addr->allocationId) : (PublicIp => $addr); return $self->call('AssociateAddress',@param); } =head2 $bool = $ec2->disassociate_address($elastic_addr) Disassociate an elastic address from whatever instance it is currently associated with, if any. The result will be true if disassociation was successful. If this is an ordinary EC2 Elastic IP address, the argument may either be an ordinary string (xx.xx.xx.xx format) or a VM::EC2::ElasticAddress object. However, if it is a VPC elastic IP address, then the argument must be a VM::EC2::ElasticAddress as returned by describe_addresses(). The reason for this is that the allocationId must be retrieved from the object in order to use in the call. =cut sub disassociate_address { my $self = shift; @_ == 1 or croak "Usage: associate_address(\$elastic_addr)"; my $addr = shift; my @param = eval {$addr->domain eq 'vpc'} ? (AssociationId => $addr->associationId) : (PublicIp => $addr); return $self->call('DisassociateAddress',@param); } =head1 RESERVED INSTANCES These methods apply to describing, purchasing and using Reserved Instances. =head2 @offerings = $ec2->describe_reserved_instances_offerings(@offering_ids) =head2 @offerings = $ec2->describe_reserved_instances_offerings(%args) This method returns a list of the reserved instance offerings currently available for purchase. The arguments allow you to filter the offerings according to a variety of filters. All arguments are optional. If no named arguments are used, then the arguments are treated as Reserved Instance Offering IDs. -reserved_instances_offering_id A scalar or arrayref of reserved instance offering IDs -instance_type The instance type on which the reserved instance can be used, e.g. "c1.medium" -availability_zone, -zone The availability zone in which the reserved instance can be used. -product_description The reserved instance description. Valid values are "Linux/UNIX", "Linux/UNIX (Amazon VPC)", "Windows", and "Windows (Amazon VPC)" -instance_tenancy The tenancy of the reserved instance offering, either "default" or "dedicated". (VPC instances only) -offering_type The reserved instance offering type, one of "Heavy Utilization", "Medium Utilization", or "Light Utilization". -filter A set of filters to apply. For available filters, see http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeReservedInstancesOfferings.html. The returned objects are of type L This can be combined with the Offering purchase() method as shown here: @offerings = $ec2->describe_reserved_instances_offerings( {'availability-zone' => 'us-east-1a', 'instance-type' => 'c1.medium', 'product-description' =>'Linux/UNIX', 'duration' => 31536000, # this is 1 year }); $offerings[0]->purchase(5) and print "Five reserved instances purchased\n"; =cut sub describe_reserved_instances_offerings { my $self = shift; my %args = $self->args('-reserved_instances_offering_id',@_); $args{-availability_zone} ||= $args{-zone}; my @param = $self->list_parm('ReservedInstancesOfferingId',\%args); push @param,$self->single_parm('ProductDescription',\%args); push @param,$self->single_parm('InstanceType',\%args); push @param,$self->single_parm('AvailabilityZone',\%args); push @param,$self->single_parm('instanceTenancy',\%args); # should initial "i" be upcase? push @param,$self->single_parm('offeringType',\%args); # should initial "o" be upcase? push @param,$self->filter_parm(\%args); return $self->call('DescribeReservedInstancesOfferings',@param); } =head $id = $ec2->purchase_reserved_instances_offering($offering_id) =head $id = $ec2->purchase_reserved_instances_offering(%args) Purchase one or more reserved instances based on an offering. Arguments: -reserved_instances_offering_id, -id -- The reserved instance offering ID to purchase (required). -instance_count, -count -- Number of instances to reserve under this offer (optional, defaults to 1). Returns a Reserved Instances Id on success, undef on failure. Also see the purchase() method of L. =cut sub purchase_reserved_instances_offering { my $self = shift; my %args = $self->args('-reserved_instances_offering_id'=>@_); $args{-reserved_instances_offering_id} ||= $args{-id}; $args{-reserved_instances_offering_id} or croak "purchase_reserved_instances_offering(): the -reserved_instances_offering_id argument is required"; $args{-instance_count} ||= $args{-count}; my @param = $self->single_parm('ReservedInstancesOfferingId',\%args); push @param,$self->single_parm('InstanceCount',\%args); return $self->call('PurchaseReservedInstancesOffering',@param); } =head2 @res_instances = $ec2->describe_reserved_instances(@res_instance_ids) =head2 @res_instances = $ec2->describe_reserved_instances(%args) This method returns a list of the reserved instances that you currently own. The information returned includes the type of instances that the reservation allows you to launch, the availability zone, and the cost per hour to run those reserved instances. All arguments are optional. If no named arguments are used, then the arguments are treated as Reserved Instance IDs. -reserved_instances_id -- A scalar or arrayref of reserved instance IDs -filter -- A set of filters to apply. For available filters, see http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeReservedInstances.html. The returned objects are of type L =cut sub describe_reserved_instances { my $self = shift; my %args = $self->args('-reserved_instances_id',@_); my @param = $self->list_parm('ReservedInstancesId',\%args); push @param,$self->filter_parm(\%args); return $self->call('DescribeReservedInstances',@param); } =head1 SPOT INSTANCES These methods allow you to request spot instances and manipulte spot data feed subscriptoins. =cut =head2 $subscription = $ec2->create_spot_datafeed_subscription($bucket,$prefix) This method creates a spot datafeed subscription. Provide the method with the name of an S3 bucket associated with your account, and a prefix to be appended to the files written by the datafeed. Spot instance usage logs will be written into the requested bucket, and prefixed with the desired prefix. If no prefix is specified, it defaults to "SPOT_DATAFEED_"; On success, a VM::EC2::Spot::DatafeedSubscription object is returned; Only one datafeed is allowed per account; =cut sub create_spot_datafeed_subscription { my $self = shift; my ($bucket,$prefix) = @_; $bucket or croak "Usage: create_spot_datafeed_subscription(\$bucket,\$prefix)"; $prefix ||= 'SPOT_DATAFEED_'; my @param = (Bucket => $bucket, Prefix => $prefix); return $self->call('CreateSpotDatafeedSubscription',@param); } =head2 $boolean = $ec2->delete_spot_datafeed_subscription() This method delete's the current account's spot datafeed subscription, if any. It takes no arguments. On success, it returns true. =cut sub delete_spot_datafeed_subscription { my $self = shift; return $self->call('DeleteSpotDatafeedSubscription'); } =head2 $subscription = $ec2->describe_spot_datafeed_subscription() This method describes the current account's spot datafeed subscription, if any. It takes no arguments. On success, a VM::EC2::Spot::DatafeedSubscription object is returned; =cut sub describe_spot_datafeed_subscription { my $self = shift; return $self->call('DescribeSpotDatafeedSubscription'); } =head2 @spot_price_history = $ec2->describe_spot_price_history(@filters) This method applies the specified filters to spot instances and returns a list of instances, timestamps and their price at the indicated time. Each spot price history point is represented as a VM::EC2::Spot::PriceHistory object. Option arguments are: -start_time Start date and time of the desired history data, in the form yyyy-mm-ddThh:mm:ss (GMT). The Perl DateTime module provides a convenient way to create times in this format. -end_time End date and time of the desired history data. -instance_type The instance type, e.g. "m1.small", can be a scalar value or an arrayref. -product_description The product description. One of "Linux/UNIX", "SUSE Linux" or "Windows". Can be a scalar value or an arrayref. -availability_zone A single availability zone, such as "us-east-1a". -max_results Maximum number of rows to return in a single call. -next_token Specifies the next set of results to return; used internally. -filter Hashref containing additional filters to apply, The following filters are recognized: "instance-type", "product-description", "spot-price", "timestamp", "availability-zone". The '*' and '?' wildcards can be used in filter values, but numeric comparison operations are not supported by the Amazon API. Note that wildcards are not generally allowed in the standard options. Hence if you wish to get spot price history in all availability zones in us-east, this will work: $ec2->describe_spot_price_history(-filter=>{'availability-zone'=>'us-east*'}) but this will return an invalid parameter error: $ec2->describe_spot_price_history(-availability_zone=>'us-east*') If you specify -max_results, then the list of history objects returned may not represent the complete result set. In this case, the method more_spot_prices() will return true. You can then call describe_spot_price_history() repeatedly with no arguments in order to retrieve the remainder of the results. When there are no more results, more_spot_prices() will return false. my @results = $ec2->describe_spot_price_history(-max_results => 20, -instance_type => 'm1.small', -availability_zone => 'us-east*', -product_description=>'Linux/UNIX'); print_history(\@results); while ($ec2->more_spot_prices) { @results = $ec2->describe_spot_price_history print_history(\@results); } =cut sub more_spot_prices { my $self = shift; return $self->{spot_price_history_token} && !$self->{spot_price_history_stop}; } sub describe_spot_price_history { my $self = shift; my @parms; if (!@_ && $self->{spot_price_history_token} && $self->{price_history_args}) { @parms = (@{$self->{price_history_args}},NextToken=>$self->{spot_price_history_token}); } else { my %args = $self->args('-filter',@_); push @parms,$self->single_parm($_,\%args) foreach qw(StartTime EndTime MaxResults AvailabilityZone); push @parms,$self->list_parm($_,\%args) foreach qw(InstanceType ProductDescription); push @parms,$self->filter_parm(\%args); if ($args{-max_results}) { $self->{spot_price_history_token} = 'xyzzy'; # dummy value $self->{price_history_args} = \@parms; } } return $self->call('DescribeSpotPriceHistory',@parms); } =head2 @requests = $ec2->request_spot_instances(%args) This method will request one or more spot instances to be launched when the current spot instance run-hour price drops below a preset value and terminated when the spot instance run-hour price exceeds the value. On success, will return a series of VM::EC2::Spot::InstanceRequest objects, one for each instance specified in -instance_count. =over 4 =item Required arguments: -spot_price The desired spot price, in USD. -image_id ID of an AMI to launch -instance_type Type of the instance(s) to launch, such as "m1.small" =item Optional arguments: -instance_count Maximum number of instances to launch (default 1) -type Spot instance request type; one of "one-time" or "persistent" -valid_from Date/time the request becomes effective, in format yyyy-mm-ddThh:mm:ss. Default is immediately. -valid_until Date/time the request expires, in format yyyy-mm-ddThh:mm:ss. Default is to remain in effect indefinitely. -launch_group Name of the launch group. Instances in the same launch group are started and terminated together. Default is to launch instances independently. -availability_zone_group If specified, all instances that are given the same zone group name will be launched into the same availability zone. This is independent of the -availability_zone argument, which specifies a particular availability zone. -key_name Name of the keypair to use -security_group_id Security group ID to use for this instance. Use an arrayref for multiple group IDs -security_group Security group name to use for this instance. Use an arrayref for multiple values. -user_data User data to pass to the instances. Do NOT base64 encode this. It will be done for you. -availability_zone The availability zone you want to launch the instance into. Call $ec2->regions for a list. -zone Short version of -availability_aone. -placement_group An existing placement group to launch the instance into. Applicable to cluster instances only. -placement_tenancy Specify 'dedicated' to launch the instance on a dedicated server. Only applicable for VPC instances. -kernel_id ID of the kernel to use for the instances, overriding the kernel specified in the image. -ramdisk_id ID of the ramdisk to use for the instances, overriding the ramdisk specified in the image. -block_devices Specify block devices to map onto the instances, overriding the values specified in the image. See run_instances() for the syntax of this argument. -block_device_mapping Alias for -block_devices. -network_interfaces Same as the -network_interfaces option in run_instances(). -monitoring Pass a true value to enable detailed monitoring. -subnet The ID of the Amazon VPC subnet in which to launch the spot instance (VPC only). -subnet_id deprecated -addressing_type Deprecated and undocumented, but present in the current EC2 API documentation. -iam_arn The Amazon resource name (ARN) of the IAM Instance Profile (IIP) to associate with the instances. -iam_name The name of the IAM instance profile (IIP) to associate with the instances. -ebs_optimized If true, request an EBS-optimized instance (certain instance types only). =cut sub request_spot_instances { my $self = shift; my %args = @_; $args{-spot_price} or croak "-spot_price argument missing"; $args{-image_id} or croak "-image_id argument missing"; $args{-instance_type} or croak "-instance_type argument missing"; $args{-availability_zone} ||= $args{-zone}; $args{-availability_zone} ||= $args{-placement_zone}; my @p = map {$self->single_parm($_,\%args)} qw(SpotPrice InstanceCount Type ValidFrom ValidUntil LaunchGroup AvailabilityZoneGroup Subnet); # oddly enough, the following args need to be prefixed with "LaunchSpecification." my @launch_spec = map {$self->single_parm($_,\%args)} qw(ImageId KeyName UserData AddressingType InstanceType KernelId RamdiskId SubnetId); push @launch_spec, map {$self->list_parm($_,\%args)} qw(SecurityGroup SecurityGroupId); push @launch_spec, ('EbsOptimized'=>'true') if $args{-ebs_optimized}; push @launch_spec, $self->block_device_parm($args{-block_devices}||$args{-block_device_mapping}); push @launch_spec, $self->iam_parm(\%args); push @launch_spec, $self->network_interface_parm(\%args); while (my ($key,$value) = splice(@launch_spec,0,2)) { push @p,("LaunchSpecification.$key" => $value); } # a few more oddballs push @p,('LaunchSpecification.Placement.AvailabilityZone'=> $args{-availability_zone}) if $args{-availability_zone}; push @p,('Placement.GroupName' =>$args{-placement_group}) if $args{-placement_group}; push @p,('LaunchSpecification.Monitoring.Enabled' => 'true') if $args{-monitoring}; push @p,('LaunchSpecification.UserData' => encode_base64($args{-user_data},'')) if $args{-user_data}; return $self->call('RequestSpotInstances',@p); } =head2 @requests = $ec2->cancel_spot_instance_requests(@request_ids) This method cancels the pending requests. It does not terminate any instances that are already running as a result of the requests. It returns a list of VM::EC2::Spot::InstanceRequest objects, whose fields will be unpopulated except for spotInstanceRequestId and state. =cut sub cancel_spot_instance_requests { my $self = shift; my %args = $self->args('-spot_instance_request_id',@_); my @parm = $self->list_parm('SpotInstanceRequestId',\%args); return $self->call('CancelSpotInstanceRequests',@parm); } =head2 @requests = $ec2->describe_spot_instance_requests(@spot_instance_request_ids) =head2 @requests = $ec2->describe_spot_instance_requests(\%filters) =head2 @requests = $ec2->describe_spot_instance_requests(-spot_instance_request_id=>\@ids,-filter=>\%filters) This method will return information about current spot instance requests as a list of VM::EC2::Spot::InstanceRequest objects. Optional arguments: -spot_instance_request_id -- Scalar or arrayref of request Ids. -filter -- Tags and other filters to apply. There are many filters available, described fully at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/index.html?ApiReference-ItemType-SpotInstanceRequestSetItemType.html: availability-zone-group create-time fault-code fault-message instance-id launch-group launch.block-device-mapping.delete-on-termination launch.block-device-mapping.device-name launch.block-device-mapping.snapshot-id launch.block-device-mapping.volume-size launch.block-device-mapping.volume-type launch.group-id launch.image-id launch.instance-type launch.kernel-id launch.key-name launch.monitoring-enabled launch.ramdisk-id launch.network-interface.network-interface-id launch.network-interface.device-index launch.network-interface.subnet-id launch.network-interface.description launch.network-interface.private-ip-address launch.network-interface.delete-on-termination launch.network-interface.group-id launch.network-interface.group-name launch.network-interface.addresses.primary product-description spot-instance-request-id spot-price state status-code status-message tag-key tag-value tag: type launched-availability-zone valid-from valid-until =cut sub describe_spot_instance_requests { my $self = shift; my %args = $self->args('-spot_instance_request_id',@_); my @params = $self->list_parm('SpotInstanceRequestId',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeSpotInstanceRequests',@params); } =head1 PLACEMENT GROUPS Placement groups Provide low latency and high-bandwidth connectivity between cluster instances within a single Availability Zone. Create a placement group and then launch cluster instances into it. Instances launched within a placement group participate in a full-bisection bandwidth cluster appropriate for HPC applications. =head2 @groups = $ec2->describe_placement_groups(@group_names) =head2 @groups = $ec2->describe_placement_groups(\%filters) =head2 @groups = $ec2->describe_placement_groups(-group_name=>\@ids,-filter=>\%filters) This method will return information about cluster placement groups as a list of VM::EC2::PlacementGroup objects. Optional arguments: -group_name -- Scalar or arrayref of placement group names. -filter -- Tags and other filters to apply. The filters available are described fully at: http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribePlacementGroups.html group-name state strategy =cut sub describe_placement_groups { my $self = shift; my %args = $self->args('-group_name',@_); my @params = $self->list_parm('GroupName',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribePlacementGroups',@params); } =head2 $success = $ec2->create_placement_group($group_name) =head2 $success = $ec2->create_placement_group(-group_name=>$name,-strategy=>$strategy) Creates a placement group that cluster instances are launched into. Required arguments: -group_name -- The name of the placement group to create Optional: -strategy -- As of 2012-12-23, the only available option is 'cluster' so the parameter defaults to that. Returns true on success. =cut sub create_placement_group { my $self = shift; my %args = $self->args('-group_name',@_); $args{-strategy} ||= 'cluster'; my @params = $self->single_parm('GroupName',\%args); push @params, $self->single_parm('Strategy',\%args); return $self->call('CreatePlacementGroup',@params); } =head2 $success = $ec2->delete_placement_group($group_name) =head2 $success = $ec2->delete_placement_group(-group_name=>$group_name) Deletes a placement group from the account. Required arguments: -group_name -- The name of the placement group to delete Returns true on success. =cut sub delete_placement_group { my $self = shift; my %args = $self->args('-group_name',@_); my @params = $self->single_parm('GroupName',\%args); return $self->call('DeletePlacementGroup',@params); } =head1 VIRTUAL PRIVATE CLOUDS EC2 virtual private clouds (VPCs) provide facilities for creating tiered applications combining public and private subnetworks, and for extending your home/corporate network into the cloud. =cut =head2 $vpc = $ec2->create_vpc(-cidr_block=>$cidr,-instance_tenancy=>$tenancy) Create a new VPC. This can be called with a single argument, in which case it is interpreted as the desired CIDR block, or $vpc = $ec2->$ec2->create_vpc('10.0.0.0/16') or die $ec2->error_str; Or it can be called with named arguments. Required arguments: -cidr_block The Classless Internet Domain Routing address, in the form xx.xx.xx.xx/xx. One or more subnets will be allocated from within this block. Optional arguments: -instance_tenancy "default" or "dedicated". The latter requests AWS to launch all your instances in the VPC on single-tenant hardware (at additional cost). See http://docs.amazonwebservices.com/AmazonVPC/latest/UserGuide/VPC_Subnets.html for a description of the valid CIDRs that can be used with EC2. On success, this method will return a new VM::EC2::VPC object. You can then use this object to create new subnets within the VPC: $vpc = $ec2->create_vpc('10.0.0.0/16') or die $ec2->error_str; $subnet1 = $vpc->create_subnet('10.0.0.0/24') or die $vpc->error_str; $subnet2 = $vpc->create_subnet('10.0.1.0/24') or die $vpc->error_str; $subnet3 = $vpc->create_subnet('10.0.2.0/24') or die $vpc->error_str; =cut sub create_vpc { my $self = shift; my %args = $self->args('-cidr_block',@_); $args{-cidr_block} or croak "create_vpc(): must provide a -cidr_block parameter"; my @parm = $self->list_parm('CidrBlock',\%args); push @parm, $self->single_parm('instanceTenancy',\%args); return $self->call('CreateVpc',@parm); } =head2 @vpc = $ec2->describe_vpcs(@vpc_ids) =head2 @vpc = $ec2->describe_vpcs(\%filter) =head2 @vpc = $ec2->describe_vpcs(-vpc_id=>\@list,-filter=>\%filter) Describe VPCs that you own and return a list of VM::EC2::VPC objects. Call with no arguments to return all VPCs, or provide a list of VPC IDs to return information on those only. You may also provide a filter list, or named argument forms. Optional arguments: -vpc_id A scalar or array ref containing the VPC IDs you want information on. -filter A hashref of filters to apply to the query. The filters you can use are described at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeVpcs.html =cut sub describe_vpcs { my $self = shift; my %args = $self->args('-vpc_id',@_); my @parm = $self->list_parm('VpcId',\%args); push @parm, $self->filter_parm(\%args); return $self->call('DescribeVpcs',@parm); } =head2 $success = $ec2->delete_vpc($vpc_id) =head2 $success = $ec2->delete_vpc(-vpc_id=>$vpc_id) Delete the indicated VPC, returning true if successful. =cut sub delete_vpc { my $self = shift; my %args = $self->args(-vpc_id => @_); my @param = $self->single_parm(VpcId=>\%args); return $self->call('DeleteVpc',@param); } =head1 VPC Subnets and Routing These methods manage subnet objects and the routing among them. A VPC may have a single subnet or many, and routing rules determine whether the subnet has access to the internet ("public"), is entirely private, or is connected to a customer gateway device to form a Virtual Private Network (VPN) in which your home network's address space is extended into the Amazon VPC. All instances in a VPC are located in one subnet or another. Subnets may be public or private, and are organized in a star topology with a logical router in the middle. Although all these methods can be called from VM::EC2 objects, many are more conveniently called from the VM::EC2::VPC object family. This allows for steps that typically follow each other, such as creating a route table and associating it with a subnet, happen automatically. For example, this series of calls creates a VPC with a single subnet, creates an Internet gateway attached to the VPC, associates a new route table with the subnet and then creates a default route from the subnet to the Internet gateway. $vpc = $ec2->create_vpc('10.0.0.0/16') or die $ec2->error_str; $subnet1 = $vpc->create_subnet('10.0.0.0/24') or die $vpc->error_str; $gateway = $vpc->create_internet_gateway or die $vpc->error_str; $routeTbl = $subnet->create_route_table or die $vpc->error_str; $routeTbl->create_route('0.0.0.0/0' => $gateway) or die $vpc->error_str; =head2 $subnet = $ec2->create_subnet(-vpc_id=>$id,-cidr_block=>$block) This method creates a new subnet within the given VPC. Pass a VPC object or VPC ID, and a CIDR block string. If successful, the method will return a VM::EC2::VPC::Subnet object. Required arguments: -vpc_id A VPC ID or previously-created VM::EC2::VPC object. -cidr_block A CIDR block string in the form "xx.xx.xx.xx/xx". The CIDR address must be within the CIDR block previously assigned to the VPC, and must not overlap other subnets in the VPC. Optional arguments: -availability_zone The availability zone for the instances launched within this instance, either an availability zone name, or a VM::EC2::AvailabilityZone object. If this is not specified, then AWS chooses a zone for you automatically. =cut sub create_subnet { my $self = shift; my %args = @_; $args{-vpc_id} && $args{-cidr_block} or croak "Usage: create_subnet(-vpc_id=>\$id,-cidr_block=>\$block)"; my @parm = map {$self->single_parm($_ => \%args)} qw(VpcId CidrBlock AvailabilityZone); return $self->call('CreateSubnet',@parm); } =head2 $success = $ec2->delete_subnet($subnet_id) =head2 $success = $ec2->delete_subnet(-subnet_id=>$id) This method deletes the indicated subnet. It may be called with a single argument consisting of the subnet ID, or a named argument form with the argument -subnet_id. =cut sub delete_subnet { my $self = shift; my %args = $self->args(-subnet_id=>@_); my @parm = $self->single_parm(SubnetId=>\%args); return $self->call('DeleteSubnet',@parm); } =head2 @subnets = $ec2->describe_subnets(@subnet_ids) =head2 @subnets = $ec2->describe_subnets(\%filters) =head2 @subnets = $ec2->describe_subnets(-subnet_id=>$id, -filter => \%filters) This method returns a list of VM::EC2::VPC::Subnet objects. Called with no arguments, it returns all Subnets (not filtered by VPC Id). Pass a list of subnet IDs or a filter hashref in order to restrict the search. Optional arguments: -subnet_id Scalar or arrayref of subnet IDs. -filter Hashref of filters. Available filters are described at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeSubnets.html =cut sub describe_subnets { my $self = shift; my %args = $self->args(-subnet_id => @_); my @parm = $self->list_parm('SubnetId',\%args); push @parm, $self->filter_parm(\%args); return $self->call('DescribeSubnets',@parm); } =head2 $table = $ec2->create_route_table($vpc_id) =head2 $table = $ec2->create_route_table(-vpc_id=>$id) This method creates a new route table within the given VPC and returns a VM::EC2::VPC::RouteTable object. By default, every route table includes a local route that enables traffic to flow within the VPC. You may add additional routes using create_route(). This method can be called using a single argument corresponding to VPC ID for the new route table, or with the named argument form. Required arguments: -vpc_id A VPC ID or previously-created VM::EC2::VPC object. =cut sub create_route_table { my $self = shift; my %args = $self->args(-vpc_id => @_); $args{-vpc_id} or croak "Usage: create_subnet(-vpc_id=>\$id)"; my @parm = $self->single_parm(VpcId => \%args); return $self->call('CreateRouteTable',@parm); } =head2 $success = $ec2->delete_route_table($route_table_id) =head2 $success = $ec2->delete_route_table(-route_table_id=>$id) This method deletes the indicated route table and all the route entries within it. It may not be called on the main route table, or if the route table is currently associated with a subnet. The method can be called with a single argument corresponding to the route table's ID, or using the named form with argument -route_table_id. =cut sub delete_route_table { my $self = shift; my %args = $self->args(-route_table_id=>@_); my @parm = $self->single_parm(RouteTableId=>\%args); return $self->call('DeleteRouteTable',@parm); } =head2 @tables = $ec2->describe_route_tables(@route_table_ids) =head2 @tables = $ec2->describe_route_tables(\%filters) =head2 @tables = $ec2->describe_route_tables(-route_table_id=> \@ids, -filter => \%filters); This method describes all or some of the route tables available to you. You may use the filter to restrict the search to a particular type of route table using one of the filters described at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeRouteTables.html. Some of the commonly used filters are: vpc-id ID of the VPC the route table is in. association.subnet-id ID of the subnet the route table is associated with. route.state State of the route, either 'active' or 'blackhole' tag: Value of a tag =cut sub describe_route_tables { my $self = shift; my %args = $self->args(-route_table_id => @_); my @parm = $self->list_parm('RouteTableId',\%args); push @parm, $self->filter_parm(\%args); return $self->call('DescribeRouteTables',@parm); } =head2 $associationId = $ec2->associate_route_table($subnet_id => $route_table_id) =head2 $associationId = $ec2->associate_route_table(-subnet_id => $id, -route_table_id => $id) This method associates a route table with a subnet. Both objects must be in the same VPC. You may use either string IDs, or VM::EC2::VPC::RouteTable and VM::EC2::VPC::Subnet objects. On success, an associationID is returned, which you may use to disassociate the route table from the subnet later. The association ID can also be found by searching through the VM::EC2::VPC::RouteTable object. Required arguments: -subnet_id The subnet ID or a VM::EC2::VPC::Subnet object. -route_table_id The route table ID or a M::EC2::VPC::RouteTable object. It may be more convenient to call the VM::EC2::VPC::Subnet->associate_route_table() or VM::EC2::VPC::RouteTable->associate_subnet() methods, which are front ends to this method. =cut sub associate_route_table { my $self = shift; my %args; if ($_[0] !~ /^-/ && @_ == 2) { @args{qw(-subnet_id -route_table_id)} = @_; } else { %args = @_; } $args{-subnet_id} && $args{-route_table_id} or croak "-subnet_id, and -route_table_id arguments required"; my @param = $self->single_parm(SubnetId=>\%args), $self->single_parm(RouteTableId=>\%args); return $self->call('AssociateRouteTable',@param); } =head2 $success = $ec2->dissociate_route_table($association_id) =head2 $success = $ec2->dissociate_route_table(-association_id => $id) This method disassociates a route table from a subnet. You must provide the association ID (either returned from associate_route_table() or found among the associations() of a RouteTable object). You may use the short single-argument form, or the longer named argument form with the required argument -association_id. The method returns true on success. =cut sub disassociate_route_table { my $self = shift; my %args = $self->args('-association_id',@_); my @params = $self->single_parm('AssociationId',\%args); return $self->call('DisassociateRouteTable',@params); } =head2 $new_association = $ec2->replace_route_table_association($association_id=>$route_table_id) =head2 $new_association = $ec2->replace_route_table_association(-association_id => $id, -route_table_id => $id) This method changes the route table associated with a given subnet. You must pass the replacement route table ID and the association ID. To replace the main route table, use its association ID and the ID of the route table you wish to replace it with. On success, a new associationID is returned. Required arguments: -association_id The association ID -route_table_id The route table ID or a M::EC2::VPC::RouteTable object. =cut sub replace_route_table_association { my $self = shift; my %args; if ($_[0] !~ /^-/ && @_ == 2) { @args{qw(-association_id -route_table_id)} = @_; } else { %args = @_; } $args{-association_id} && $args{-route_table_id} or croak "-association_id, and -route_table_id arguments required"; my @param = $self->single_parm(AssociationId => \%args), $self->single_parm(RouteTableId => \%args); return $self->call('ReplaceRouteTableAssociation',@param); } =head2 $success = $ec2->create_route($route_table_id,$destination,$target) =head2 $success = $ec2->create_route(-route_table_id => $id, -destination_cidr_block => $block, -target=>$target) This method creates a routing rule in a route table within a VPC. It takes three mandatory arguments consisting of the route table, the CIDR address block to match packet destinations against, and a target to route matching packets to. The target may be an internet gateway, a NAT instance, or a network interface ID. Network packets are routed by matching their destination addresses against a CIDR block. For example, 0.0.0.0/0 matches all addresses, while 10.0.1.0/24 matches 10.0.1.* addresses. When a packet matches more than one rule, the most specific matching routing rule is chosen. In the named argument form, the following arguments are recognized: -route_table_id The ID of a route table, or a VM::EC2::VPC::RouteTable object. -destination_cidr_block The CIDR address block to match against packet destinations. -destination A shorthand version of -destination_cidr_block. -target The destination of matching packets. See below for valid targets. The -target value can be any one of the following: 1. A VM::EC2::VPC::InternetGateway object, or an internet gateway ID matching the regex /^igw-[0-9a-f]{8}$/ 2. A VM::EC2::Instance object, or an instance ID matching the regex /^i-[0-9a-f]{8}$/. 3. A VM::EC2::NetworkInterface object, or a network interface ID matching the regex /^eni-[0-9a-f]{8}$/. On success, this method returns true. =cut sub create_route { my $self = shift; return $self->_manipulate_route('CreateRoute',@_); } =head2 $success = $ec2->delete_route($route_table_id,$destination_block) This method deletes a route in the specified routing table. The destination CIDR block is used to indicate which route to delete. On success, the method returns true. =cut sub delete_route { my $self = shift; @_ == 2 or croak "Usage: delete_route(\$route_table_id,\$destination_block)"; my %args; @args{qw(-route_table_id -destination_cidr_block)} = @_; my @parm = map {$self->single_parm($_,\%args)} qw(RouteTableId DestinationCidrBlock); return $self->call('DeleteRoute',@parm); } =head2 $success = $ec2->replace_route($route_table_id,$destination,$target) =head2 $success = $ec2->replace_route(-route_table_id => $id, -destination_cidr_block => $block, -target=>$target) This method replaces an existing routing rule in a route table within a VPC. It takes three mandatory arguments consisting of the route table, the CIDR address block to match packet destinations against, and a target to route matching packets to. The target may be an internet gateway, a NAT instance, or a network interface ID. Network packets are routed by matching their destination addresses against a CIDR block. For example, 0.0.0.0/0 matches all addresses, while 10.0.1.0/24 matches 10.0.1.* addresses. When a packet matches more than one rule, the most specific matching routing rule is chosen. In the named argument form, the following arguments are recognized: -route_table_id The ID of a route table, or a VM::EC2::VPC::RouteTable object. -destination_cidr_block The CIDR address block to match against packet destinations. -destination A shorthand version of -destination_cidr_block. -target The destination of matching packets. See below for valid targets. The -target value can be any one of the following: 1. A VM::EC2::VPC::InternetGateway object, or an internet gateway ID matching the regex /^igw-[0-9a-f]{8}$/ 2. A VM::EC2::Instance object, or an instance ID matching the regex /^i-[0-9a-f]{8}$/. 3. A VM::EC2::NetworkInterface object, or a network interface ID matching the regex /^eni-[0-9a-f]{8}$/. On success, this method returns true. =cut sub replace_route { my $self = shift; return $self->_manipulate_route('ReplaceRoute',@_); } sub _manipulate_route { my $self = shift; my $api_call = shift; my %args; if ($_[0] !~ /^-/ && @_ == 3) { @args{qw(-route_table_id -destination -target)} = @_; } else { %args = @_; } $args{-destination_cidr_block} ||= $args{-destination}; $args{-destination_cidr_block} && $args{-route_table_id} && $args{-target} or croak "-route_table_id, -destination_cidr_block, and -target arguments required"; # figure out what the target is. $args{-gateway_id} = $args{-target} if eval{$args{-target}->isa('VM::EC2::VPC::InternetGateway')} || $args{-target} =~ /^igw-[0-9a-f]{8}$/; $args{-instance_id} = $args{-target} if eval{$args{-target}->isa('VM::EC2::Instance')} || $args{-target} =~ /^i-[0-9a-f]{8}$/; $args{-network_interface_id} = $args{-target} if eval{$args{-target}->isa('VM::EC2::NetworkInterface')} || $args{-target} =~ /^eni-[0-9a-f]{8}$/; my @parm = map {$self->single_parm($_,\%args)} qw(RouteTableId DestinationCidrBlock GatewayId InstanceId NetworkInterfaceId); return $self->call($api_call,@parm); } =head2 $gateway = $ec2->create_internet_gateway() This method creates a new Internet gateway. It takes no arguments and returns a VM::EC2::VPC::InternetGateway object. Gateways are initially independent of any VPC, but later can be attached to one or more VPCs using attach_internet_gateway(). =cut sub create_internet_gateway { my $self = shift; return $self->call('CreateInternetGateway'); } =head2 $success = $ec2->delete_internet_gateway($internet_gateway_id) =head2 $success = $ec2->delete_internet_gateway(-internet_gateway_id=>$id) This method deletes the indicated internet gateway. It may be called with a single argument corresponding to the route table's ID, or using the named form with argument -internet_gateway_id. =cut sub delete_internet_gateway { my $self = shift; my %args = $self->args(-internet_gateway_id=>@_); my @parm = $self->single_parm(InternetGatewayId=>\%args); return $self->call('DeleteInternetGateway',@parm); } =head2 @gateways = $ec2->describe_internet_gateways(@gateway_ids) =head2 @gateways = $ec2->describe_internet_gateways(\%filters) =head2 @gateways = $ec2->describe_internet_gateways(-internet_gateway_id=>\@ids, -filter =>\$filters) This method describes all or some of the internet gateways available to you. You may use the filter to restrict the search to a particular type of internet gateway using one or more of the filters described at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeInternetGateways.html. Some of the commonly used filters are: attachment.vpc-id ID of one of the VPCs the gateway is attached to attachment.state State of the gateway, always "available" tag: Value of a tag On success this method returns a list of VM::EC2::VPC::InternetGateway objects. =cut sub describe_internet_gateways { my $self = shift; my %args = $self->args(-internet_gateway_id => @_); my @parm = $self->list_parm('InternetGatewayId',\%args); push @parm, $self->filter_parm(\%args); return $self->call('DescribeInternetGateways',@parm); } =head2 $boolean = $ec2->attach_internet_gateway($internet_gateway_id,$vpc_id) =head2 $boolean = $ec2->attach_internet_gateway(-internet_gateway_id => $id, -vpc_id => $id) This method attaches an internet gateway to a VPC. You can use internet gateway and VPC IDs, or their corresponding VM::EC2::VPC::InternetGateway and VM::EC2::VPC objects. Required arguments: -internet_gateway_id ID of the network interface to attach. -vpc_id ID of the instance to attach the interface to. On success, this method a true value. Note that it may be more convenient to attach and detach gateways via methods in the VM::EC2::VPC and VM::EC2::VPC::Gateway objects. $vpc->attach_internet_gateway($gateway); $gateway->attach($vpc); =cut sub attach_internet_gateway { my $self = shift; my %args; if ($_[0] !~ /^-/ && @_ == 2) { @args{qw(-internet_gateway_id -vpc_id)} = @_; } else { %args = @_; } $args{-internet_gateway_id} && $args{-vpc_id} or croak "-internet_gateway_id and-vpc_id arguments must be specified"; $args{-device_index} =~ s/^eth//; my @param = $self->single_parm(InternetGatewayId=>\%args); push @param,$self->single_parm(VpcId=>\%args); return $self->call('AttachInternetGateway',@param); } =head2 $boolean = $ec2->detach_internet_gateway($internet_gateway_id,$vpc_id) =head2 $boolean = $ec2->detach_internet_gateway(-internet_gateway_id => $id, -vpc_id => $id) This method detaches an internet gateway to a VPC. You can use internet gateway and VPC IDs, or their corresponding VM::EC2::VPC::InternetGateway and VM::EC2::VPC objects. Required arguments: -internet_gateway_id ID of the network interface to detach. -vpc_id ID of the VPC to detach the gateway from. On success, this method a true value. Note that it may be more convenient to detach and detach gateways via methods in the VM::EC2::VPC and VM::EC2::VPC::Gateway objects. $vpc->detach_internet_gateway($gateway); $gateway->detach($vpc); =cut sub detach_internet_gateway { my $self = shift; my %args; if ($_[0] !~ /^-/ && @_ == 2) { @args{qw(-internet_gateway_id -vpc_id)} = @_; } else { %args = @_; } $args{-internet_gateway_id} && $args{-vpc_id} or croak "-internet_gateway_id and-vpc_id arguments must be specified"; $args{-device_index} =~ s/^eth//; my @param = $self->single_parm(InternetGatewayId=>\%args); push @param,$self->single_parm(VpcId=>\%args); return $self->call('DetachInternetGateway',@param); } =head2 @acls = $ec2->describe_network_acls(-network_acl_id=>\@ids, -filter=>\%filters) =head2 @acls = $ec2->describe_network_acls(\@network_acl_ids) =head2 @acls = $ec2->describe_network_acls(%filters) Provides information about network ACLs. Returns a series of L objects. Optional parameters are: -network_acl_id -- ID of the network ACL(s) to return information on. This can be a string scalar, or an arrayref. -filter -- Tags and other filters to apply. The filter argument is a hashreference in which the keys are the filter names, and the values are the match strings. Some filters accept wildcards. There are a number of filters, which are listed in full at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeNetworkAcls.html Here is a alpha-sorted list of filter names: association.association-id, association.network-acl-id, association.subnet-id, default, entry.cidr, entry.egress, entry.icmp.code, entry.icmp.type, entry.port-range.from, entry.port-range.to, entry.protocol, entry.rule-action, entry.rule-number, network-acl-id, tag-key, tag-value, tag:key, vpc-id =cut sub describe_network_acls { my $self = shift; my %args = $self->args('-network_acl_id',@_); my @params = $self->list_parm('NetworkAclId',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeNetworkAcls',@params); } =head2 $acl = $ec2->create_network_acl(-vpc_id=>$vpc_id) =head2 $acl = $ec2->create_network_acl($vpc_id) Creates a new network ACL in a VPC. Network ACLs provide an optional layer of security (on top of security groups) for the instances in a VPC. Arguments: -vpc_id -- The VPC ID to create the ACL in Retuns a VM::EC2::VPC::NetworkAcl object on success. =cut sub create_network_acl { my $self = shift; my %args = $self->args('-vpc_id',@_); $args{-vpc_id} or croak "create_network_acl(): -vpc_id argument missing"; my @params = $self->single_parm('VpcId',\%args); return $self->call('CreateNetworkAcl',@params); } =head2 $boolean = $ec2->delete_network_acl(-network_acl_id=>$id) =head2 $boolean = $ec2->delete_network_acl($id) Deletes a network ACL from a VPC. The ACL must not have any subnets associated with it. The default network ACL cannot be deleted. Arguments: -network_acl_id -- The ID of the network ACL to delete Returns true on successful deletion. =cut sub delete_network_acl { my $self = shift; my %args = $self->args('-network_acl_id',@_); my @params = $self->single_parm('NetworkAclId',\%args); return $self->call('DeleteNetworkAcl',@params); } =head2 $boolean = $ec2->create_network_acl_entry(%args) Creates an entry (i.e., rule) in a network ACL with the rule number you specified. Each network ACL has a set of numbered ingress rules and a separate set of numbered egress rules. When determining whether a packet should be allowed in or out of a subnet associated with the ACL, Amazon VPC processes the entries in the ACL according to the rule numbers, in ascending order. Arguments: -network_acl_id -- ID of the ACL where the entry will be created (Required) -rule_number -- Rule number to assign to the entry (e.g., 100). ACL entries are processed in ascending order by rule number. Positive integer from 1 to 32766. (Required) -protocol -- The IP protocol the rule applies to. You can use -1 to mean all protocols. See http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml for a list of protocol numbers. (Required) -rule_action -- Indicates whether to allow or deny traffic that matches the rule. allow | deny (Required) -egress -- Indicates whether this rule applies to egress traffic from the subnet (true) or ingress traffic to the subnet (false). Default is false. -cidr_block -- The CIDR range to allow or deny, in CIDR notation (e.g., 172.16.0.0/24). (Required) -icmp_code -- For the ICMP protocol, the ICMP code. You can use -1 to specify all ICMP codes for the given ICMP type. Required if specifying 1 (ICMP) for protocol. -icmp_type -- For the ICMP protocol, the ICMP type. You can use -1 to specify all ICMP types. Required if specifying 1 (ICMP) for the protocol -port_from -- The first port in the range. Required if specifying 6 (TCP) or 17 (UDP) for the protocol. -port_to -- The last port in the range. Required if specifying 6 (TCP) or 17 (UDP) for the protocol. Returns true on successful creation. =cut sub create_network_acl_entry { my $self = shift; my %args = @_; $args{-network_acl_id} or croak "create_network_acl_entry(): -network_acl_id argument missing"; $args{-rule_number} or croak "create_network_acl_entry(): -rule_number argument missing"; defined $args{-protocol} or croak "create_network_acl_entry(): -protocol argument missing"; $args{-rule_action} or croak "create_network_acl_entry(): -rule_action argument missing"; $args{-cidr_block} or croak "create_network_acl_entry(): -cidr_block argument missing"; if ($args{-protocol} == 1) { defined $args{-icmp_type} && defined $args{-icmp_code} or croak "create_network_acl_entry(): -icmp_type or -icmp_code argument missing"; } elsif ($args{-protocol} == 6 || $args{-protocol} == 17) { defined $args{-port_from} or croak "create_network_acl_entry(): -port_from argument missing"; $args{-port_to} = $args{-port_from} if (! defined $args{-port_to}); } $args{'-Icmp.Type'} = $args{-icmp_type}; $args{'-Icmp.Code'} = $args{-icmp_code}; $args{'-PortRange.From'} = $args{-port_from}; $args{'-PortRange.To'} = $args{-port_to}; my @params; push @params,$self->single_parm($_,\%args) foreach qw(NetworkAclId RuleNumber Protocol RuleAction Egress CidrBlock Icmp.Code Icmp.Type PortRange.From PortRange.To); return $self->call('CreateNetworkAclEntry',@params); } =head2 $success = $ec2->delete_network_acl_entry(-network_acl_id=>$id, -rule_number =>$int, -egress =>$bool) Deletes an ingress or egress entry (i.e., rule) from a network ACL. Arguments: -network_acl_id -- ID of the ACL where the entry will be created -rule_number -- Rule number of the entry (e.g., 100). Optional arguments: -egress -- Whether the rule to delete is an egress rule (true) or ingress rule (false). Default is false. Returns true on successful deletion. =cut sub delete_network_acl_entry { my $self = shift; my %args = @_; $args{-network_acl_id} or croak "delete_network_acl_entry(): -network_acl_id argument missing"; $args{-rule_number} or croak "delete_network_acl_entry(): -rule_number argument missing"; my @params; push @params,$self->single_parm($_,\%args) foreach qw(NetworkAclId RuleNumber Egress); return $self->call('DeleteNetworkAclEntry',@params); } =head2 $assoc_id = $ec2->replace_network_acl_association(-association_id=>$assoc_id, -network_acl_id=>$id) Changes which network ACL a subnet is associated with. By default when you create a subnet, it's automatically associated with the default network ACL. Arguments: -association_id -- The ID of the association to replace -network_acl_id -- The ID of the network ACL to associated the subnet with Returns the new association ID. =cut sub replace_network_acl_association { my $self = shift; my %args = @_; $args{-association_id} or croak "replace_network_acl_association(): -association_id argument missing"; $args{-network_acl_id} or croak "replace_network_acl_association(): -network_acl_id argument missing"; my @params; push @params,$self->single_parm($_,\%args) foreach qw(AssociationId NetworkAclId); return $self->call('ReplaceNetworkAclAssociation',@params); } =head2 $success = $ec2->replace_network_acl_entry(%args) Replaces an entry (i.e., rule) in a network ACL. Arguments: -network_acl_id -- ID of the ACL where the entry will be created (Required) -rule_number -- Rule number of the entry to replace. (Required) -protocol -- The IP protocol the rule applies to. You can use -1 to mean all protocols. See http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml for a list of protocol numbers. (Required) -rule_action -- Indicates whether to allow or deny traffic that matches the rule. allow | deny (Required) -egress -- Indicates whether this rule applies to egress traffic from the subnet (true) or ingress traffic to the subnet (false). Default is false. -cidr_block -- The CIDR range to allow or deny, in CIDR notation (e.g., 172.16.0.0/24). (Required) -icmp_code -- For the ICMP protocol, the ICMP code. You can use -1 to specify all ICMP codes for the given ICMP type. Required if specifying 1 (ICMP) for protocol. -icmp_type -- For the ICMP protocol, the ICMP type. You can use -1 to specify all ICMP types. Required if specifying 1 (ICMP) for the protocol -port_from -- The first port in the range. Required if specifying 6 (TCP) or 17 (UDP) for the protocol. -port_to -- The last port in the range. Only required if specifying 6 (TCP) or 17 (UDP) for the protocol and is a different port than -port_from. Returns true on successful replacement. =cut sub replace_network_acl_entry { my $self = shift; my %args = @_; $args{-network_acl_id} or croak "replace_network_acl_entry(): -network_acl_id argument missing"; $args{-rule_number} or croak "replace_network_acl_entry(): -rule_number argument missing"; $args{-protocol} or croak "replace_network_acl_entry(): -protocol argument missing"; $args{-rule_action} or croak "replace_network_acl_entry(): -rule_action argument missing"; if ($args{-protocol} == 1) { defined $args{-icmp_type} && defined $args{-icmp_code} or croak "replace_network_acl_entry(): -icmp_type or -icmp_code argument missing"; } elsif ($args{-protocol} == 6 || $args{-protocol} == 17) { defined $args{-port_from} or croak "create_network_acl_entry(): -port_from argument missing"; $args{-port_to} = $args{-port_from} if (! defined $args{-port_to}); } $args{'-Icmp.Type'} = $args{-icmp_type}; $args{'-Icmp.Code'} = $args{-icmp_code}; $args{'-PortRange.From'} = $args{-port_from}; $args{'-PortRange.To'} = $args{-port_to}; my @params; push @params,$self->single_parm($_,\%args) foreach qw(NetworkAclId RuleNumber Protocol RuleAction Egress CidrBlock Icmp.Code Icmp.Type PortRange.From PortRange.To); return $self->call('ReplaceNetworkAclEntry',@params); } =head1 DHCP Options These methods manage DHCP Option objects, which can then be applied to a VPC to configure the DHCP options applied to running instances. =head2 $options = $ec2->create_dhcp_options(\%configuration_list) This method creates a DhcpOption object, The single required argument is a configuration list hash (which can be passed either as a hashref or a flattened hash) with one or more of the following keys: -domain_name Domain name for instances running in this VPC. -domain_name_servers Scalar or arrayref containing up to 4 IP addresses of domain name servers for this VPC. -ntp_servers Scalar or arrayref containing up to 4 IP addresses of network time protocol servers -netbios_name_servers Scalar or arrayref containing up to 4 IP addresses for NetBIOS name servers. -netbios_node_type The NetBios node type (1,2,4 or 8). Amazon recommends using "2" at this time. On successful completion, a VM::EC2::VPC::DhcpOptions object will be returned. This can be associated with a VPC using the VPC object's set_dhcp_options() method: $vpc = $ec2->create_vpc(...); $options = $ec2->create_dhcp_options(-domain_name=>'test.com', -domain_name_servers=>['204.16.255.55','216.239.34.10']); $vpc->set_dhcp_options($options); =cut # { 'domain-name-servers' => ['192.168.2.1','192.168.2.2'],'domain-name'=>'example.com'} sub create_dhcp_options { my $self = shift; my %args; if (@_ == 1 && ref $_[0] eq 'HASH') { %args = %{$_[0]}; } else { %args = @_; } my @parm; my $count = 1; for my $key (sort keys %args) { my $value = $args{$key}; my @values = ref $value && ref $value eq 'ARRAY' ? @$value : $value; $key =~ s/^-//; $key =~ s/_/-/g; my $item = 1; push @parm,("DhcpConfiguration.$count.Key" => $key); push @parm,("DhcpConfiguration.$count.Value.".$item++ => $_) foreach @values; $count++; } return $self->call('CreateDhcpOptions',@parm); } =head2 $success = $ec2->delete_dhcp_options($dhcp_id) Delete the indicated DHCPOptions, returning true if successful. You may also use the named argument -dhcp_options_id.. =cut sub delete_dhcp_options { my $self = shift; my %args = $self->args(-dhcp_options_id => @_); my @param = $self->single_parm(DhcpOptionsId=>\%args); return $self->call('DeleteDhcpOptions',@param); } =head2 @options = $ec2->describe_dhcp_options(@option_ids) =head2 @options = $ec2->describe_dhcp_options(\%filters) =head2 @options = $ec2->describe_dhcp_options(-dhcp_options_id=>$id, -filter => \%filters) This method returns a list of VM::EC2::VPC::DhcpOptions objects, which describe a set of DHCP options that can be assigned to a VPC. Called with no arguments, it returns all DhcpOptions. Pass a list of option IDs or a filter hashref in order to restrict the search. Optional arguments: -dhcp_options_id Scalar or arrayref of DhcpOption IDs. -filter Hashref of filters. Available filters are described at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeDhcpOptions.html. =cut sub describe_dhcp_options { my $self = shift; my %args = $self->args(-dhcp_options_id => @_); my @parm = $self->list_parm('DhcpOptionsId',\%args); push @parm, $self->filter_parm(\%args); return $self->call('DescribeDhcpOptions',@parm); } =head2 $success = $ec2->associate_dhcp_options($vpc_id => $dhcp_id) =head2 $success = $ec2->associate_dhcp_options(-vpc_id => $vpc_id,-dhcp_options_id => $dhcp_id) Associate a VPC ID with a DHCP option set. Pass an ID of 'default' to restore the default DHCP options for the VPC. =cut sub associate_dhcp_options { my $self = shift; my %args; if ($_[0] !~ /^-/ && @_ == 2) { @args{qw(-vpc_id -dhcp_options_id)} = @_; } else { %args = @_; } $args{-vpc_id} && $args{-dhcp_options_id} or croak "-vpc_id and -dhcp_options_id must be specified"; my @param = $self->single_parm(DhcpOptionsId=> \%args); push @param, $self->single_parm(VpcId => \%args); return $self->call('AssociateDhcpOptions',@param); } =head1 Virtual Private Networks These methods create and manage Virtual Private Network (VPN) connections to an Amazon Virtual Private Cloud (VPC). =head2 @gtwys = $ec2->describe_vpn_gateways(-vpn_gateway_id=>\@ids, -filter =>\%filters) =head2 @gtwys = $ec2->describe_vpn_gateways(@vpn_gateway_ids) =head2 @gtwys = $ec2->describe_vpn_gateways(%filters) Provides information on VPN gateways. Return a series of VM::EC2::VPC::VpnGateway objects. When called with no arguments, returns all VPN gateways. Pass a list of VPN gateway IDs or use the assorted filters to restrict the search. Optional parameters are: -vpn_gateway_id ID of the gateway(s) to return information on. This can be a string scalar, or an arrayref. -filter Tags and other filters to apply. The filter argument is a hashreference in which the keys are the filter names, and the values are the match strings. Some filters accept wildcards. There are a number of filters, which are listed in full at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeVpnGateways.html Here is a alpha-sorted list of filter names: attachment.state, attachment.vpc-id, availability-zone, state, tag-key, tag-value, tag:key, type, vpn-gateway-id =cut sub describe_vpn_gateways { my $self = shift; my %args = $self->args('-vpn_gateway_id',@_); my @params = $self->list_parm('VpnGatewayId',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeVpnGateways',@params); } =head2 $vpn_gateway = $ec2->create_vpn_gateway(-type=>$type) =head2 $vpn_gateway = $ec2->create_vpn_gateway($type) =head2 $vpn_gateway = $ec2->create_vpn_gateway Creates a new virtual private gateway. A virtual private gateway is the VPC-side endpoint for a VPN connection. You can create a virtual private gateway before creating the VPC itself. -type switch is optional as there is only one type as of API 2012-06-15 Returns a VM::EC2::VPC::VpnGateway object on success =cut sub create_vpn_gateway { my $self = shift; my %args = $self->args('-type',@_); $args{-type} ||= 'ipsec.1'; my @params = $self->list_parm('Type',\%args); return $self->call('CreateVpnGateway',@params); } =head2 $success = $ec2->delete_vpn_gateway(-vpn_gateway_id=>$id); =head2 $success = $ec2->delete_vpn_gateway($id); Deletes a virtual private gateway. Use this when a VPC and all its associated components are no longer needed. It is recommended that before deleting a virtual private gateway, detach it from the VPC and delete the VPN connection. Note that it is not necessary to delete the virtual private gateway if the VPN connection between the VPC and data center needs to be recreated. Arguments: -vpn_gateway_id -- The ID of the VPN gateway to delete. Returns true on successful deletion =cut sub delete_vpn_gateway { my $self = shift; my %args = $self->args('-vpn_gateway_id',@_); $args{-vpn_gateway_id} or croak "delete_vpn_gateway(): -vpn_gateway_id argument missing"; my @params = $self->single_parm('VpnGatewayId',\%args); return $self->call('DeleteVpnGateway',@params); } =head2 $state = $ec2->attach_vpn_gateway(-vpn_gateway_id=>$vpn_gtwy_id, -vpc_id =>$vpc_id) Attaches a virtual private gateway to a VPC. Arguments: -vpc_id -- The ID of the VPC to attach the VPN gateway to -vpn_gateway_id -- The ID of the VPN gateway to attach Returns the state of the attachment, one of: attaching | attached | detaching | detached =cut sub attach_vpn_gateway { my $self = shift; my %args = @_; $args{-vpn_gateway_id} or croak "attach_vpn_gateway(): -vpn_gateway_id argument missing"; $args{-vpc_id} or croak "attach_vpn_gateway(): -vpc_id argument missing"; my @params = $self->single_parm('VpnGatewayId',\%args); push @params, $self->single_parm('VpcId',\%args); return $self->call('AttachVpnGateway',@params); } =head2 $success = $ec2->detach_vpn_gateway(-vpn_gateway_id=>$vpn_gtwy_id, -vpc_id =>$vpc_id) Detaches a virtual private gateway from a VPC. You do this if you're planning to turn off the VPC and not use it anymore. You can confirm a virtual private gateway has been completely detached from a VPC by describing the virtual private gateway (any attachments to the virtual private gateway are also described). You must wait for the attachment's state to switch to detached before you can delete the VPC or attach a different VPC to the virtual private gateway. Arguments: -vpc_id -- The ID of the VPC to detach the VPN gateway from -vpn_gateway_id -- The ID of the VPN gateway to detach Returns true on successful detachment. =cut sub detach_vpn_gateway { my $self = shift; my %args = @_; $args{-vpn_gateway_id} or croak "detach_vpn_gateway(): -vpn_gateway_id argument missing"; $args{-vpc_id} or croak "detach_vpn_gateway(): -vpc_id argument missing"; my @params = $self->single_parm('VpnGatewayId',\%args); push @params, $self->single_parm('VpcId',\%args); return $self->call('DetachVpnGateway',@params); } =head2 @vpn_connections = $ec2->describe_vpn_connections(-vpn_connection_id=>\@ids, -filter=>\%filters); =head2 @vpn_connections = $ec2->describe_vpn_connections(@vpn_connection_ids) =head2 @vpn_connections = $ec2->describe_vpn_connections(%filters); Gives information about VPN connections Returns a series of VM::EC2::VPC::VpnConnection objects. Optional parameters are: -vpn_connection_id ID of the connection(s) to return information on. This can be a string scalar, or an arrayref. -filter Tags and other filters to apply. The filter argument is a hashreference in which the keys are the filter names, and the values are the match strings. Some filters accept wildcards. There are a number of filters, which are listed in full at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeVpnConnections.html Here is a alpha-sorted list of filter names: customer-gateway-configuration, customer-gateway-id, state, tag-key, tag-value, tag:key, type, vpn-connection-id, vpn-gateway-id =cut sub describe_vpn_connections { my $self = shift; my %args = $self->args('-vpn_connection_id',@_); my @params = $self->list_parm('VpnConnectionId',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeVpnConnections',@params); } =head2 $vpn_connection = $ec2->create_vpn_connection(-type =>$type, -customer_gateway_id=>$gtwy_id, -vpn_gateway_id =>$vpn_id) Creates a new VPN connection between an existing virtual private gateway and a VPN customer gateway. The only supported connection type is ipsec.1. Required Arguments: -customer_gateway_id -- The ID of the customer gateway -vpn_gateway_id -- The ID of the VPN gateway Optional arguments: -type -- Default is the only currently available option: ipsec.1 (API 2012-06-15) -static_routes_only -- Indicates whether or not the VPN connection requires static routes. If you are creating a VPN connection for a device that does not support BGP, you must specify this value as true. Returns a L object. =cut sub create_vpn_connection { my $self = shift; my %args = @_; $args{-type} ||= 'ipsec.1'; $args{-vpn_gateway_id} or croak "create_vpn_connection(): -vpn_gateway_id argument missing"; $args{-customer_gateway_id} or croak "create_vpn_connection(): -customer_gateway_id argument missing"; $args{'Options.StaticRoutesOnly'} = $args{-static_routes_only}; my @params; push @params,$self->single_parm($_,\%args) foreach qw(VpnGatewayId CustomerGatewayId Type); push @params,$self->boolean_parm('Options.StaticRoutesOnly',\%args); return $self->call('CreateVpnConnection',@params); } =head2 $success = $ec2->delete_vpn_connection(-vpn_connection_id=>$vpn_id) =head2 $success = $ec2->delete_vpn_connection($vpn_id) Deletes a VPN connection. Use this if you want to delete a VPC and all its associated components. Another reason to use this operation is if you believe the tunnel credentials for your VPN connection have been compromised. In that situation, you can delete the VPN connection and create a new one that has new keys, without needing to delete the VPC or virtual private gateway. If you create a new VPN connection, you must reconfigure the customer gateway using the new configuration information returned with the new VPN connection ID. Arguments: -vpn_connection_id -- The ID of the VPN connection to delete Returns true on successful deletion. =cut sub delete_vpn_connection { my $self = shift; my %args = $self->args('-vpn_connection_id',@_); $args{-vpn_connection_id} or croak "delete_vpn_connection(): -vpn_connection_id argument missing"; my @params = $self->single_parm('VpnConnectionId',\%args); return $self->call('DeleteVpnConnection',@params); } =head2 @gtwys = $ec2->describe_customer_gateways(-customer_gateway_id=>\@ids, -filter =>\%filters) =head2 @gtwys = $ec2->describe_customer_gateways(\@customer_gateway_ids) =head2 @gtwys = $ec2->describe_customer_gateways(%filters) Provides information on VPN customer gateways. Returns a series of VM::EC2::VPC::CustomerGateway objects. Optional parameters are: -customer_gateway_id ID of the gateway(s) to return information on. This can be a string scalar, or an arrayref. -filter Tags and other filters to apply. The filter argument is a hashreference in which the keys are the filter names, and the values are the match strings. Some filters accept wildcards. There are a number of filters, which are listed in full at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeCustomerGateways.html Here is a alpha-sorted list of filter names: bgp-asn, customer-gateway-id, ip-address, state, type, tag-key, tag-value, tag:key =cut sub describe_customer_gateways { my $self = shift; my %args = $self->args('-customer_gateway_id',@_); my @params = $self->list_parm('CustomerGatewayId',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeCustomerGateways',@params); } =head2 $cust_gtwy = $ec2->create_customer_gateway(-type =>$type, -ip_address=>$ip, -bgp_asn =>$asn) Provides information to AWS about a VPN customer gateway device. The customer gateway is the appliance at the customer end of the VPN connection (compared to the virtual private gateway, which is the device at the AWS side of the VPN connection). Arguments: -ip_address -- The IP address of the customer gateway appliance -bgp_asn -- The Border Gateway Protocol (BGP) Autonomous System Number (ASN) of the customer gateway -type -- Optional as there is only currently (2012-06-15 API) only one type (ipsec.1) -ip -- Alias for -ip_address Returns a L object on success. =cut sub create_customer_gateway { my $self = shift; my %args = @_; $args{-type} ||= 'ipsec.1'; $args{-ip_address} ||= $args{-ip}; $args{-ip_address} or croak "create_customer_gateway(): -ip_address argument missing"; $args{-bgp_asn} or croak "create_customer_gateway(): -bgp_asn argument missing"; my @params = $self->single_parm('Type',\%args); push @params, $self->single_parm('IpAddress',\%args); push @params, $self->single_parm('BgpAsn',\%args); return $self->call('CreateCustomerGateway',@params); } =head2 $success = $ec2->delete_customer_gateway(-customer_gateway_id=>$id) =head2 $success = $ec2->delete_customer_gateway($id) Deletes a VPN customer gateway. You must delete the VPN connection before deleting the customer gateway. Arguments: -customer_gateway_id -- The ID of the customer gateway to delete Returns true on successful deletion. =cut sub delete_customer_gateway { my $self = shift; my %args = $self->args('-customer_gateway_id',@_); $args{-customer_gateway_id} or croak "delete_customer_gateway(): -customer_gateway_id argument missing"; my @params = $self->single_parm('CustomerGatewayId',\%args); return $self->call('DeleteCustomerGateway',@params); } =head2 $success = $ec2->create_vpn_connection_route(-destination_cidr_block=>$cidr, -vpn_connection_id =>$id) Creates a new static route associated with a VPN connection between an existing virtual private gateway and a VPN customer gateway. The static route allows traffic to be routed from the virtual private gateway to the VPN customer gateway. Arguments: -destination_cidr_block -- The CIDR block associated with the local subnet of the customer data center. -vpn_connection_id -- The ID of the VPN connection. Returns true on successsful creation. =cut sub create_vpn_connection_route { my $self = shift; my %args = @_; $args{-destination_cidr_block} or croak "create_vpn_connection_route(): -destination_cidr_block argument missing"; $args{-vpn_connection_id} or croak "create_vpn_connection_route(): -vpn_connection_id argument missing"; my @params = $self->single_parm($_,\%args) foreach qw(DestinationCidrBlock VpnConnectionId); return $self->call('CreateVpnConnectionRoute',@params); } =head2 $success = $ec2->delete_vpn_connection_route(-destination_cidr_block=>$cidr, -vpn_connection_id =>$id) Deletes a static route associated with a VPN connection between an existing virtual private gateway and a VPN customer gateway. The static route allows traffic to be routed from the virtual private gateway to the VPN customer gateway. Arguments: -destination_cidr_block -- The CIDR block associated with the local subnet of the customer data center. -vpn_connection_id -- The ID of the VPN connection. Returns true on successsful deletion. =cut sub delete_vpn_connection_route { my $self = shift; my %args = @_; $args{-destination_cidr_block} or croak "delete_vpn_connection_route(): -destination_cidr_block argument missing"; $args{-vpn_connection_id} or croak "delete_vpn_connection_route(): -vpn_connection_id argument missing"; my @params = $self->single_parm($_,\%args) foreach qw(DestinationCidrBlock VpnConnectionId); return $self->call('DeleteVpnConnectionRoute',@params); } =head2 $success = $ec2->disable_vgw_route_propogation(-route_table_id=>$rt_id, -gateway_id =>$gtwy_id) Disables a virtual private gateway (VGW) from propagating routes to the routing tables of an Amazon VPC. Arguments: -route_table_id -- The ID of the routing table. -gateway_id -- The ID of the virtual private gateway. Returns true on successful disablement. =cut sub disable_vgw_route_propogation { my $self = shift; my %args = @_; $args{-route_table_id} or croak "disable_vgw_route_propogation(): -route_table_id argument missing"; $args{-gateway_id} or croak "disable_vgw_route_propogation(): -gateway_id argument missing"; my @params = $self->single_parm($_,\%args) foreach qw(RouteTableId GatewayId); return $self->call('DisableVgwRoutePropagation',@params); } =head2 $success = $ec2->enable_vgw_route_propogation(-route_table_id=>$rt_id, -gateway_id =>$gtwy_id) Enables a virtual private gateway (VGW) to propagate routes to the routing tables of an Amazon VPC. Arguments: -route_table_id -- The ID of the routing table. -gateway_id -- The ID of the virtual private gateway. Returns true on successful enablement. =cut sub enable_vgw_route_propogation { my $self = shift; my %args = @_; $args{-route_table_id} or croak "enable_vgw_route_propogation(): -route_table_id argument missing"; $args{-gateway_id} or croak "enable_vgw_route_propogation(): -gateway_id argument missing"; my @params = $self->single_parm($_,\%args) foreach qw(RouteTableId GatewayId); return $self->call('EnableVgwRoutePropagation',@params); } =head1 Elastic Network Interfaces These methods create and manage Elastic Network Interfaces (ENI). Once created, an ENI can be attached to instances and/or be associated with a public IP address. ENIs can only be used in conjunction with VPC instances. =head2 $interface = $ec2->create_network_interface($subnet_id) =head2 $interface = $ec2->create_network_interface(%args) This method creates an elastic network interface (ENI). If only a single argument is provided, it is treated as the ID of the VPC subnet to associate with the ENI. If multiple arguments are provided, they are treated as -arg=>value parameter pairs. Arguments: The -subnet_id argument is mandatory. Others are optional. -subnet_id -- ID of the VPC subnet to associate with the network interface (mandatory) -private_ip_address -- The primary private IP address of the network interface, or a reference to an array of private IP addresses. In the latter case, the first element of the array becomes the primary address, and the subsequent ones become secondary addresses. If no private IP address is specified, one will be chosen for you. See below for more information on this parameter. -private_ip_addresses -- Same as -private_ip_address, for readability. -secondary_ip_address_count -- An integer requesting this number of secondary IP addresses to be allocated automatically. If present, cannot provide any secondary addresses explicitly. -description -- Description of this ENI. -security_group_id -- Array reference or scalar containing IDs of the security group(s) to assign to this interface. You can assign multiple IP addresses to the interface explicitly, or by allowing EC2 to choose addresses within the designated subnet automatically. The following examples demonstrate the syntax: # one primary address, chosen explicitly -private_ip_address => '192.168.0.12' # one primary address and two secondary addresses, chosen explicitly -private_ip_address => ['192.168.0.12','192.168.0.200','192.168.0.201'] # one primary address chosen explicitly, and two secondaries chosen automatically -private_ip_address => ['192.168.0.12','auto','auto'] # one primary address chosen explicitly, and two secondaries chosen automatically (another syntax) -private_ip_address => ['192.168.0.12',2] # one primary address chosen automatically, and two secondaries chosen automatically -private_ip_address => [auto,2] You cannot assign some secondary addresses explicitly and others automatically on the same ENI. If you provide no -private_ip_address parameter at all, then a single private IP address will be chosen for you (the same as -private_ip_address=>'auto'). The return value is a VM::EC2::NetworkInterface object =cut # NOTE: there is code overlap with network_interface_parm() sub create_network_interface { my $self = shift; my %args = $self->args(-subnet_id=>@_); $args{-subnet_id} or croak "Usage: create_network_interface(-subnet_id=>\$id,\@more_args)"; my @parm = $self->single_parm('SubnetId',\%args); push @parm, $self->single_parm('Description',\%args); push @parm, $self->list_parm('SecurityGroupId',\%args); my $address = $args{-private_ip_address} || $args{-private_ip_addresses}; my $auto_count; if ($address) { my $c = 0; my @addresses = ref $address && ref $address eq 'ARRAY' ? @$address : ($address); my $primary = shift @addresses; unless ($primary eq 'auto') { push @parm, ("PrivateIpAddresses.$c.PrivateIpAddress" => $primary); push @parm, ("PrivateIpAddresses.$c.Primary" => 'true'); } # deal with automatic secondary addresses .. this seems needlessly complex if (my @auto = grep {/auto/i} @addresses) { @auto == @addresses or croak "cannot request both explicit and automatic secondary IP addresses"; $auto_count = @auto; } $auto_count = $addresses[0] if @addresses == 1 && $addresses[0] =~ /^\d+$/; $auto_count ||= $args{-secondary_ip_address_count}; unless ($auto_count) { foreach (@addresses) { $c++; push @parm,("PrivateIpAddresses.$c.PrivateIpAddress" => $_ ); push @parm,("PrivateIpAddresses.$c.Primary" => 'false'); } } } push @parm,('SecondaryPrivateIpAddressCount'=>$auto_count) if $auto_count ||= $args{-secondary_ip_address_count}; $self->call('CreateNetworkInterface',@parm); } =head2 $result = $ec2->assign_private_ip_addresses(%args) Assign one or more secondary private IP addresses to a network interface. You can either set the addresses explicitly, or provide a count of secondary addresses, and let Amazon select them for you. Required arguments: -network_interface_id The network interface to which the IP address(es) will be assigned. -private_ip_address One or more secondary IP addresses, as a scalar string -private_ip_addresses or array reference. (The two arguments are equivalent). Optional arguments: -allow_reassignment If true, allow assignment of an IP address is already in use by another network interface or instance. The following are valid arguments to -private_ip_address: -private_ip_address => '192.168.0.12' # single address -private_ip_address => ['192.168.0.12','192.168.0.13] # multiple addresses -private_ip_address => 3 # autoselect three addresses The mixed form of address, such as ['192.168.0.12','auto'] is not allowed in this call. On success, this method returns true. =cut sub assign_private_ip_addresses { my $self = shift; my %args = $self->args(-network_interface_id => @_); $args{-private_ip_address} ||= $args{-private_ip_addresses}; $args{-network_interface_id} && $args{-private_ip_address} or croak "usage: assign_private_ip_addresses(-network_interface_id=>\$id,-private_ip_address=>\\\@addresses)"; my @parms = $self->single_parm('NetworkInterfaceId',\%args); if (!ref($args{-private_ip_address}) && $args{-private_ip_address} =~ /^\d+$/) { push @parms,('SecondaryPrivateIpAddressCount' => $args{-private_ip_address}); } else { push @parms,$self->list_parm('PrivateIpAddress',\%args); } push @parms,('AllowReassignment' => $args{-allow_reassignment} ? 'true' : 'false') if exists $args{-allow_reassignment}; $self->call('AssignPrivateIpAddresses',@parms); } =head2 $result = $ec2->unassign_private_ip_addresses(%args) Unassign one or more secondary private IP addresses from a network interface. Required arguments: -network_interface_id The network interface to which the IP address(es) will be assigned. -private_ip_address One or more secondary IP addresses, as a scalar string -private_ip_addresses or array reference. (The two arguments are equivalent). The following are valid arguments to -private_ip_address: -private_ip_address => '192.168.0.12' # single address -private_ip_address => ['192.168.0.12','192.168.0.13] # multiple addresses On success, this method returns true. =cut sub unassign_private_ip_addresses { my $self = shift; my %args = $self->args(-network_interface_id => @_); $args{-private_ip_address} ||= $args{-private_ip_addresses}; $args{-network_interface_id} && $args{-private_ip_address} or croak "usage: assign_private_ip_addresses(-network_interface_id=>\$id,-private_ip_address=>\\\@addresses)"; my @parms = $self->single_parm('NetworkInterfaceId',\%args); push @parms,$self->list_parm('PrivateIpAddress',\%args); $self->call('UnassignPrivateIpAddresses',@parms); } =head2 $result = $ec2->delete_network_interface($network_interface_id); =head2 $result = $ec2->delete_network_interface(-network_interface_id => $id); Deletes the specified network interface. Returns a boolean indicating success of the delete operation. =cut sub delete_network_interface { my $self = shift; my %args = $self->args(-network_interface_id => @_); my @param = $self->single_parm(NetworkInterfaceId=>\%args); return $self->call('DeleteNetworkInterface',@param); } =head2 @ifs = $ec2->describe_network_interfaces(@interface_ids) =head2 @ifs = $ec2->describe_network_interfaces(\%filters) =head2 @ifs = $ec2->describe_network_interfaces(-network_interface_id=>\@interface_ids,-filter=>\%filters) Return a list of elastic network interfaces as VM::EC2::VPC::NetworkInterface objects. You may restrict the list by passing a list of network interface IDs, a hashref of filters or by using the full named-parameter form. Optional arguments: -network_interface_id A single network interface ID or an arrayref to a list of IDs. -filter A hashref for filtering on tags and other attributes. The list of valid filters can be found at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeNetworkInterfaces.html. =cut sub describe_network_interfaces { my $self = shift; my %args = $self->args(-network_interface_id=>@_); my @params = $self->list_parm('NetworkInterfaceId',\%args); push @params,$self->filter_parm(\%args); return $self->call('DescribeNetworkInterfaces',@params); } =head2 @data = $ec2->describe_network_interface_attribute($network_id,$attribute) This method returns network interface attributes. Only one attribute can be retrieved at a time. The following is the list of attributes that can be retrieved: description -- hashref groupSet -- hashref sourceDestCheck -- hashref attachment -- hashref These values can be retrieved more conveniently from the L object, so there is no attempt to parse the results of this call into Perl objects. =cut sub describe_network_interface_attribute { my $self = shift; @_ == 2 or croak "Usage: describe_network_interface_attribute(\$interface_id,\$attribute_name)"; my ($interface_id,$attribute) = @_; my @param = (NetworkInterfaceId=>$interface_id,Attribute=>$attribute); my $result = $self->call('DescribeNetworkInterfaceAttribute',@param); return $result && $result->attribute($attribute); } =head2 $boolean = $ec2->modify_network_interface_attribute($interface_id,-$attribute_name=>$value) This method changes network interface attributes. Only one attribute can be set per call The following is the list of attributes that can be set: -description -- interface description -security_group_id -- single security group ID or arrayref to a list of group ids -source_dest_check -- boolean; if false enables packets to be forwarded, and is necessary for NAT and other router tasks -delete_on_termination -- [$attachment_id=>$delete_on_termination]; Pass this a two-element array reference consisting of the attachment ID and a boolean indicating whether deleteOnTermination should be enabled for this attachment. =cut sub modify_network_interface_attribute { my $self = shift; my $interface_id = shift or croak "Usage: modify_network_interface_attribute(\$interfaceId,%param)"; my %args = @_; my @param = (NetworkInterfaceId=>$interface_id); push @param,$self->value_parm($_,\%args) foreach qw(Description SourceDestCheck); push @param,$self->list_parm('SecurityGroupId',\%args); if (my $dot = $args{-delete_on_termination}) { my ($attachment_id,$delete_on_termination) = @$dot; push @param,'Attachment.AttachmentId'=>$attachment_id; push @param,'Attachment.DeleteOnTermination'=>$delete_on_termination ? 'true' : 'false'; } return $self->call('ModifyNetworkInterfaceAttribute',@param); } =head2 $boolean = $ec2->reset_network_interface_attribute($interface_id => $attribute_name) This method resets the named network interface attribute to its default value. Only one attribute can be reset per call. The AWS documentation is not completely clear on this point, but it appears that the only attribute that can be reset using this method is: source_dest_check -- Turns on source destination checking For consistency with modify_network_interface_attribute, you may specify attribute names with or without a leading dash, and using either under_score or mixedCase naming: $ec2->reset_network_interface_atribute('eni-12345678' => 'source_dest_check'); $ec2->reset_network_interface_atribute('eni-12345678' => '-source_dest_check'); $ec2->reset_network_interface_atribute('eni-12345678' => sourceDestCheck); =cut sub reset_network_interface_attribute { my $self = shift; @_ == 2 or croak "Usage: reset_network_interface_attribute(\$interfaceId,\$attribute)"; my ($interface_id,$attribute) = @_; $attribute = s/^-//; $attribute = $self->uncanonicalize($attribute); my @param = (NetworkInterfaceId=> $interface_id, Attribute => $attribute ); return $self->call('ResetNetworkInterfaceAttribute',@param); } =head2 $attachmentId = $ec2->attach_network_interface($network_interface_id,$instance_id,$device_index) =head2 $attachmentId = $ec2->attach_network_interface(-network_interface_id => $id, -instance_id => $id, -device_index => $index) This method attaches a network interface to an instance using the indicated device index. You can use instance and network interface IDs, or VM::EC2::Instance and VM::EC2::NetworkInterface objects. You may use an integer for -device_index, or use the strings "eth0", "eth1" etc. Required arguments: -network_interface_id ID of the network interface to attach. -instance_id ID of the instance to attach the interface to. -device_index Network device number to use (e.g. 0 for eth0). On success, this method returns the attachmentId of the new attachment (not a VM::EC2::NetworkInterface::Attachment object, due to an AWS API inconsistency). Note that it may be more convenient to attach and detach network interfaces via methods in the VM::EC2::Instance and VM::EC2::NetworkInterface objects: $instance->attach_network_interface($interface=>'eth0'); $interface->attach($instance=>'eth0'); =cut sub attach_network_interface { my $self = shift; my %args; if ($_[0] !~ /^-/ && @_ == 3) { @args{qw(-network_interface_id -instance_id -device_index)} = @_; } else { %args = @_; } $args{-network_interface_id} && $args{-instance_id} && defined $args{-device_index} or croak "-network_interface_id, -instance_id and -device_index arguments must all be specified"; $args{-device_index} =~ s/^eth//; my @param = $self->single_parm(NetworkInterfaceId=>\%args); push @param,$self->single_parm(InstanceId=>\%args); push @param,$self->single_parm(DeviceIndex=>\%args); return $self->call('AttachNetworkInterface',@param); } =head2 $boolean = $ec2->detach_network_interface($attachment_id [,$force]) This method detaches a network interface from an instance. Both the network interface and instance are specified using their attachmentId. If the $force flag is present, and true, then the detachment will be forced even if the interface is in use. Note that it may be more convenient to attach and detach network interfaces via methods in the VM::EC2::Instance and VM::EC2::NetworkInterface objects: $instance->detach_network_interface($interface); $interface->detach(); =cut sub detach_network_interface { my $self = shift; my ($attachment_id,$force) = @_; $attachment_id or croak "Usage: detach_network_interface(\$attachment_id [,\$force])"; my @param = (AttachmentId => $attachment_id); push @param,(Force => 'true') if defined $force && $force; return $self->call('DetachNetworkInterface',@param); } =head1 Elastic Load Balancers (ELB) The methods in this section allow you to retrieve information about Elastic Load Balancers, create new ELBs, and change the properties of the ELBs. The primary object manipulated by these methods is L. Please see the L manual page =head2 @lbs = $ec2->describe_load_balancers(-load_balancer_name=>\@names) =head2 @lbs = $ec2->describe_load_balancers(@names) Provides detailed configuration information for the specified ELB(s). Optional parameters are: -load_balancer_names Name of the ELB to return information on. This can be a string scalar, or an arrayref. -lb_name,-lb_names, -load_balancer_name Aliases for -load_balancer_names Returns a series of L objects. =cut sub describe_load_balancers { my $self = shift; my %args = $self->args('-load_balancer_names',@_); $args{'-load_balancer_names'} ||= $args{-lb_name}; $args{'-load_balancer_names'} ||= $args{-lb_names}; $args{'-load_balancer_names'} ||= $args{-load_balancer_name}; my @params = $self->member_list_parm('LoadBalancerNames',\%args); push @params,$self->filter_parm(\%args); return $self->elb_call('DescribeLoadBalancers',@params); } =head2 $success = $ec2->delete_load_balancer(-load_balancer_name=>$name) =head2 $success = $ec2->delete_load_balancer($name) Deletes the specified ELB. Arguments: -load_balancer_name -- The name of the ELB to delete -lb_name -- Alias for -load_balancer_name Returns true on successful deletion. NOTE: This API call will return success regardless of existence of the ELB. =cut sub delete_load_balancer { my $self = shift; my %args = $self->args('-load_balancer_name',@_); $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_name} or croak "delete_load_balancer(): -load_balancer_name argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); return $self->elb_call('DeleteLoadBalancer',@params); } =head2 $healthcheck = $ec2->configure_health_check(-load_balancer_name => $name, -healthy_threshold => $cnt, -interval => $secs, -target => $target, -timeout => $secs, -unhealthy_threshold => $cnt) Define an application healthcheck for the instances. All Parameters are required. -load_balancer_name Name of the ELB. -healthy_threashold Specifies the number of consecutive health probe successes required before moving the instance to the Healthy state. -interval Specifies the approximate interval, in seconds, between health checks of an individual instance. -target Must be a string in the form: Protocol:Port[/PathToPing] - Valid Protocol types are: HTTP, HTTPS, TCP, SSL - Port must be in range 1-65535 - PathToPing is only applicable to HTTP or HTTPS protocol types and must be 1024 characters long or fewer. -timeout Specifies the amount of time, in seconds, during which no response means a failed health probe. -unhealthy_threashold Specifies the number of consecutive health probe failures required before moving the instance to the Unhealthy state. -lb_name Alias for -load_balancer_name Returns a L object. =cut sub configure_health_check { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_name} or croak "configure_health_check(): -load_balancer_name argument missing"; $args{-healthy_threshold} && $args{-interval} && $args{-target} && $args{-timeout} && $args{-unhealthy_threshold} or croak "configure_health_check(): healthcheck argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, map {$self->prefix_parm('HealthCheck',$_,\%args)} qw(HealthyThreshold Interval Target Timeout UnhealthyThreshold); return $self->elb_call('ConfigureHealthCheck',@params); } =head2 $success = $ec2->create_app_cookie_stickiness_policy(-load_balancer_name => $name, -cookie_name => $cookie, -policy_name => $policy) Generates a stickiness policy with sticky session lifetimes that follow that of an application-generated cookie. This policy can be associated only with HTTP/HTTPS listeners. Required arguments: -load_balancer_name Name of the ELB. -cookie_name Name of the application cookie used for stickiness. -policy_name The name of the policy being created. The name must be unique within the set of policies for this ELB. -lb_name Alias for -load_balancer_name Returns true on successful execution. =cut sub create_app_cookie_stickiness_policy { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_name} or croak "create_app_cookie_stickiness_policy(): -load_balancer_name argument missing"; $args{-cookie_name} && $args{-policy_name} or croak "create_app_cookie_stickiness_policy(): -cookie_name or -policy_name option missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, map {$self->single_parm($_,\%args)} qw(CookieName PolicyName); return $self->elb_call('CreateAppCookieStickinessPolicy',@params); } =head2 $success = $ec2->create_lb_cookie_stickiness_policy(-load_balancer_name => $name, -cookie_expiration_period => $secs, -policy_name => $policy) Generates a stickiness policy with sticky session lifetimes controlled by the lifetime of the browser (user-agent) or a specified expiration period. This policy can be associated only with HTTP/HTTPS listeners. Required arguments: -load_balancer_name Name of the ELB. -cookie_expiration_period The time period in seconds after which the cookie should be considered stale. Not specifying this parameter indicates that the sticky session will last for the duration of the browser session. OPTIONAL -policy_name The name of the policy being created. The name must be unique within the set of policies for this ELB. -lb_name Alias for -load_balancer_name Returns true on successful execution. =cut sub create_lb_cookie_stickiness_policy { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_name} or croak "create_lb_cookie_stickiness_policy(): -load_balancer_name argument missing"; $args{-cookie_expiration_period} && $args{-policy_name} or croak "create_lb_cookie_stickiness_policy(): -cookie_expiration_period or -policy_name option missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, map {$self->single_parm($_,\%args)} qw(CookieExpirationPeriod PolicyName); return $self->elb_call('CreateLBCookieStickinessPolicy',@params); } =head2 $lb = $ec2->create_load_balancer(-load_balancer_name => $name, -listeners => \@listeners, -availability_zones => \@zones, -scheme => $scheme, ) Creates a new ELB. Required arguments: -load_balancer_name Name of the ELB. -listeners Must either be a L object (or arrayref of objects) or a hashref (or arrayref of hashrefs) containing the following keys: Protocol -- Value as one of: HTTP, HTTPS, TCP, or SSL LoadBalancerPort -- Value in range 1-65535 InstancePort -- Value in range 1-65535 and optionally: InstanceProtocol -- Value as one of: HTTP, HTTPS, TCP, or SSL SSLCertificateId -- Certificate ID from AWS IAM certificate list -availability_zones Literal string or array of strings containing valid availability zones. Optional if subnets are specified in a VPC usage scenario. Optional arguments: -scheme The type of ELB. By default, Elastic Load Balancing creates an Internet-facing LoadBalancer with a publicly resolvable DNS name, which resolves to public IP addresses. Specify the value 'internal' for this option to create an internal LoadBalancer with a DNS name that resolves to private IP addresses. This option is only available in a VPC. -security_groups The security groups assigned to your ELB within your VPC. String or arrayref. -subnets A list of subnet IDs in your VPC to attach to your ELB. String or arrayref. REQUIRED if availability zones are not specified above. Argument aliases: -zones Alias for -availability_zones -lb_name Alias for -load_balancer_name Returns a L object if successful. =cut sub create_load_balancer { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-availability_zones } ||= $args{-zones}; $args{-load_balancer_name} or croak "create_load_balancer(): -load_balancer_name argument missing"; $args{-listeners} or croak "create_load_balancer(): -listeners option missing"; $args{-availability_zones} || $args{-subnets} or croak "create_load_balancer(): -availability_zones option is required if subnets are not specified"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->_listener_parm($args{-listeners}); push @params, $self->member_list_parm('AvailabilityZones',\%args); push @params, $self->single_parm('Scheme',\%args); push @params, $self->member_list_parm('SecurityGroups',\%args); push @params, $self->member_list_parm('Subnets',\%args); return if (! defined $self->elb_call('CreateLoadBalancer',@params)); return $self->describe_load_balancers($args{-load_balancer_name}); } # Internal method for building ELB listener parameters sub _listener_parm { my $self = shift; my $l = shift; my @param; my $i = 1; for my $lsnr (ref $l && ref $l eq 'ARRAY' ? @$l : $l) { if (ref $lsnr && ref $lsnr eq 'HASH') { push @param,("Listeners.member.$i.Protocol"=> $lsnr->{Protocol}); push @param,("Listeners.member.$i.LoadBalancerPort"=> $lsnr->{LoadBalancerPort}); push @param,("Listeners.member.$i.InstancePort"=> $lsnr->{InstancePort}); push @param,("Listeners.member.$i.InstanceProtocol"=> $lsnr->{InstanceProtocol}) if $lsnr->{InstanceProtocol}; push @param,("Listeners.member.$i.SSLCertificateId"=> $lsnr->{SSLCertificateId}) if $lsnr->{SSLCertificateId}; $i++; } elsif (ref $lsnr && ref $lsnr eq 'VM::EC2::ELB::Listener') { push @param,("Listeners.member.$i.Protocol"=> $lsnr->Protocol); push @param,("Listeners.member.$i.LoadBalancerPort"=> $lsnr->LoadBalancerPort); push @param,("Listeners.member.$i.InstancePort"=> $lsnr->InstancePort); if (my $InstanceProtocol = $lsnr->InstanceProtocol) { push @param,("Listeners.member.$i.InstanceProtocol"=> $InstanceProtocol) } if (my $SSLCertificateId = $lsnr->SSLCertificateId) { push @param,("Listeners.member.$i.SSLCertificateId"=> $SSLCertificateId) } $i++; } } return @param; } =head2 $success = $ec2->create_load_balancer_listeners(-load_balancer_name => $name, -listeners => \@listeners) Creates one or more listeners on a ELB for the specified port. If a listener with the given port does not already exist, it will be created; otherwise, the properties of the new listener must match the properties of the existing listener. -listeners Must either be a L object (or arrayref of objects) or a hash (or arrayref of hashes) containing the following keys: Protocol -- Value as one of: HTTP, HTTPS, TCP, or SSL LoadBalancerPort -- Value in range 1-65535 InstancePort -- Value in range 1-65535 and optionally: InstanceProtocol -- Value as one of: HTTP, HTTPS, TCP, or SSL SSLCertificateId -- Certificate ID from AWS IAM certificate list -lb_name Alias for -load_balancer_name Returns true on successful execution. =cut sub create_load_balancer_listeners { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_name} or croak "create_load_balancer_listeners(): -load_balancer_name argument missing"; $args{-listeners} or croak "create_load_balancer_listeners(): -listeners option missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->_listener_parm($args{-listeners}); return $self->elb_call('CreateLoadBalancerListeners',@params); } =head2 $success = $ec2->delete_load_balancer_listeners(-load_balancer_name => $name, -load_balancer_ports => \@ports) Deletes listeners from the ELB for the specified port. Arguments: -load_balancer_name The name of the ELB -load_balancer_ports An arrayref of strings or literal string containing the port numbers. -ports Alias for -load_balancer_ports -lb_name Alias for -load_balancer_name Returns true on successful execution. =cut sub delete_load_balancer_listeners { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_ports} ||= $args{-ports}; $args{-load_balancer_name} or croak "delete_load_balancer_listeners(): -load_balancer_name argument missing"; $args{-load_balancer_ports} or croak "delete_load_balancer_listeners(): -load_balancer_ports argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->member_list_parm('LoadBalancerPorts',\%args); return $self->elb_call('DeleteLoadBalancerListeners',@params); } =head2 @z = $ec2->disable_availability_zones_for_load_balancer(-load_balancer_name => $name, -availability_zones => \@zones) Removes the specified EC2 Availability Zones from the set of configured Availability Zones for the ELB. There must be at least one Availability Zone registered with a LoadBalancer at all times. Instances registered with the ELB that are in the removed Availability Zone go into the OutOfService state. Arguments: -load_balancer_name The name of the ELB -availability_zones Arrayref or literal string of availability zone names (ie. us-east-1a) -zones Alias for -availability_zones -lb_name Alias for -load_balancer_name Returns an array of L objects now associated with the ELB. =cut sub disable_availability_zones_for_load_balancer { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-availability_zones} ||= $args{-zones}; $args{-load_balancer_name} or croak "disable_availability_zones_for_load_balancer(): -load_balancer_name argument missing"; $args{-availability_zones} or croak "disable_availability_zones_for_load_balancer(): -availability_zones argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->member_list_parm('AvailabilityZones',\%args); my @zones = $self->elb_call('DisableAvailabilityZonesForLoadBalancer',@params) or return; return $self->describe_availability_zones(@zones); } =head2 @z = $ec2->enable_availability_zones_for_load_balancer(-load_balancer_name => $name, -availability_zones => \@zones) Adds one or more EC2 Availability Zones to the ELB. The ELB evenly distributes requests across all its registered Availability Zones that contain instances. Arguments: -load_balancer_name The name of the ELB -availability_zones Array or literal string of availability zone names (ie. us-east-1a) -zones Alias for -availability_zones -lb_name Alias for -load_balancer_name Returns an array of L objects now associated with the ELB. =cut sub enable_availability_zones_for_load_balancer { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-availability_zones} ||= $args{-zones}; $args{-load_balancer_name} or croak "enable_availability_zones_for_load_balancer(): -load_balancer_name argument missing"; $args{-availability_zones} or croak "enable_availability_zones_for_load_balancer(): -availability_zones argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->member_list_parm('AvailabilityZones',\%args); my @zones = $self->elb_call('EnableAvailabilityZonesForLoadBalancer',@params) or return; return $self->describe_availability_zones(@zones); } =head2 @i = $ec2->register_instances_with_load_balancer(-load_balancer_name => $name, -instances => \@instance_ids) Adds new instances to the ELB. If the instance is in an availability zone that is not registered with the ELB will be in the OutOfService state. Once the zone is added to the ELB the instance will go into the InService state. Arguments: -load_balancer_name The name of the ELB -instances An arrayref or literal string of Instance IDs. -lb_name Alias for -load_balancer_name Returns an array of instances now associated with the ELB in the form of L objects. =cut sub register_instances_with_load_balancer { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-instances} ||= $args{-instance_id}; $args{-load_balancer_name} or croak "register_instances_with_load_balancer(): -load_balancer_name argument missing"; $args{-instances} or croak "register_instances_with_load_balancer(): -instances argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->_perm_parm('Instances','member','InstanceId',$args{-instances}); my @i = $self->elb_call('RegisterInstancesWithLoadBalancer',@params) or return; return $self->describe_instances(@i); } =head2 @i = $ec2->deregister_instances_from_load_balancer(-load_balancer_name => $name, -instances => \@instance_ids) Deregisters instances from the ELB. Once the instance is deregistered, it will stop receiving traffic from the ELB. Arguments: -load_balancer_name The name of the ELB -instances An arrayref or literal string of Instance IDs. -lb_name Alias for -load_balancer_name Returns an array of instances now associated with the ELB in the form of L objects. =cut sub deregister_instances_from_load_balancer { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-instances} ||= $args{-instance_id}; $args{-load_balancer_name} or croak "deregister_instances_from_load_balancer(): -load_balancer_name argument missing"; $args{-instances} or croak "deregister_instances_from_load_balancer(): -instances argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->_perm_parm('Instances','member','InstanceId',$args{-instances}); my @i = $self->elb_call('DeregisterInstancesFromLoadBalancer',@params) or return; return $self->describe_instances(@i); } =head2 $success = $ec2->set_load_balancer_listener_ssl_certificate(-load_balancer_name => $name, -load_balancer_port => $port, -ssl_certificate_id => $cert_id) Sets the certificate that terminates the specified listener's SSL connections. The specified certificate replaces any prior certificate that was used on the same ELB and port. Required arguments: -load_balancer_name The name of the the ELB. -load_balancer_port The port that uses the specified SSL certificate. -ssl_certificate_id The ID of the SSL certificate chain to use. See the AWS Identity and Access Management documentation under Managing Server Certificates for more information. Alias arguments: -lb_name Alias for -load_balancer_name -port Alias for -load_balancer_port -cert_id Alias for -ssl_certificate_id Returns true on successful execution. =cut sub set_load_balancer_listener_ssl_certificate { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_port} ||= $args{-port}; $args{-ssl_certificate_id} ||= $args{-cert_id}; $args{-load_balancer_name} or croak "set_load_balancer_listener_ssl_certificate(): -load_balancer_name argument missing"; $args{-load_balancer_port} or croak "set_load_balancer_listener_ssl_certificate(): -load_balancer_port argument missing"; $args{-ssl_certificate_id} or croak "set_load_balancer_listener_ssl_certificate(): -ssl_certificate_id argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->single_parm('LoadBalancerPort',\%args); push @params,('SSLCertificateId'=>$args{-ssl_certificate_id}) if $args{-ssl_certificate_id}; return $self->elb_call('SetLoadBalancerListenerSSLCertificate',@params); } =head2 @states = $ec2->describe_instance_health(-load_balancer_name => $name, -instances => \@instance_ids) Returns the current state of the instances of the specified LoadBalancer. If no instances are specified, the state of all the instances for the ELB is returned. Required arguments: -load_balancer_name The name of the ELB Optional parameters: -instances Literal string or arrayref of Instance IDs -lb_name Alias for -load_balancer_name -instance_id Alias for -instances Returns an array of L objects. =cut sub describe_instance_health { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-instances} ||= $args{-instance_id}; $args{-load_balancer_name} or croak "describe_instance_health(): -load_balancer_name argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->_perm_parm('Instances','member','InstanceId',$args{-instances}); return $self->elb_call('DescribeInstanceHealth',@params); } =head2 $success = $ec2->create_load_balancer_policy(-load_balancer_name => $name, -policy_name => $policy, -policy_type_name => $type_name, -policy_attributes => \@attrs) Creates a new policy that contains the necessary attributes depending on the policy type. Policies are settings that are saved for your ELB and that can be applied to the front-end listener, or the back-end application server, depending on your policy type. Required Arguments: -load_balancer_name The name associated with the LoadBalancer for which the policy is being created. This name must be unique within the client AWS account. -policy_name The name of the ELB policy being created. The name must be unique within the set of policies for this ELB. -policy_type_name The name of the base policy type being used to create this policy. To get the list of policy types, use the describe_load_balancer_policy_types function. Optional Arguments: -policy_attributes Arrayref of hashes containing AttributeName and AttributeValue -lb_name Alias for -load_balancer_name Returns true if successful. =cut sub create_load_balancer_policy { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_name} or croak "create_load_balancer_policy(): -load_balancer_name argument missing"; $args{-policy_name} or croak "create_load_balancer_policy(): -policy_name argument missing"; $args{-policy_type_name} or croak "create_load_balancer_policy(): -policy_type_name argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->single_parm('PolicyName',\%args); push @params, $self->single_parm('PolicyTypeName',\%args); push @params, $self->_policy_attr_parm($args{-policy_attributes}); return $self->elb_call('CreateLoadBalancerPolicy',@params); } # internal method for building policy attribute parameters sub _policy_attr_parm { my $self = shift; my $p = shift; my @param; my $i = 1; for my $policy (ref $p && ref $p eq 'ARRAY' ? @$p : $p) { if (ref $policy && ref $policy eq 'HASH') { push @param,("PolicyAttributes.member.$i.AttributeName"=> $policy->{AttributeName}); push @param,("PolicyAttributes.member.$i.AttributeValue"=> $policy->{AttributeValue}); $i++; } elsif (ref $policy && ref $policy eq 'VM::EC2::ELB::PolicyAttribute') { push @param,("PolicyAttributes.member.$i.AttributeName"=> $policy->AttributeName); push @param,("PolicyAttributes.member.$i.AttributeValue"=> $policy->AttributeValue); $i++; } } return @param; } =head2 $success = $ec2->delete_load_balancer_policy(-load_balancer_name => $name, -policy_name => $policy) Deletes a policy from the ELB. The specified policy must not be enabled for any listeners. Arguments: -load_balancer_name The name of the ELB -policy_name The name of the ELB policy -lb_name Alias for -load_balancer_name Returns true if successful. =cut sub delete_load_balancer_policy { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_name} or croak "delete_load_balancer_policy(): -load_balancer_name argument missing"; $args{-policy_name} or croak "delete_load_balancer_policy(): -policy_name argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->single_parm('PolicyName',\%args); return $self->elb_call('DeleteLoadBalancerPolicy',@params); } =head2 @policy_descs = $ec2->describe_load_balancer_policies(-load_balancer_name => $name, -policy_names => \@names) Returns detailed descriptions of ELB policies. If you specify an ELB name, the operation returns either the descriptions of the specified policies, or descriptions of all the policies created for the ELB. If you don't specify a ELB name, the operation returns descriptions of the specified sample policies, or descriptions of all the sample policies. The names of the sample policies have the ELBSample- prefix. Optional Arguments: -load_balancer_name The name of the ELB. -policy_names The names of ELB policies created or ELB sample policy names. -lb_name Alias for -load_balancer_name Returns an array of L objects if successful. =cut sub describe_load_balancer_policies { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-policy_names} ||= $args{-policy_name}; $args{-load_balancer_name} or croak "describe_load_balancer_policies(): -load_balancer_name argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->member_list_parm('PolicyNames',\%args); return $self->elb_call('DescribeLoadBalancerPolicies',@params); } =head2 @policy_types = $ec2->describe_load_balancer_policy_types(-policy_type_names => \@names) Returns meta-information on the specified ELB policies defined by the Elastic Load Balancing service. The policy types that are returned from this action can be used in a create_load_balander_policy call to instantiate specific policy configurations that will be applied to an ELB. Required arguemnts: -load_balancer_name The name of the ELB. Optional arguments: -policy_type_names Literal string or arrayref of policy type names -names Alias for -policy_type_names Returns an array of L objects if successful. =cut sub describe_load_balancer_policy_types { my $self = shift; my %args = @_; $args{-policy_type_names} ||= $args{-names}; my @params = $self->member_list_parm('PolicyTypeNames',\%args); return $self->elb_call('DescribeLoadBalancerPolicyTypes',@params); } =head2 $success = $ec2->set_load_balancer_policies_of_listener(-load_balancer_name => $name, -load_balancer_port => $port, -policy_names => \@names) Associates, updates, or disables a policy with a listener on the ELB. Multiple policies may be associated with a listener. Required arguments: -load_balancer_name The name associated with the ELB. -load_balancer_port The external port of the LoadBalancer with which this policy applies to. -policy_names List of policies to be associated with the listener. Currently this list can have at most one policy. If the list is empty, the current policy is removed from the listener. String or arrayref. Returns true if successful. =cut sub set_load_balancer_policies_of_listener { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_port} ||= $args{-port}; $args{-load_balancer_name} or croak "set_load_balancer_policies_of_listener(): -load_balancer_name argument missing"; $args{-load_balancer_port} or croak "set_load_balancer_policies_of_listener(): -load_balancer_port argument missing"; $args{-policy_names} or croak "set_load_balancer_policies_of_listener(): -policy_names argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->single_parm('LoadBalancerPort',\%args); push @params, $self->member_list_parm('PolicyNames',\%args); return $self->elb_call('SetLoadBalancerPoliciesOfListener',@params); } =head2 @sgs = $ec2->apply_security_groups_to_load_balancer(-load_balancer_name => $name, -security_groups => \@groups) Associates one or more security groups with your ELB in VPC. The provided security group IDs will override any currently applied security groups. Required arguments: -load_balancer_name The name associated with the ELB. -security_groups A list of security group IDs to associate with your ELB in VPC. The security group IDs must be provided as the ID and not the security group name (For example, sg-123456). String or arrayref. Returns a series of L objects. =cut sub apply_security_groups_to_load_balancer { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_name} or croak "apply_security_groups_to_load_balancer(): -load_balancer_name argument missing"; $args{-security_groups} or croak "apply_security_groups_to_load_balancer(): -security_groups argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->member_list_parm('SecurityGroups',\%args); my @g = $self->elb_call('ApplySecurityGroupsToLoadBalancer',@params) or return; return $self->describe_security_groups(@g); } =head2 @subnets = $ec2->attach_load_balancer_to_subnets(-load_balancer_name => $name, -subnets => \@subnets) Adds one or more subnets to the set of configured subnets for the ELB. Required arguments: -load_balancer_name The name associated with the ELB. -subnets A list of subnet IDs to add for the ELB. String or arrayref. Returns a series of L objects corresponding to the subnets the ELB is now attached to. =cut sub attach_load_balancer_to_subnets { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_name} or croak "attach_load_balancer_to_subnets(): -load_balancer_name argument missing"; $args{-subnets} or croak "attach_load_balancer_to_subnets(): -subnets argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->member_list_parm('Subnets',\%args); my @sn = $self->elb_call('AttachLoadBalancerToSubnets',@params) or return; return $self->describe_subnets(@sn); } =head2 @subnets = $ec2->detach_load_balancer_from_subnets(-load_balancer_name => $name, -subnets => \@subnets) Removes subnets from the set of configured subnets in the VPC for the ELB. Required arguments: -load_balancer_name The name associated with the ELB. -subnets A list of subnet IDs to add for the ELB. String or arrayref. Returns a series of L objects corresponding to the subnets the ELB is now attached to. =cut sub detach_load_balancer_from_subnets { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-load_balancer_name} or croak "detach_load_balancer_from_subnets(): -load_balancer_name argument missing"; $args{-subnets} or croak "detach_load_balancer_from_subnets(): -subnets argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->member_list_parm('Subnets',\%args); my @sn = $self->elb_call('DetachLoadBalancerFromSubnets',@params) or return; return $self->describe_subnets(@sn); } =head2 $success = $ec2->set_load_balancer_policies_for_backend_server(-instance_port => $port, -load_balancer_name => $name, -policy_names => \@policies) Replaces the current set of policies associated with a port on which the back- end server is listening with a new set of policies. After the policies have been created, they can be applied here as a list. At this time, only the back- end server authentication policy type can be applied to the back-end ports; this policy type is composed of multiple public key policies. Required arguments: -load_balancer_name The name associated with the ELB. -instance_port The port number associated with the back-end server. -policy_names List of policy names to be set. If the list is empty, then all current polices are removed from the back-end server. Aliases: -port Alias for -instance_port -lb_name Alias for -load_balancer_name Returns true if successful. =cut sub set_load_balancer_policies_for_backend_server { my $self = shift; my %args = @_; $args{-load_balancer_name} ||= $args{-lb_name}; $args{-instance_port} ||= $args{-port}; $args{-load_balancer_name} or croak "set_load_balancer_policies_for_backend_server(): -load_balancer_name argument missing"; $args{-instance_port} or croak "set_load_balancer_policies_for_backend_server(): -instance_port argument missing"; $args{-policy_names} or croak "set_load_balancer_policies_for_backend_server(): -policy_names argument missing"; my @params = $self->single_parm('LoadBalancerName',\%args); push @params, $self->single_parm('InstancePort',\%args); push @params, $self->member_list_parm('PolicyNames',\%args); return $self->elb_call('SetLoadBalancerPoliciesForBackendServer',@params); } =head1 AWS SECURITY TOKENS AWS security tokens provide a way to grant temporary access to resources in your EC2 space without giving them permanent accounts. They also provide the foundation for mobile services and multifactor authentication devices (MFA). Used in conjunction with VM::EC2::Security::Policy and VM::EC2::Security::Credentials, you can create a temporary user who is authenticated for a limited length of time and pass the credentials to him or her via a secure channel. He or she can then create a credentials object to access your AWS resources. Here is an example: # on your side of the connection $ec2 = VM::EC2->new(...); # as usual my $policy = VM::EC2::Security::Policy->new; $policy->allow('DescribeImages','RunInstances'); my $token = $ec2->get_federation_token(-name => 'TemporaryUser', -duration => 60*60*3, # 3 hrs, as seconds -policy => $policy); my $serialized = $token->credentials->serialize; send_data_to_user_somehow($serialized); # on the temporary user's side of the connection my $serialized = get_data_somehow(); my $token = VM::EC2::Security::Credentials->new_from_serialized($serialized); my $ec2 = VM::EC2->new(-security_token => $token); print $ec2->describe_images(-owner=>'self'); For temporary users who are not using the Perl VM::EC2 API, you can transmit the required fields individually: my $credentials = $token->credentials; my $access_key_id = $credentials->accessKeyId; my $secret_key = $credentials->secretKey; my $session_token = $credentials->sessionToken; send_data_to_user_somehow($session_token, $access_key_id, $secret_key); Calls to get_federation_token() return a VM::EC2::Security::Token object. This object contains two sub-objects, a VM::EC2::Security::Credentials object, and a VM::EC2::Security::FederatedUser object. The Credentials object contains a temporary access key ID, secret access key, and session token which together can be used to authenticate to the EC2 API. The FederatedUser object contains the temporary user account name and ID. See L, L, L, and L. =cut =head2 $token = $ec2->get_federation_token($username) =head2 $token = $ec2->get_federation_token(-name=>$username,@args) This method creates a new temporary user under the provided username and returns a VM::EC2::Security::Token object that contains temporary credentials for the user, as well as information about the user's account. Other options allow you to control the duration for which the credentials will be valid, and the policy the controls what resources the user is allowed to access. =over 4 =item Required arguments: -name The username The username must comply with the guidelines described in http://docs.amazonwebservices.com/IAM/latest/UserGuide/LimitationsOnEntities.html: essentially all alphanumeric plus the characters [+=,.@-]. =item Optional arguments: -duration_seconds Length of time the session token will be valid for, expressed in seconds. -duration Same thing, faster to type. -policy A VM::EC2::Security::Policy object, or a JSON string complying with the IAM policy syntax. The duration must be no shorter than 1 hour (3600 seconds) and no longer than 36 hours (129600 seconds). If no duration is specified, Amazon will default to 12 hours. If no policy is provided, then the user will not be able to execute B actions. Note that if the temporary user wishes to create a VM::EC2 object and specify a region name at create time (e.g. VM::EC2->new(-region=>'us-west-1'), then the user must have access to the DescribeRegions action: $policy->allow('DescribeRegions') Otherwise the call to new() will fail. =back =cut sub get_federation_token { my $self = shift; my %args = $self->args('-name',@_); $args{-name} or croak "Usage: get_federation_token(-name=>\$name,\@more_args)"; $args{-duration_seconds} ||= $args{-duration}; my @p = map {$self->single_parm($_,\%args)} qw(Name DurationSeconds Policy); return $self->sts_call('GetFederationToken',@p); } =head2 $token = $ec2->get_session_token(%args) This method creates a temporary VM::EC2::Security::Token object for an anonymous user. The token has no policy associated with it, and can be used to run any of the EC2 actions available to the user who created the token. Optional arguments allow the session token to be used in conjunction with MFA devices. =over 4 =item Required arguments: none =item Optional arguments: -duration_seconds Length of time the session token will be valid for, expressed in seconds. -duration Same thing, faster to type. -serial_number The identification number of the user's MFA device, if any. -token_code The code provided by the MFA device, if any. If no duration is specified, Amazon will default to 12 hours. See http://docs.amazonwebservices.com/IAM/latest/UserGuide/Using_ManagingMFA.html for information on using AWS in conjunction with MFA devices. =back =cut sub get_session_token { my $self = shift; my %args = @_; my @p = map {$self->single_parm($_,\%args)} qw(SerialNumber DurationSeconds TokenCode); return $self->sts_call('GetSessionToken',@p); } =head1 LAUNCH CONFIGURATIONS =head2 @lc = $ec2->describe_launch_configurations(-names => \@names); =head2 @lc = $ec->describe_launch_configurations(@names); Provides detailed information for the specified launch configuration(s). Optional parameters are: -launch_configuration_names Name of the Launch config. This can be a string scalar or an arrayref. -name Alias for -launch_configuration_names Returns a series of L objects. =cut sub describe_launch_configurations { my $self = shift; my %args = $self->args('-launch_configuration_names',@_); $args{-launch_configuration_names} ||= $args{-names}; my @params = $self->list_parm('LaunchConfigurationNames',\%args); return $self->asg_call('DescribeLaunchConfigurations', @params); } =head2 $success = $ec2->create_launch_configuration(%args); Creates a new launch configuration. Required arguments: -name -- scalar, name for the Launch config. -image_id -- scalar, AMI id which this launch config will use -instance_type -- scalar, instance type of the Amazon EC2 instance. Optional arguments: -block_device_mappings -- list of hashref -ebs_optimized -- scalar (boolean). false by default -iam_instance_profile -- scalar -instance_monitoring -- scalar (boolean). true by default -kernel_id -- scalar -key_name -- scalar -ramdisk -- scalar -security_groups -- list of scalars -spot_price -- scalar -user_data -- scalar Returns true on successful execution. =cut sub create_launch_configuration { my $self = shift; my %args = @_; my $name = $args{-name} or croak "-name argument is required"; my $imageid = $args{-image_id} or croak "-image_id argument is required"; my $itype = $args{-instance_type} or croak "-instance_type argument is required"; my @params = (ImageId => $imageid, InstanceType => $itype, LaunchConfigurationName => $name); push @params, $self->member_list_parm('BlockDeviceMappings',\%args); push @params, $self->member_list_parm('SecurityGroups',\%args); push @params, $self->boolean_parm('EbsOptimized', \%args); push @params, ('UserData' =>encode_base64($args{-user_data},'')) if $args{-user_data}; push @params, ('InstanceMonitoring.Enabled' => 'false') if (exists $args{-instance_monitoring} and not $args{-instance_monitoring}); my @p = map {$self->single_parm($_,\%args) } qw(IamInstanceProfile KernelId KeyName RamdiskId SpotPrice); push @params, @p; return $self->asg_call('CreateLaunchConfiguration',@params); } =head2 $success = $ec2->delete_launch_configuration(-name => $name); Deletes a launch config. -name Required. Name of the launch config to delete Returns true on success. =cut sub delete_launch_configuration { my $self = shift; my %args = @_; my $name = $args{-name} or croak "-name argument is required"; my @params = (LaunchConfigurationName => $name); return $self->asg_call('DeleteLaunchConfiguration', @params); } =head1 AUTOSCALING GROUPS =head2 @asg = $ec2->describe_autoscaling_groups(-auto_scaling_group_names => \@names); Returns information about autoscaling groups -auto_scaling_group_names List of auto scaling groups to describe -names Alias of -auto_scaling_group_names Returns a list of L. =cut sub describe_autoscaling_groups { my ($self, %args) = @_; $args{-auto_scaling_group_names} ||= $args{-names}; my @params = $self->member_list_parm('AutoScalingGroupNames',\%args); return $self->asg_call('DescribeAutoScalingGroups', @params); } =head2 $success = $ec2->create_autoscaling_group(-name => $name, -launch_config => $lc, -max_size => $max_size, -min_size => $min_size); Creates a new autoscaling group. Required arguments: -name Name for the autoscaling group -launch_config Name of the launch configuration to be used -max_size Max number of instances to be run at once -min_size Min number of instances Optional arguments: -availability_zones List of availability zone names -load_balancer_names List of ELB names -tags List of tags to apply to the instances run -termination_policies List of policy names -default_cooldown Time in seconds between autoscaling activities -desired_capacity Number of instances to be run after creation -health_check_type One of "ELB" or "EC2" -health_check_grace_period Mandatory for health check type ELB. Number of seconds between an instance is started and the autoscaling group starts checking its health -placement_group Physical location of your cluster placement group -vpc_zone_identifier Strinc containing a comma-separated list of subnet identifiers Returns true on success. =cut sub create_autoscaling_group { my $self = shift; my %args = @_; my $name = $args{-name} or croak "-name argument is required"; my $lconfig = $args{-launch_config} or croak "-launch_config argument is required"; my $max = $args{-max_size}; croak "-max_size argument is required" if (not defined $max); my $min = $args{-min_size}; croak "-min_size argument is required" if (not defined $min); my @params = (AutoScalingGroupName => $name, LaunchConfigurationName => $lconfig, MaxSize => $max, MinSize => $max); push @params, $self->member_list_parm('AvailabilityZones',\%args); push @params, $self->member_list_parm('LoadBalancerNames',\%args); push @params, $self->member_list_parm('TerminationPolicies',\%args); push @params, $self->autoscaling_tags('Tags', \%args); my @p = map {$self->single_parm($_,\%args) } qw( DefaultCooldown DesiredCapacity HealthCheckGracePeriod HealthCheckType PlacementGroup VPCZoneIdentifier); push @params, @p; return $self->asg_call('CreateAutoScalingGroup',@params); } =head2 $success = $ec2->delete_autoscaling_group(-name => $name) Deletes an autoscaling group. -name Name of the autoscaling group to delete Returns true on success. =cut sub delete_autoscaling_group { my $self = shift; my %args = @_; my $name = $args{-name} or croak "-name argument is required"; my @params = (AutoScalingGroupName => $name); push @params, $self->single_parm('ForceDelete',\%args); return $self->asg_call('DeleteAutoScalingGroup', @params); } =head2 $success = $ec2->update_autoscaling_group(-name => $name); Updates an autoscaling group. Only required parameter is C<-name> Optional arguments: -availability_zones List of AZ's -termination_policies List of policy names -default_cooldown -desired_capacity -health_check_type -health_check_grace_period -placement_group -vpc_zone_identifier -max_size -min_size Returns true on success; =cut sub update_autoscaling_group { my $self = shift; my %args = @_; my $name = $args{-name} or croak "-name argument is required"; my @params = (AutoScalingGroupName => $name); push @params, $self->member_list_parm('AvailabilityZones',\%args); push @params, $self->member_list_parm('TerminationPolicies',\%args); my @p = map {$self->single_parm($_,\%args) } qw( DefaultCooldown DesiredCapacity HealthCheckGracePeriod HealthCheckType PlacementGroup VPCZoneIdentifier MaxSize MinSize ); push @params, @p; return $self->asg_call('UpdateAutoScalingGroup',@params); } =head2 $success = $ec2->suspend_processes(-name => $asg_name, -scaling_processes => \@procs); Suspend the requested autoscaling processes. -name Name of the autoscaling group -scaling_processes List of process names to suspend. Valid processes are: Launch Terminate HealthCheck ReplaceUnhealty AZRebalance AlarmNotification ScheduledActions AddToLoadBalancer Returns true on success. =cut sub suspend_processes { my ($self, %args) = @_; my $name = $args{-name} or croak "-name argument is required"; my @params = (AutoScalingGroupName => $name); push @params, $self->member_list_parm('ScalingProcesses', \%args); return $self->asg_call('SuspendProcesses', @params); } =head2 $success = $ec2->resume_processes(-name => $asg_name, -scaling_processes => \@procs); Resumes the requested autoscaling processes. It accepts the same arguments than C. Returns true on success. =cut sub resume_processes { my ($self, %args) = @_; my $name = $args{-name} or croak "-name argument is required"; my @params = (AutoScalingGroupName => $name); push @params, $self->member_list_parm('ScalingProcesses', \%args); return $self->asg_call('ResumeProcesses', @params); } # ------------------------------------------------------------------------------------------ =head1 INTERNAL METHODS These methods are used internally and are listed here without documentation (yet). =head2 $underscore_name = $ec2->canonicalize($mixedCaseName) =cut sub canonicalize { my $self = shift; my $name = shift; while ($name =~ /\w[A-Z]/) { $name =~ s/([a-zA-Z])([A-Z])/\L$1_$2/g or last; } return '-'.lc $name; } sub uncanonicalize { my $self = shift; my $name = shift; $name =~ s/_([a-z])/\U$1/g; return $name; } =head2 $instance_id = $ec2->instance_parm(@args) =cut sub instance_parm { my $self = shift; my %args; if ($_[0] =~ /^-/) { %args = @_; } elsif (@_ > 1) { %args = (-instance_id => [@_]); } else { %args = (-instance_id => shift); } my $id = $args{-instance_id}; return ref $id && ref $id eq 'ARRAY' ? @$id : $id; } =head2 @arguments = $ec2->value_parm(ParameterName => \%args) =cut sub value_parm { my $self = shift; my ($argname,$args) = @_; my $name = $self->canonicalize($argname); return unless exists $args->{$name} || exists $args->{"-$argname"}; my $val = $args->{$name} || $args->{"-$argname"}; return ("$argname.Value"=>$val); } =head2 @arguments = $ec2->single_parm(ParameterName => \%args) =cut sub single_parm { my $self = shift; my ($argname,$args) = @_; my $name = $self->canonicalize($argname); my $val = $args->{$name} || $args->{"-$argname"}; defined $val or return; my $v = ref $val && ref $val eq 'ARRAY' ? $val->[0] : $val; return ($argname=>$v); } =head2 @parameters = $ec2->prefix_parm($prefix, ParameterName => \%args) =cut sub prefix_parm { my $self = shift; my ($prefix,$argname,$args) = @_; my $name = $self->canonicalize($argname); my $val = $args->{$name} || $args->{"-$argname"}; defined $val or return; my $v = ref $val && ref $val eq 'ARRAY' ? $val->[0] : $val; return ("$prefix.$argname"=>$v); } =head2 @parameters = $ec2->member_list_parm(ParameterName => \%args) =cut sub member_list_parm { my $self = shift; my ($argname,$args) = @_; my $name = $self->canonicalize($argname); my @params; if (my $a = $args->{$name}||$args->{"-$argname"}) { my $c = 1; for (ref $a && ref $a eq 'ARRAY' ? @$a : $a) { push @params,("$argname.member.".$c++ => $_); } } return @params; } =head2 @arguments = $ec2->list_parm(ParameterName => \%args) =cut sub list_parm { my $self = shift; my ($argname,$args) = @_; my $name = $self->canonicalize($argname); my @params; if (my $a = $args->{$name}||$args->{"-$argname"}) { my $c = 1; for (ref $a && ref $a eq 'ARRAY' ? @$a : $a) { push @params,("$argname.".$c++ => $_); } } return @params; } =head2 @arguments = $ec2->autoscaling_tags($argname, \%args) =cut sub autoscaling_tags { my $self = shift; my ($argname, $args) = @_; my $name = $self->canonicalize($argname); my @params; if (my $a = $args->{$name}||$args->{"-$argname"}) { my $c = 1; for my $tag (ref $a && ref $a eq 'ARRAY' ? @$a : $a) { my $prefix = "$argname.member." . $c++; while (my ($k, $v) = each %$tag) { push @params, ("$prefix.$k" => $v); } } } return @params; } =head2 @arguments = $ec2->filter_parm(\%args) =cut sub filter_parm { my $self = shift; my $args = shift; return $self->key_value_parameters('Filter','Name','Value',$args); } =head2 @arguments = $ec2->tagcreate_parm(\%args) =cut sub tagcreate_parm { my $self = shift; my $args = shift; return $self->key_value_parameters('Tag','Key','Value',$args); } =head2 @arguments = $ec2->tagdelete_parm(\%args) =cut sub tagdelete_parm { my $self = shift; my $args = shift; return $self->key_value_parameters('Tag','Key','Value',$args,1); } =head2 @arguments = $ec2->key_value_parameters($param_name,$keyname,$valuename,\%args,$skip_undef_values) =cut sub key_value_parameters { my $self = shift; # e.g. 'Filter', 'Name','Value',{-filter=>{a=>b}} my ($parameter_name,$keyname,$valuename,$args,$skip_undef_values) = @_; my $arg_name = $self->canonicalize($parameter_name); my @params; if (my $a = $args->{$arg_name}||$args->{"-$parameter_name"}) { my $c = 1; if (ref $a && ref $a eq 'HASH') { while (my ($name,$value) = each %$a) { push @params,("$parameter_name.$c.$keyname" => $name); if (ref $value && ref $value eq 'ARRAY') { for (my $m=1;$m<=@$value;$m++) { push @params,("$parameter_name.$c.$valuename.$m" => $value->[$m-1]) } } else { push @params,("$parameter_name.$c.$valuename" => $value) unless !defined $value && $skip_undef_values; } $c++; } } else { for (ref $a ? @$a : $a) { my ($name,$value) = /([^=]+)\s*=\s*(.+)/; push @params,("$parameter_name.$c.$keyname" => $name); push @params,("$parameter_name.$c.$valuename" => $value) unless !defined $value && $skip_undef_values; $c++; } } } return @params; } =head2 @arguments = $ec2->launch_perm_parm($prefix,$suffix,$value) =cut sub launch_perm_parm { my $self = shift; my ($prefix,$suffix,$value) = @_; return unless defined $value; $self->_perm_parm('LaunchPermission',$prefix,$suffix,$value); } sub create_volume_perm_parm { my $self = shift; my ($prefix,$suffix,$value) = @_; return unless defined $value; $self->_perm_parm('CreateVolumePermission',$prefix,$suffix,$value); } sub _perm_parm { my $self = shift; my ($base,$prefix,$suffix,$value) = @_; return unless defined $value; my @list = ref $value && ref $value eq 'ARRAY' ? @$value : $value; my $c = 1; my @param; for my $v (@list) { push @param,("$base.$prefix.$c.$suffix" => $v); $c++; } return @param; } =head2 @arguments = $ec2->iam_parm($args) =cut sub iam_parm { my $self = shift; my $args = shift; my @p; push @p,('IamInstanceProfile.Arn' => $args->{-iam_arn}) if $args->{-iam_arn}; push @p,('IamInstanceProfile.Name' => $args->{-iam_name}) if $args->{-iam_name}; return @p; } =head2 @arguments = $ec2->block_device_parm($block_device_mapping_string) =cut sub block_device_parm { my $self = shift; my $devlist = shift or return; my @dev = ref $devlist && ref $devlist eq 'ARRAY' ? @$devlist : $devlist; my @p; my $c = 1; for my $d (@dev) { $d =~ /^([^=]+)=([^=]+)$/ or croak "block device mapping must be in format /dev/sdXX=device-name"; my ($devicename,$blockdevice) = ($1,$2); push @p,("BlockDeviceMapping.$c.DeviceName"=>$devicename); if ($blockdevice =~ /^vol-/) { # this is a volume, and not a snapshot my ($volume,$delete_on_term) = split ':',$blockdevice; push @p,("BlockDeviceMapping.$c.Ebs.VolumeId" => $volume); push @p,("BlockDeviceMapping.$c.Ebs.DeleteOnTermination"=>$delete_on_term) if defined $delete_on_term && $delete_on_term=~/^(true|false|1|0)$/ } elsif ($blockdevice eq 'none') { push @p,("BlockDeviceMapping.$c.NoDevice" => ''); } elsif ($blockdevice =~ /^ephemeral\d$/) { push @p,("BlockDeviceMapping.$c.VirtualName"=>$blockdevice); } else { my ($snapshot,$size,$delete_on_term,$vtype,$iops) = split ':',$blockdevice; # Workaround for apparent bug in 2012-12-01 API; instances will crash without volume size # even if a snapshot ID is provided if ($snapshot) { $size ||= eval{$self->describe_snapshots($snapshot)->volumeSize}; push @p,("BlockDeviceMapping.$c.Ebs.SnapshotId" =>$snapshot); } push @p,("BlockDeviceMapping.$c.Ebs.VolumeSize" =>$size) if $size; push @p,("BlockDeviceMapping.$c.Ebs.DeleteOnTermination"=>$delete_on_term) if defined $delete_on_term && $delete_on_term=~/^(true|false|1|0)$/; push @p,("BlockDeviceMapping.$c.Ebs.VolumeType"=>$vtype) if $vtype; push @p,("BlockDeviceMapping.$c.Ebs.Iops"=>$iops) if $iops; } $c++; } return @p; } # ['eth0=eni-123456','eth1=192.168.2.1,192.168.3.1,192.168.4.1:subnet-12345:sg-12345:true:My Weird Network'] # form 1: ethX=network device id # form 2: ethX=primary_address,secondary_address1,secondary_address2...:subnetId:securityGroupId:deleteOnTermination:description # form 3: ethX=primary_address,secondary_address_count:subnetId:securityGroupId:deleteOnTermination:description sub network_interface_parm { my $self = shift; my $args = shift; my $devlist = $args->{-network_interfaces} or return; my @dev = ref $devlist && ref $devlist eq 'ARRAY' ? @$devlist : $devlist; my @p; my $c = 0; for my $d (@dev) { $d =~ /^eth(\d+)\s*=\s*([^=]+)$/ or croak "network device mapping must be in format ethX=option-string"; my ($device_index,$device_options) = ($1,$2); push @p,("NetworkInterface.$c.DeviceIndex" => $device_index); my @options = split ':',$device_options; if (@options == 1) { push @p,("NetworkInterface.$c.NetworkInterfaceId" => $options[0]); } else { my ($ip_addresses,$subnet_id,$security_group_id,$delete_on_termination,$description) = @options; my @addresses = split /\s*,\s*/,$ip_addresses; for (my $a = 0; $a < @addresses; $a++) { if ($addresses[$a] =~ /^\d+\.\d+\.\d+\.\d+$/ ) { push @p,("NetworkInterface.$c.PrivateIpAddresses.$a.PrivateIpAddress" => $addresses[$a]); push @p,("NetworkInterface.$c.PrivateIpAddresses.$a.Primary" => $a == 0 ? 'true' : 'false'); } elsif ($addresses[$a] =~ /^\d+$/ && $a > 0) { push @p,("NetworkInterface.$c.SecondaryPrivateIpAddressCount" => $addresses[$a]); } } my @sgs = split ',',$security_group_id; for (my $i=0;$i<@sgs;$i++) { push @p,("NetworkInterface.$c.SecurityGroupId.$i" => $sgs[$i]); } push @p,("NetworkInterface.$c.SubnetId" => $subnet_id) if length $subnet_id; push @p,("NetworkInterface.$c.DeleteOnTermination" => $delete_on_termination) if length $delete_on_termination; push @p,("NetworkInterface.$c.Description" => $description) if length $description; } $c++; } return @p; } sub boolean_parm { my $self = shift; my ($argname,$args) = @_; my $name = $self->canonicalize($argname); return unless exists $args->{$name} || exists $args->{$argname}; my $val = $args->{$name} || $args->{$argname}; return ($argname => $val ? 'true' : 'false'); } =head2 $version = $ec2->version() API version. =cut sub version { my $self = shift; return $self->{version} ||= '2012-12-01'; } =head2 $ts = $ec2->timestamp =cut sub timestamp { return strftime("%Y-%m-%dT%H:%M:%SZ",gmtime); } =head2 $ua = $ec2->ua LWP::UserAgent object. =cut sub ua { my $self = shift; return $self->{ua} ||= LWP::UserAgent->new; } =head2 @obj = $ec2->call($action,@param); Make a call to Amazon using $action and the passed arguments, and return a list of objects. =cut sub call { my $self = shift; my $response = $self->make_request(@_); unless ($response->is_success) { my $content = $response->decoded_content; my $error; if ($content =~ //) { $error = VM::EC2::Dispatch->create_error_object($response->decoded_content,$self,$_[0]); } else { my $code = $response->status_line; my $msg = $response->decoded_content; $error = VM::EC2::Error->new({Code=>$code,Message=>"$msg from API call '$_[0]')"},$self); } $self->error($error); carp "$error" if $self->print_error; croak "$error" if $self->raise_error; return; } $self->error(undef); my @obj = VM::EC2::Dispatch->response2objects($response,$self); # slight trick here so that we return one object in response to # describe_images(-image_id=>'foo'), rather than the number "1" if (!wantarray) { # scalar context return $obj[0] if @obj == 1; return if @obj == 0; return @obj; } else { return @obj; } } sub sts_call { my $self = shift; local $self->{endpoint} = 'https://sts.amazonaws.com'; local $self->{version} = '2011-06-15'; $self->call(@_); } sub elb_call { my $self = shift; (my $endpoint = $self->{endpoint}) =~ s/ec2/elasticloadbalancing/; local $self->{endpoint} = $endpoint; local $self->{version} = '2012-06-01'; $self->call(@_); } sub asg_call { my $self = shift; (my $endpoint = $self->{endpoint}) =~ s/ec2/autoscaling/; local $self->{endpoint} = $endpoint; local $self->{version} = '2011-01-01'; $self->call(@_); } =head2 $request = $ec2->make_request($action,@param); Set up the signed HTTP::Request object. =cut sub make_request { my $self = shift; my ($action,@args) = @_; my $request = $self->_sign(Action=>$action,@args); return $self->ua->request($request); } =head2 $request = $ec2->_sign(@args) Create and sign an HTTP::Request. =cut # adapted from Jeff Kim's Net::Amazon::EC2 module sub _sign { my $self = shift; my @args = @_; my $action = 'POST'; my $host = lc URI->new($self->endpoint)->host; my $path = '/'; my %sign_hash = @args; $sign_hash{AWSAccessKeyId} = $self->id; $sign_hash{Timestamp} = $self->timestamp; $sign_hash{Version} = $self->version; $sign_hash{SignatureVersion} = 2; $sign_hash{SignatureMethod} = 'HmacSHA256'; $sign_hash{SecurityToken} = $self->security_token if $self->security_token; my @param; my @parameter_keys = sort keys %sign_hash; for my $p (@parameter_keys) { push @param,join '=',map {uri_escape($_,"^A-Za-z0-9\-_.~")} ($p,$sign_hash{$p}); } my $to_sign = join("\n", $action,$host,$path,join('&',@param)); my $signature = encode_base64(hmac_sha256($to_sign,$self->secret),''); $sign_hash{Signature} = $signature; my $uri = URI->new($self->endpoint); $uri->query_form(\%sign_hash); return POST $self->endpoint,[%sign_hash]; } =head2 @param = $ec2->args(ParamName=>@_) Set up calls that take either method(-resource_id=>'foo') or method('foo'). =cut sub args { my $self = shift; my $default_param_name = shift; return unless @_; return @_ if $_[0] =~ /^-/; return (-filter=>shift) if @_==1 && ref $_[0] && ref $_[0] eq 'HASH'; return ($default_param_name => \@_); } =head1 MISSING METHODS As of 24 Dec 2012, the following Amazon API calls were NOT implemented. Volunteers to implement these calls are most welcome. BundleInstance CancelBundleTask CancelConversionTask CancelReservedInstancesListing CreateReservedInstancesListing DescribeBundleTasks DescribeConversionTasks DescribeReservedInstancesListings ImportInstance ImportVolume =head1 OTHER INFORMATION This section contains technical information that may be of interest to developers. =head2 Signing and authentication protocol This module uses Amazon AWS signing protocol version 2, as described at http://docs.amazonwebservices.com/AWSEC2/latest/UserGuide/index.html?using-query-api.html. It uses the HmacSHA256 signature method, which is the most secure method currently available. For additional security, use "https" for the communications endpoint: $ec2 = VM::EC2->new(-endpoint=>'https://ec2.amazonaws.com'); =head2 Subclassing VM::EC2 objects To subclass VM::EC2 objects (or implement your own from scratch) you will need to override the object dispatch mechanism. Fortunately this is very easy. After "use VM::EC2" call VM::EC2::Dispatch->add_override() one or more times: VM::EC2::Dispatch->add_override($call_name => $dispatch). The first argument, $call_name, is name of the Amazon API call, such as "DescribeImages". The second argument, $dispatch, instructs VM::EC2::Dispatch how to create objects from the parsed XML. There are three possible syntaxes: 1) A CODE references, such as an anonymous subroutine. In this case the code reference will be invoked to handle the parsed XML returned from the request. The code will receive two arguments consisting of the parsed content of the response, and the VM::EC2 object used to generate the request. 2) A VM::EC2::Dispatch method name, optionally followed by its arguments delimited by commas. Example: "fetch_items,securityGroupInfo,VM::EC2::SecurityGroup" This tells Dispatch to invoke its fetch_items() method with the following arguments: $dispatch->fetch_items($parsed_xml,$ec2,'securityGroupInfo','VM::EC2::SecurityGroup') The fetch_items() method is used for responses in which a list of objects is embedded within a series of tags. See L for more information. Other commonly-used methods are "fetch_one", and "boolean". 3) A class name, such as 'MyVolume' In this case, class MyVolume is loaded and then its new() method is called with the four arguments ($parsed_xml,$ec2,$xmlns,$requestid), where $parsed_xml is the parsed XML response, $ec2 is the VM::EC2 object that generated the request, $xmlns is the XML namespace of the XML response, and $requestid is the AWS-generated ID for the request. Only the first two arguments are really useful. I suggest you inherit from VM::EC2::Generic and use the inherited new() method to store the parsed XML object and other arguments. Dispatch tries each of (1), (2) and (3), in order. This means that class names cannot collide with method names. The parsed content is the result of passing the raw XML through a XML::Simple object created with: XML::Simple->new(ForceArray => ['item'], KeyAttr => ['key'], SuppressEmpty => undef); In general, this will give you a hash of hashes. Any tag named 'item' will be forced to point to an array reference, and any tag named "key" will be flattened as described in the XML::Simple documentation. A simple way to examine the raw parsed XML is to invoke any VM::EC2::Generic's as_string() method: my ($i) = $ec2->describe_instances; print $i->as_string; This will give you a Data::Dumper representation of the XML after it has been parsed. The suggested way to override the dispatch table is from within a subclass of VM::EC2: package 'VM::EC2New'; use base 'VM::EC2'; sub new { my $self=shift; VM::EC2::Dispatch->add_override('call_name_1'=>\&subroutine1). VM::EC2::Dispatch->add_override('call_name_2'=>\&subroutine2). $self->SUPER::new(@_); } See L for a working example of subclassing VM::EC2 and one of its object classes. =head1 DEVELOPING The git source for this library can be found at https://github.com/lstein/LibVM-EC2-Perl, To contribute to development, please obtain a github account and then either: 1) Fork a copy of the repository, make your changes against this repository, and send a pull request to me to incorporate your changes. 2) Contact me by email and ask for push privileges on the repository. See http://help.github.com/ for help getting started. =head1 SEE ALSO L L L L L L L L L L L L L L L L L L L L L L L L L L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut 1; VM-EC2-1.23/lib/VM/EC2000755001751001751 012100273360 13744 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/ELB.pm000444001751001751 5225212100273360 15067 0ustar00lsteinlstein000000000000package VM::EC2::ELB; =head1 NAME VM::EC2::ELB -- Object describing an Elastic Load Balancer =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $lb = $ec2->create_load_balancer(%args); or $lb = $ec2->describe_load_balancers(-load_balancer_name=>'my-lb'); @zones = $lb->AvailabilityZones; $created = $lb->CreatedTime; $dns_name = $lb->DNSName; $health_check = $lb->HealthCheck; @instances = $lb->Instances; @list_desc = $lb->ListenerDescriptions; $name = $lb->LoadBalancerName; @policies_obj = $lb->Policies; @policies = $lb->describe_policies(-policy_names=>'mypolicy'); $scheme = $lb->Scheme; $sg_name = $lb->SourceSecurityGroup; $success = $lb->create_load_balancer_listeners(%args); $success = $lb->enable_availability_zones_for_load_balancer(@zones); @list = $lb->register_instances_with_load_balancer(-instances => 'i-12345678'); $state = $lb->describe_instance_health(-instances => 'i-12345678') $success = $lb->delete_load_balancer; =head1 DESCRIPTION This object represents an Amazon Elastic Load Balancer and is returned by VM::EC2->describe_load_balancers() and VM::EC2->create_load_balancer(). In addition to methods to query the ELB's attributes, there are methods that manage the ELB's lifecycle and properties. =head1 METHODS The following object methods are supported: AvailabilityZones -- The enabled availability zones for the ELB in the form of an array of L objects. BackendServerDescriptions -- The backend server descriptions. CreatedTime -- The creation date of the ELB. DNSName -- The DNS name of the ELB. HealthCheck -- The health check associated with the ELB in the form of a L object. Instances -- The instances that the ELB points to, in the form of an array of L objects. ListenerDescriptions -- An array of L objects. LoadBalancerName -- The name of the ELB Policies -- The policies of the ELB in the form of a L object. Scheme -- Specifies the type of ELB ('internal' is for VPC only.) SecurityGroups -- The security groups the ELB is a member of (VPC only) in the form of L objects. SourceSecurityGroup -- The security group that the ELB is a member of Subnets -- Provides an array of VPC subnet objects (L) that the ELB is part of. VPCId -- Provides the ID of the VPC attached to the ELB. "Unimplemented/untested" object methods related to Route 53 (return raw data/ data structures): CanonicalHostedZoneName -- The name of the Amazon Route 53 hosted zone that is associated with the ELB. CanonicalHostedZoneNameID -- The ID of the Amazon Route 53 hosted zone name that is associated with the ELB. The following convenience methods are supported; active_policies -- Returns the policies that are actively in use by the ELB in the form of L objects. all_policies -- Returns all policies that are associated with the ELB in the form of L objects. listeners -- Provides the L objects associated with the ELB =head1 LIFECYCLE METHODS =head2 $success = $elb->delete_load_balancer =head2 $success = $elb->delete This method deletes the ELB. Returns true on success. =head2 $success = $elb->create_app_cookie_stickiness_policy(-cookie_name=>$cookie_name,-policy_name=>$policy_name) Generates a stickiness policy with sticky session lifetimes that follow that of an application-generated cookie. This policy can be associated only with HTTP/HTTPS listeners. Returns true on success. =head2 $success = $elb->create_lb_cookie_stickiness_policy(-cookie_expiration_period=>$secs,-policy_name=>$name) Generates a stickiness policy with sticky session lifetimes controlled by the lifetime of the browser (user-agent) or a specified expiration period. This policy can be associated only with HTTP/HTTPS listeners. Returns true on success. =head2 $success = $elb->create_load_balancer_listeners(-listeners=>\%listener_hash); =head2 $success = $elb->create_listeners(\%listener_hash); Creates one or more listeners on a ELB for the specified port. If a listener with the given port does not already exist, it will be created; otherwise, the properties of the new listener must match the properties of the existing listener. Returns true on success. The passed argument must either be a L object (or arrayref of objects) or a hash (or arrayref of hashes) containing the following keys: Protocol -- Value as one of: HTTP, HTTPS, TCP, or SSL LoadBalancerPort -- Value in range 1-65535 InstancePort -- Value in range 1-65535 and optionally: InstanceProtocol -- Value as one of: HTTP, HTTPS, TCP, or SSL SSLCertificateId -- Certificate ID from AWS IAM certificate list =head2 $success = $elb->delete_load_balancer_listeners(-load_balancer_ports=>\@ports) =head2 $success = $elb->delete_listeners(@ports) Deletes listeners from the ELB for the specified port. Returns true on success. =head2 @zones = $elb->disable_availability_zones_for_load_balancer(-zones=>\@zones) =head2 @zones = $elb->disable_availability_zones(@zones) =head2 @zones = $elb->disable_zones(@zones) Removes the specified EC2 Availability Zones from the set of configured Availability Zones for the ELB. Returns a series of L objects now associated with the ELB. =head2 @zones = $elb->enable_availability_zones_for_load_balancer(-zones=>\@zones) =head2 @zones = $elb->enable_availability_zones(@zones) =head2 @zones = $elb->enable_zones(@zones) Adds the specified EC2 Availability Zones to the set of configured Availability Zones for the ELB. Returns a series of L objects now associated with the ELB. =head2 @instance_ids = $elb->register_instances_with_load_balancer(-instances=>\@instance_ids) =head2 @instance_ids = $elb->register_instances(@instance_ids) Adds new instances to the ELB. If the instance is in an availability zone that is not registered with the ELB will be in the OutOfService state. Once the zone is added to the ELB the instance will go into the InService state. Returns an array of instance IDs now associated with the ELB. =head2 @instance_ids = $elb->deregister_instances_from_load_balancer(-instances=>\@instance_ids) =head2 @instance_ids = $elb->deregister_instances(@instance_ids) Deregisters instances from the ELB. Once the instance is deregistered, it will stop receiving traffic from the ELB. Returns an array of instance IDs now associated with the ELB. =head2 @states = $elb->describe_instance_health(-instances=>\@instance_ids) =head2 @states = $elb->describe_instance_health(@instance_ids) Provides the current state of the instances of the specified LoadBalancer. If no instances are specified, the state of all the instances for the ELB is returned. Returns an array of L objects. =head2 $success = $elb->create_load_balancer_policy(-policy_name=>$name,-policy_type_name=>$type_name,-policy_attributes=>\@attrs) =head2 $success = $elb->create_policy(-policy_name=>$name,-policy_type_name=>$type_name,-policy_attributes=>\@attrs) Creates a new policy that contains the necessary attributes depending on the policy type. Policies are settings that are saved for your ELB and that can be applied to the front-end listener, or the back-end application server, depending on your policy type. Returns true on success. =head2 $success = $elb->delete_load_balancer_policy(-policy_name=>$policy_name) =head2 $success = $elb->delete_policy($policy_name) Deletes a policy from the ELB. The specified policy must not be enabled for any listeners. Returns true on success. =head1 CONFIGURATION METHODS =head2 $health_check = $elb->configure_health_check(-healthy_threshold=>$cnt,-interval=>$secs,-target=>$target,-timeout=>$secs,-unhealthy_threshold=>$cnt) This method configures the health check for a particular target service. -target must be in the format Protocol:Port[/PathToPing]: - Valid Protocol types are: HTTP, HTTPS, TCP, SSL - Port must be in range 0-65535 - PathToPing is only applicable to HTTP or HTTPS protocol types and must be 1024 characters long or fewer. ex: HTTP:80/index.html =head2 $success = $elb->create_policy(-policy_name=>$name,-policy_type_name=>$type_name) Creates a new policy that contains the necessary attributes depending on the policy type. Returns true on success. =head2 $success = $elb->set_load_balancer_listener_ssl_certificate(-port=>$port,-cert_id=>$cert_id) Sets the certificate that terminates the specified listener's SSL connections. The specified certificate replaces any prior certificate that was used on the same ELB and port. Returns true on success. =head2 $success = $elb->set_load_balancer_policies_of_listener(-port=>$port,-policy_names=>\@names) =head2 $success = $elb->set_policies_of_listener(-port=>$port,-policy_names=>\@names) Associates, updates, or disables a policy with a listener on the ELB. Multiple policies may be associated with a listener. Returns true on success. =head2 @groups = $elb->apply_security_groups_to_load_balancer(-security_groups=>\@groups) =head2 @groups = $elb->apply_security_groups(@groups) Associates one or more security groups with your ELB in VPC. The provided security group IDs will override any currently applied security groups. Returns a list of L objects. =head2 @subnets = $elb->attach_load_balancer_to_subnets(-subnets=>\@subnets) =head2 @subnets = $elb->attach_to_subnets(@subnets) Adds one or more subnets to the set of configured subnets for the ELB. Returns a series of L objects corresponding to the subnets the ELB is now attached to. =head2 @subnets = $elb->detach_load_balancer_from_subnets(-subnets=>\@subnets) =head2 @subnets = $elb->detach_from_subnets(@subnets) Removes subnets from the set of configured subnets in the VPC for the ELB. Returns a series of L objects corresponding to the subnets the ELB is now attached to. =head2 $success = $elb->set_load_balancer_policies_for_backend_server(-port=>$port,-policy_names=>$names) =head2 $success = $elb->set_policies_for_backend_server(-port=>$port,-policy_names=>$names) Replaces the current set of policies associated with a port on which the back- end server is listening with a new set of policies. After the policies have been created, they can be applied here as a list. At this time, only the back- end server authentication policy type can be applied to the back-end ports; this policy type is composed of multiple public key policies. Returns true on success. =head1 INFORMATION METHODS =head2 $state = $lb->describe_instance_health(-instances=>\@instances) =head2 $state = $lb->describe_instance_health(@instances) =head2 $state = $lb->describe_instance_health Returns the current state of the instances registered with the ELB. =head2 @policies = $lb->describe_load_balancer_policies(-policy_names=>\@names) =head2 @policies = $lb->describe_load_balancer_policies; =head1 STRING OVERLOADING When used in a string context, this object will interpolate the Elastic Load Balancer Name. =head1 SEE ALSO L L L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::ELB::HealthCheck; use VM::EC2::ELB::ListenerDescription; use VM::EC2::ELB::BackendServerDescription; use VM::EC2::ELB::Policies; use overload '""' => sub { my $self = shift; return $self->LoadBalancerName}, fallback => 1; sub valid_fields { my $self = shift; return qw(AvailabilityZones BackendServerDescriptions CanonicalHostedZoneName CanonicalHostedZoneNameID CreatedTime DNSName HealthCheck Instances ListenerDescriptions LoadBalancerName Policies Scheme SecurityGroups SourceSecurityGroup Subnets VPCId); } # object methods sub AvailabilityZones { my $self = shift; my $zones = $self->SUPER::AvailabilityZones or return; return $self->aws->describe_availability_zones(@{$zones->{member}}); } sub BackendServerDescriptions { my $self = shift; my $descs = $self->SUPER::BackendServerDescriptions or return; return map { VM::EC2::ELB::BackendServerDescription->new($_,$self->aws) } @{$descs->{member}}; } sub HealthCheck { my $self = shift; my $hc = $self->SUPER::HealthCheck or return; return VM::EC2::ELB::HealthCheck->new($hc,$self->aws); } sub Instances { my $self = shift; my $instances = $self->SUPER::Instances or return; my @i = map { $_->{InstanceId} } @{$instances->{member}}; return $self->aws->describe_instances(@i); } sub ListenerDescriptions { my $self = shift; my $listener_descs = $self->SUPER::ListenerDescriptions or return; return map { VM::EC2::ELB::ListenerDescription->new($_,$self->aws) } @{$listener_descs->{member}}; } sub Policies { my $self = shift; my $policies = $self->SUPER::Policies or return; return VM::EC2::ELB::Policies->new($policies,$self->aws); } sub SecurityGroups { my $self = shift; my $sg = $self->SUPER::SecurityGroups or return; return $self->aws->describe_security_groups(@{$sg->{member}}); } sub SourceSecurityGroup { my $self = shift; my $ssg = $self->SUPER::SourceSecurityGroup or return; return $ssg->{OwnerAlias} . '/' . $ssg->{GroupName}; } sub Subnets { my $self = shift; my $sn = $self->SUPER::Subnets or return; return $self->aws->describe_subnets(@{$sn->{member}}); } # convenience methods sub listeners { my $self = shift; return map { $_->Listener } $self->ListenerDescriptions; } sub active_policies { my $self = shift; my @policies; foreach ($self->ListenerDescriptions) { push @policies,$_->PolicyNames; } my @p = keys %{{ map { $_ => 1 } @policies }}; return $self->aws->describe_load_balancer_policies(-load_balancer_name=>$self->LoadBalancerName,-policy_names=>\@p); } sub all_policies { my $self = shift; return $self->aws->describe_load_balancer_policies(-load_balancer_name=>$self->LoadBalancerName); } sub delete_load_balancer { my $self = shift; return $self->aws->delete_load_balancer($self->LoadBalancerName); } sub delete { shift->delete_load_balancer } sub configure_health_check { my $self = shift; my %args = @_; $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->configure_health_check(%args); } sub create_app_cookie_stickiness_policy { my $self = shift; my %args = @_; $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->create_app_cookie_stickiness_policy(%args); } sub create_lb_cookie_stickiness_policy { my $self = shift; my %args = @_; $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->create_lb_cookie_stickiness_policy(%args); } sub create_load_balancer_listeners { my $self = shift; my %args = @_; $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->create_load_balancer_listeners(%args); } sub create_listeners { shift->create_load_balancer_listeners(@_) } sub delete_load_balancer_listeners { my $self = shift; my %args = $self->args('-load_balancer_ports',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->delete_load_balancer_listeners(%args); } sub delete_listeners { shift->delete_load_balancer_listeners(@_) } sub disable_availability_zones_for_load_balancer { my $self = shift; my %args = $self->args('-availability_zones',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->disable_availability_zones_for_load_balancer(%args); } sub disable_availability_zones { shift->disable_availability_zones_for_load_balancer(@_) } sub disable_zones { shift->disable_availability_zones_for_load_balancer(@_) } sub enable_availability_zones_for_load_balancer { my $self = shift; my %args = $self->args('-availability_zones',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->enable_availability_zones_for_load_balancer(%args); } sub enable_availability_zones { shift->enable_availability_zones_for_load_balancer(@_) } sub enable_zones { shift->enable_availability_zones_for_load_balancer(@_) } sub register_instances_with_load_balancer { my $self = shift; my %args = $self->args('-instances',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->register_instances_with_load_balancer(%args); } sub register_instances { shift->register_instances_with_load_balancer(@_) } sub deregister_instances_from_load_balancer { my $self = shift; my %args = $self->args('-instances',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->deregister_instances_from_load_balancer(%args); } sub deregister_instances { shift->deregister_instances_from_load_balancer(@_) } sub set_load_balancer_listener_ssl_certificate { my $self = shift; my %args = @_; $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->set_load_balancer_listener_ssl_certificate(%args); } sub set_listener_ssl_certificate { shift->set_load_balancer_listener_ssl_certificate(@_) } sub set_ssl_certificate { shift->set_load_balancer_listener_ssl_certificate(@_) } sub describe_instance_health { my $self = shift; my %args = $self->args('-instances',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->describe_instance_health(%args); } sub create_load_balancer_policy { my $self = shift; my %args = @_; $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->create_load_balancer_policy(%args); } sub create_policy { shift->create_load_balancer_policy(@_) } sub delete_load_balancer_policy { my $self = shift; my %args = $self->args('-policy_name',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->delete_load_balancer_policy(%args); } sub delete_policy { shift->delete_load_balancer_policy(@_) } sub describe_load_balancer_policies { my $self = shift; my %args = $self->args('-policy_names',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->describe_load_balancer_policies(%args); } sub describe_policies { shift->describe_load_balancer_policies(@_) } sub set_load_balancer_policies_of_listener { my $self = shift; my %args = @_; $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->set_load_balancer_policies_of_listener(%args); } sub set_policies_of_listener { shift->set_load_balancer_policies_of_listener(@_) } sub set_policies { shift->set_load_balancer_policies_of_listener(@_) } sub apply_security_groups_to_load_balancer { my $self = shift; my %args = $self->args('-security_groups',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->apply_security_groups_to_load_balancer(%args); } sub apply_security_groups { shift->apply_security_groups_to_load_balancer(@_) } sub attach_load_balancer_to_subnets { my $self = shift; my %args = $self->args('-subnets',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->attach_load_balancer_to_subnets(%args); } sub attach_to_subnets { shift->attach_load_balancer_to_subnets(@_) } sub detach_load_balancer_from_subnets { my $self = shift; my %args = $self->args('-subnets',@_); $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->detach_load_balancer_from_subnets(%args); } sub detach_from_subnets { shift->detach_load_balancer_from_subnets(@_) } sub set_load_balancer_policies_for_backend_server { my $self = shift; my %args = @_; $args{-load_balancer_name} = $self->LoadBalancerName; return $self->aws->set_load_balancer_policies_for_backend_server(%args); } sub set_policies_for_backend_server { shift->set_load_balancer_policies_for_backend_server(@_) } sub args { my $self = shift; my $default_param_name = shift; return unless @_; return @_ if $_[0] =~ /^-/; return ($default_param_name => \@_); } 1; VM-EC2-1.23/lib/VM/EC2/SecurityGroup.pm000444001751001751 3120412100273360 17303 0ustar00lsteinlstein000000000000package VM::EC2::SecurityGroup; =head1 NAME VM::EC2::SecurityGroup - Object describing an Amazon EC2 security group =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @sg = $ec2->describe_security_groups; for my $sg (@sg) { $name = $sg->groupName; $id = $sg->groupId; $desc = $sg->groupDescription; $tags = $sg->tags; @inbound_permissions = $sg->ipPermissions; @outbound_permissions = $sg->ipPermissionsEgress; for $i (@inbound_permissions) { $protocol = $i->ipProtocol; $fromPort = $i->fromPort; $toPort = $i->toPort; @ranges = $i->ipRanges; } } $sg = $sg[0]; # Add a new security rule $sg->authorize_incoming(-protocol => 'tcp', -port => 80, -source_ip => ['192.168.2.0/24','192.168.2.1/24'}); # write it to AWS. $sg->update(); =head1 DESCRIPTION This object is used to describe an Amazon EC2 security group. It is returned by VM::EC2->describe_security_groups(). You may also obtain this object by calling an Instance object's groups() method, and then invoking one of the group's permissions() method. See L. =head1 METHODS The following object methods are supported: ownerId -- Owner of this security group groupId -- ID of this security group groupName -- Name of this security group groupDescription -- Description of this group vpcId -- Virtual Private Cloud ID, if applicable ipPermissions -- A list of rules that govern incoming connections to instances running under this security group. Each rule is a L object. ipPermissionsEgress -- A list of rules that govern outgoing connections from instances running under this security group. Each rule is a L. This field is only valid for VPC groups. tags -- Hashref containing tags associated with this group. See L. For convenience, the following aliases are provided for commonly used methods: inbound_permissions -- same as ipPermissions() outbound_permissions -- same as ipPermissionsEgress() name -- same as groupName() See L for details on accessing port numbers, IP ranges and other fields associated with incoming and outgoing firewall rules. =head1 MODIFYING FIREWALL RULES To add or revoke firewall rules, call the authorize_incoming, authorize_outgoing, revoke_incoming or revoke_outgoing() methods one or more times. Each of these methods either adds or removes a single firewall rule. After adding or revoking the desired rules, call update() to write the modified group back to Amazon. The object will change to reflect the new permissions. =head2 $permission = $group->authorize_incoming(%args) Add a rule for incoming firewall traffic. Arguments are as follows: -protocol The protocol, either a string (tcp,udp,icmp) or the corresponding protocol number (6, 17, 1). Use -1 to indicate all protocols. (required) -port, -ports The port or port range. When referring to a single port, you may use either the port number or the service name (e.g. "ssh"). For this to work the service name must be located in /etc/services. When specifying a port range, use "start..end" as in "8000..9000". Note that this is a string that contains two dots, and not two numbers separated by the perl range operator. For the icmp protocol, this argument corresponds to the ICMP type number. (required). -group, -groups Security groups to authorize. Instances that belong to the named security groups will be allowed access. You may specify either a single group or a list of groups as an arrayref. The following syntaxes are recognized: "sg-12345" authorize group with this groupId "12345/my group" authorize group named "my group" owned by user 12345 "my group" authorize group named "my group" owned by yourself -source, -source_ip Authorize incoming traffic from an IP address, IP address range, or set of such ranges. IP addresses use the CIDR notation of a.b.c.d/mask, as described in http://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing. Pass an arrayref to simultaneously authorize multiple CIDR ranges. The result of this call is a L object corresponding to the rule you defined. Note that the rule is not written to Amazon until you call update(). Here are some examples: $sg->authorize_incoming(-protocol => 'tcp', -port => 80, -source_ip => ['192.168.2.0/24','192.168.2.1/24'}); # TCP on ports 22 and 23 from anyone $sg->authorize_incoming(-protocol => 'tcp', -port => '22..23', -source_ip => '0.0.0.0/0'); # ICMP on echo (ping) port from anyone $sg->authorize_incoming(-protocol => 'icmp', -port => 0, -source_ip => '0.0.0.0/0'); # TCP to port 25 (mail) from instances belonging to # the "Mail relay" group belonging to user 12345678. $sg->authorize_incoming(-protocol => 'tcp', -port => 25, -group => '12345678/Mail relay'); =head2 $permission = $group->authorize_outgoing(%args) This is identical to authorize_incoming() except that the rule applies to outbound traffic. Only VPC security groups can define outgoing firewall rules. =head2 $permission = $group->revoke_incoming($rule) =head2 $permission = $group->revoke_incoming(%args) This method revokes an incoming firewall rule. You can call it with a single argument consisting of a L object in order to revoke that rule. Alternatively, when called with the named arguments listed for authorize_incoming(), it will attempt to match an existing rule to the provided arguments and queue it for deletion. Here is an example of revoking all rules that allow ssh (port 22) access: @ssh_rules = grep {$_->fromPort == 22} $group->ipPermissions; $group->revoke_incoming($_) foreach @ssh_rules; $group->update(); =head2 $boolean = $group->update() This method will write all queued rule authorizations and revocations to Amazon, and return a true value if successful. The method will return false if any of the rule updates failed. You can examine the VM::EC2 object's error_str() method to determine what went wrong, and check the group object's ipPermissions() method to see what firewall rules are currently defined. =head2 $boolean = $group->write() An alias for update() =head2 $group->refresh() This method refreshes the group information from Amazon. It is called automatically by update(). =head1 STRING OVERLOADING When used in a string context, this object will interpolate the groupId. =head1 SEE ALSO L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::SecurityGroup::IpPermission; use Carp 'croak'; sub valid_fields { return qw(ownerId groupId groupName groupDescription vpcId ipPermissions ipPermissionsEgress tagSet); } sub primary_id { shift->groupId } sub name { shift->groupName } sub inbound_permissions { shift->ipPermissions } sub outbound_permissions { shift->ipPermissionsEgress } sub ipPermissions { my $self = shift; my $p = $self->SUPER::ipPermissions or return; my @p = map { VM::EC2::SecurityGroup::IpPermission->new($_, $self->aws, $self->xmlns, $self->requestId) } @{$p->{item}}; # tell ip permissions about the owner -- needed for the # group name string. my $owner = $self->ownerId; foreach (@p) {$_->ownerId($owner)} return @p; } sub ipPermissionsEgress { my $self = shift; my $p = $self->SUPER::ipPermissionsEgress or return; my @p = map { VM::EC2::SecurityGroup::IpPermission->new($_,$self->aws,$self->xmlns,$self->requestId)} @{$p->{item}}; # tell ip permissions about the owner -- needed for the # group name string. my $owner = $self->ownerId; foreach (@p) {$_->ownerId($owner)} return @p; } sub _uncommitted_permissions { my $self = shift; my ($action,$direction) = @_; # e.g. 'Authorize','Ingress' my $perms = $self->{uncommitted}{$action}{$direction} or return; return values %$perms; } sub authorize_incoming { my $self = shift; my $permission = $self->_new_permission(@_); $self->{uncommitted}{Authorize}{Ingress}{$permission}=$permission; } sub authorize_outgoing { my $self = shift; my $permission = $self->_new_permission(@_); $self->{uncommitted}{Authorize}{Egress}{$permission}=$permission; } sub revoke_incoming { my $self = shift; my $permission = $_[0] =~ /^-/ ? $self->_new_permission(@_) : shift; if ($self->{uncommitted}{Authorize}{Ingress}{$permission}) { delete $self->{uncommitted}{Authorize}{Ingress}{$permission}; } $self->{uncommitted}{Revoke}{Ingress}{$permission}=$permission; } sub revoke_outgoing { my $self = shift; my $permission = $_[0] =~ /^-/ ? $self->_new_permission(@_) : shift; if ($self->{uncommitted}{Authorize}{Egress}{$permission}) { delete $self->{uncommitted}{Authorize}{Egress}{$permission}; } $self->{uncommitted}{Revoke}{Egress}{$permission}=$permission; } # write permissions out to AWS sub update { my $self = shift; my $aws = $self->aws; my $result = $aws->update_security_group($self); { local $aws->{error}; # so we can do a double-fetch $self->refresh; } return $result; } sub write { shift->update } sub refresh { my $self = shift; local $self->aws->{raise_error} = 1; my $i = $self->aws->describe_security_groups($self->groupId) or return; %$self = %$i; } sub _new_permission { my $self = shift; my %args = @_; my $data = {}; # xml my $protocol = lc $args{-protocol} or croak "-protocol argument required"; $data->{ipProtocol} = $protocol; $args{-source_ip} ||= $args{-source}; my $ports = $args{-port} || $args{-ports}; my ($from_port,$to_port); if ($ports =~ /^(\d+)\.\.(\d+)$/) { $from_port = $1; $to_port = $2; } elsif ($ports =~ /^-?\d+$/) { $from_port = $to_port = $ports; } elsif (my @p = getservbyname($ports,$protocol)) { $from_port = $to_port = $p[2]; } else { croak "value of -port argument not recognized"; } $data->{fromPort} = $from_port; $data->{toPort} = $to_port; my $group = $args{-groups} || $args{-group}; my @groups = ref $group && ref $group eq 'ARRAY' ? @$group :$group ? ($group) : (); for my $g (@groups) { if ($g =~ /^sg-[a-f0-9]+$/) { push @{$data->{groups}{item}},{groupId=>$g}; } elsif (my ($userid,$groupname) = $g =~ m!(\d+)/(.+)!) { push @{$data->{groups}{item}},{userId=>$userid,groupName=>$groupname}; } else { my $userid = $self->aws->account_id; push @{$data->{groups}{item}},{userId=>$userid,groupName=>$g}; } } my $address = $args{-source_ip}; $address && $group and croak "the -source_ip and -group arguments are mutually exclusive"; $address ||= '0.0.0.0/0' unless $group; my @addresses = ref $address && ref $address eq 'ARRAY' ? @$address :$address ? ($address) : (); foreach (@addresses) { $_ = '0.0.0.0/0' if $_ eq 'any' } $data->{ipRanges}{item} = [map {{cidrIp=>$_}} @addresses] if @addresses; my $sg = VM::EC2::SecurityGroup::IpPermission->new($data,$self->aws); $sg->ownerId($self->ownerId); return $sg; } 1; VM-EC2-1.23/lib/VM/EC2/Group.pm000444001751001751 464012100273360 15537 0ustar00lsteinlstein000000000000package VM::EC2::Group; =head1 NAME VM::EC2::Group - Object describing an Amazon EC2 security group name =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $instance = $ec2->describe_instances(-instance_id=>'i-12345'); my @groups = $instance->groups; for my $g (@groups) { my $id = $g->groupId; my $name = $g->groupName; # get the security group details my $sg = $ec2->describe_security_group($g); my $permissions = $sg->ipPermissions; } =head1 DESCRIPTION This object represents the name and ID of a security group. It is returned by an instance's groups() method. This object does not provide any of the details about the security group, but you can use it in a call to VM::EC2->describe_security_group() to get details about the security group's allowed ports, etc. =head1 METHODS These object methods are supported: groupId -- the group ID groupName -- the group's name For convenience, the object also provides a permissions() method that will return the fully detailed VM::EC2::SecurityGroup: $details = $group->permissions() See L =head1 STRING OVERLOADING When used in a string context, this object will interpolate the groupId. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return $self->SUPER::valid_fields, qw(groupId groupName); } sub primary_id { shift->groupId } sub groupName { my $self = shift; my $name = $self->SUPER::groupName; $name =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # for some reason this is URI encoded! $name; } sub permissions { my $self = shift; return $self->{perm} if exists $self->{perm}; my @sg = $self->aws->describe_security_groups(-group_id=>$self->groupId); return unless @sg; die "more than one security group returned?" if @sg > 1; return $self->{perm} = $sg[0]; } 1; VM-EC2-1.23/lib/VM/EC2/Snapshot.pm000444001751001751 2766612100273360 16277 0ustar00lsteinlstein000000000000package VM::EC2::Snapshot; =head1 NAME VM::EC2::Snapshot - Object describing an Amazon EBS snapshot =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @snap = $ec2->describe_snapshots; for my $snap (@snapshots) { $id = $snap->snapshotId; $vol = $snap->volumeId; $state = $snap->status; $time = $snap->startTime; $progress = $snap->progress; $size = $snap->volumeSize; $description = $snap->description; $tags = $snap->tags; } # use a snapshot as the root device for a new AMI $ami = $snap->register_image(-name => 'My new image', -kernel_id => 'aki-407d9529', -architecture => 'i386'); #create a volume from the snapshot $vol = $snap->create_volume(-zone => 'us-east-1a'); =head1 DESCRIPTION This object is used to describe an Amazon EBS snapshot. =head1 METHODS The following object methods are supported: snapshotId -- ID of this snapshot ownerId -- Owner of this snapshot volumeId -- ID of the volume snapshot was taken from status -- Snapshot state, one of "pending", "completed" or "error" startTime -- Timestamp for when snapshot was begun. progress -- The progress of the snapshot, in percent. volumeSize -- Size of the volume, in gigabytes. description -- Description of the snapshot ownerAlias -- AWS account alias, such as "self". tags -- Hashref containing tags associated with this group. See L. In addition, this class provides several convenience functions: =head2 $vol = $snap->from_volume Returns the VM::EC2::Volume object that this snapshot was originally derived from. If the original volume no longer exists because it has been deleted, this will return undef; if -raise_error was passed to the VM::EC2 object, this will raise an exception. =head2 @vol = $snap->to_volumes Returns all VM::EC2::Volume objects that were derived from this snapshot. If no volumes currently exist that satisfy this criteria, returns an empty list, but will not raise an error. =head2 $image = $snap->register_image(%args) Register a new AMI using this snapshot as the root device. By default, the root device will be mapped to /dev/sda1 and will delete on instance termination. You can modify this behavior and add additional block devices. Arguments: -name Name for this image (required) -description Description of this image -kernel_id Kernel for this image (recommended) -ramdisk_id Ramdisk for this image -architecture Architecture ("i386" or "x86_64") -root_device_name Specify the root device based on this snapshot (/dev/sda1). -root_size Size of the root volume (defaults to size of the snapshot). -root_delete_on_termination True value (default) to delete the root volume after the instance terminates. False value to keep the EBS volume available. -block_device_mapping Additional block devices you wish to incorporate into the image. -block_devices Same as above. See L for information on the syntax of the -block_device_mapping argument. If the root device is explicitly included in the block device mapping argument, then the arguments specified in -root_size, and -root_delete_on_termination will be ignored, and the current snapshot will not automatically be used as the root device. The return value is a L. You can call its current_status() method to poll its availability: $snap = $ec2->describe_snapshots('snap-123456'); $ami = $snap->register_image(-name => 'My new image', -kernel_id => 'aki-407d9529', -architecture => 'i386', -block_devices => '/dev/sdc=ephemeral0' ) or die $ec2->error_str; while ($ami->current_status eq 'pending') { print "$ami: ",$ami->current_status,"\n" sleep 30; # takes a long time to register some images } print "$ami is ready to go\n"; =head2 $volume = $snap->create_volume(%args) Create a new volume from this snapshot. Arguments are: -availability_zone -- An availability zone from describe_availability_zones (required) -size -- Size of the volume, in GB (between 1 and 1024). If -size is not provided, then the new volume will have the same size as the snapshot. Optional Arguments: -volume_type -- The volume type. standard or io1, default is standard -iops -- The number of I/O operations per second (IOPS) that the volume supports. Range is 100 to 2000. Required when volume type is io1. On success, the returned value is a L object. =head2 $status = $snap->current_status Refreshes the snapshot and returns its current status. =head2 $boolean = $snapshot->is_public Return true if the snapshot's createVolume permissions allow the "all" group to create volumes from the snapshot. =head2 $boolean = $snapshot->make_public($public) Modify the createVolumePermission attribute to allow the "all" group to create volumes from this snapshot. Provide a true value to make the snapshot public, a false one to make it private. =head2 @user_ids = $snap->createVolumePermissions() =head2 @user_ids = $snap->authorized_users Returns a list of user IDs with createVolume permissions for this snapshot. The result is a list of L objects, which interpolate as strings corresponding to either the user ID, or the group named "all." The two methods are aliases of each other. =head2 $boolean = $snap->add_authorized_users($id1,$id2,...) =head2 $boolean = $snap->remove_authorized_users($id1,$id2,...) =head2 $boolean = $snap->reset_authorized_users These methods add and remove user accounts which have createVolume permissions for the snapshot. The result code indicates whether the list of user IDs were successfully added or removed. To add the "all" group, use make_public(). reset_authorized_users() resets the list users authored to create volumes from this snapshot to empty, effectively granting volume creation to the owner only. See also authorized_users(). =head2 $size = $snap->size Alias to volumeSize, provided for consistency with VM::EC2::Volume->size. =head2 $snap->refresh Refreshes the snapshot from information provided by AWS. Use before checking progress or other changeable elements. =head2 $snapshot_copy = $snapshot->copy(-region=>$dest_region, -description=>$desc) Copies the snapshot to the same or different region. Required Argument: -region The region to copy the snapshot to Optional Argument: -description Description of the new snapshot Returns a VM::EC2::Snapshot object if successful. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the snapshotId. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::Snapshot::CreateVolumePermission; use VM::EC2::ProductCode; use Carp 'croak'; sub valid_fields { my $self = shift; return $self->SUPER::valid_fields, qw(snapshotId volumeId status startTime progress ownerId volumeSize description ownerAlias); } sub primary_id { shift->snapshotId } sub size { shift->volumeSize } sub from_volume { my $self = shift; my $vid = $self->volumeId or return; # may throw an error if volume no longer exists return $self->aws->describe_volumes(-volume_id=>$vid); } sub to_volumes { my $self = shift; return $self->aws->describe_volumes(-filter=>{'snapshot-id'=>$self->snapshotId}); } sub refresh { my $self = shift; local $self->aws->{raise_error} = 1; my $s = $self->aws->describe_snapshots($self); %$self = %$s; } sub register_image { my $self = shift; my %args = @_; $args{-name} or croak "register_image(): -name argument required"; $args{-root_device_name} ||= '/dev/sda1'; my $block_devices = $args{-block_devices} || $args{-block_device_mapping} || []; $block_devices = [$block_devices] unless ref $block_devices && ref $block_devices eq 'ARRAY'; # See if the root device is on the block device mapping list. # If it is not, then create a /dev/sda1 entry for it from this snapshot. my $rd = $args{-root_device_name}; unless (grep {/$rd=/} @$block_devices) { my $root_size = $args{-root_size} || ''; $args{-root_delete_on_termination} = 1 unless defined $args{-root_delete_on_termination}; my $root_delete = $args{-root_delete_on_termination} ? 'true' : 'false'; my $snap_id = $self->snapshotId; unshift @$block_devices,"$rd=$snap_id:$root_size:$root_delete" } $args{-block_device_mapping} = $block_devices; # just cleaning up, not really necessary delete $args{-root_size}; delete $args{-root_delete_on_termination}; return $self->aws->register_image(%args); } sub create_volume { my $self = shift; my @args = @_; return $self->ec2->create_volume(@args,-snapshot_id=>$self->snapshotId); } sub current_status { my $self = shift; $self->refresh; return $self->status; } sub createVolumePermissions { my $self = shift; return map {VM::EC2::Snapshot::CreateVolumePermission->new($_,$self->aws)} $self->aws->describe_snapshot_attribute($self->snapshotId,'createVolumePermission'); } sub is_public { my $self = shift; my @users = $self->createVolumePermissions; my $count = grep {$_->group eq 'all'} @users; return $count > 0; } sub make_public { my $self = shift; @_ == 1 or croak "Usage: VM::EC2::Snapshot->make_public(\$boolean)"; my $public = shift; my @arg = $public ? (-add_group=>'all') : (-remove_group=>'all'); my $result = $self->aws->modify_snapshot_attribute($self->snapshotId,@arg) or return; return $result } sub authorized_users { shift->createVolumePermissions } sub add_authorized_users { my $self = shift; @_ or croak "Usage: VM::EC2::Snapshot->add_authorized_users(\@userIds)"; return $self->aws->modify_snapshot_attribute($self->snapshotId,-add_user=>\@_); } sub remove_authorized_users { my $self = shift; @_ or croak "Usage: VM::EC2::Snapshot->remove_authorized_users(\@userIds)"; return $self->aws->modify_snapshot_attribute($self->snapshotId,-remove_user=>\@_); } sub reset_authorized_users { my $self = shift; $self->aws->reset_snapshot_attribute($self->snapshotId,'createVolumePermission'); } sub product_codes { my $self = shift; my @codes = $self->aws->describe_snapshot_attribute($self,'productCodes'); return map {VM::EC2::ProductCode->new($_,$self->aws)} @codes; } sub copy { my $self = shift; my %args = @_; my $snap_id = $self->snapshotId; my $desc = $args{-description} || $args{-desc}; my $region = $args{-region} or croak "copy(): -region argument required"; my $orig_region = $self->aws->region; # create a new EC2 object for the destination my $dest_aws = $self->aws->clone; $dest_aws->region($region); my $snapshot = $dest_aws->copy_snapshot(-source_region=>$orig_region, -source_snapshot_id=>$snap_id, -description=>$desc); return $snapshot; } 1; VM-EC2-1.23/lib/VM/EC2/Instance.pm000444001751001751 6704712100273360 16241 0ustar00lsteinlstein000000000000package VM::EC2::Instance; =head1 NAME VM::EC2::Instance - Object describing an Amazon EC2 instance =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $instance = $ec2->describe_instances(-instance_id=>'i-12345'); $instanceId = $instance->instanceId; $ownerId = $instance->ownerId; $reservationId = $instance->reservationId; $imageId = $instance->imageId; $state = $instance->instanceState; @groups = $instance->groups; $private_ip = $instance->privateIpAddress; $public_ip = $instance->ipAddress; $private_dns = $instance->privateDnsName; $public_dns = $instance->dnsName; $time = $instance->launchTime; $status = $instance->current_status; $tags = $instance->tags; $stateChange = $instance->start(); $stateChange = $instance->stop(); $stateChange = $instance->reboot(); $stateChange = $instance->terminate(); $seconds = $instance->up_time; =head1 DESCRIPTION This object represents an Amazon EC2 instance, and is returned by VM::EC2->describe_instances(). In addition to methods to query the instance's attributes, there are methods that allow you to manage the instance's lifecycle, including start, stopping, and terminating it. Note that the information about security groups and reservations that is returned by describe_instances() is copied into each instance before returning it, so there is no concept of a "reservation set" in this interface. =head1 METHODS These object methods are supported: instanceId -- ID of this instance. imageId -- ID of the image used to launch this instance. instanceState -- The current state of the instance at the time that describe_instances() was called, as a VM::EC2::Instance::State object. Also see the status() method, which re-queries EC2 for the current state of the instance. States are represented in strings as "terminated", "running", "stopped", "stopping",and "shutting-down". privateDnsName -- The private DNS name assigned to the instance within Amazon's EC2 network. This element is defined only for running instances. dnsName -- The public DNS name assigned to the instance, defined only for running instances. reason -- Reason for the most recent state transition, if applicable. keyName -- Name of the associated key pair, if applicable. keyPair -- The VM::EC2::KeyPair object, derived from the keyName amiLaunchIndex -- The AMI launch index, which can be used to find this instance within the launch group. productCodes -- A list of product codes that apply to this instance. instanceType -- The instance type, such as "t1.micro". CHANGEABLE. launchTime -- The time the instance launched. placement -- The placement of the instance. Returns a VM::EC2::Instance::Placement object, which when used as a string is equal to the instance's availability zone. availabilityZone -- Same as placement. kernelId -- ID of the instance's kernel. CHANGEABLE. ramdiskId -- ID of the instance's RAM disk. CHANGEABLE. platform -- Platform of the instance, either "windows" or empty. monitoring -- State of monitoring for the instance. One of "disabled", "enabled", or "pending". CHANGEABLE: pass true or "enabled" to turn on monitoring. Pass false or "disabled" to turn it off. subnetId -- The Amazon VPC subnet ID in which the instance is running, for Virtual Private Cloud instances only. vpcId -- The Virtual Private Cloud ID for VPC instances. privateIpAddress -- The private (internal Amazon) IP address assigned to the instance. ipAddress -- The public IP address of the instance. sourceDestCheck -- Whether source destination checking is enabled on this instance. This returns a Perl boolean rather than the string "true". This method is used in conjunction with VPC NAT functionality. See the Amazon VPC User Guide for details. CHANGEABLE. networkInterfaceSet -- Return list of VM::EC2::ElasticNetworkInterface objects attached to this instance. iamInstanceProfile -- The IAM instance profile (IIP) associated with this instance. ebsOptimized -- True if instance is optimized for EBS I/O. groupSet -- List of VM::EC2::Group objects indicating the VPC security groups in which this instance resides. Not to be confused with groups(), which returns the security groups of non-VPC instances. stateReason -- A VM::EC2::Instance::State::Reason object which indicates the reason for the instance's most recent state change. See http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-ItemType-StateReasonType.html architecture -- The architecture of the image. Either "i386" or "x86_64". rootDeviceType -- The type of the root device used by the instance. One of "ebs" or "instance-store". rootDeviceName -- The name of the the device used by the instance, such as /dev/sda1. CHANGEABLE. blockDeviceMapping -- The block device mappings for the instance, represented as a list of L objects. instanceLifeCycle -- "spot" if this instance is a spot instance, otherwise empty. spotInstanceRequestId -- The ID of the spot instance request, if applicable. virtualizationType -- Either "paravirtual" or "hvm". clientToken -- The idempotency token provided at the time of the AMI launch, if any. hypervisor -- The instance's hypervisor type, either "ovm" or "xen". userData -- User data passed to instance at launch. CHANGEABLE. disableApiTermination -- True if the instance is protected from termination via the console or command-line APIs. CHANGEABLE. instanceInitiatedShutdownBehavior -- Action to take when the instance calls shutdown or halt. One of "stop" or "terminate". CHANGEABLE. tagSet -- Tags for the instance as a hashref. CHANGEABLE via add_tags() and delete_tags(). The object also supports the tags() method described in L: print "ready for production\n" if $image->tags->{Released}; All methods return read-only values except for those marked CHANGEABLE in the list above. For these, you can change the instance attribute on stopped instances by invoking the method with an appropriate new value. For example, to change the instance type from "t1.micro" to "m1.small", you can do this: my @tiny_instances = $ec2->describe_instances(-filter=>{'instance-type'=>'t1.micro'}); for my $i (@tiny_instances) { next unless $i->instanceState eq 'stopped'; $i->instanceType('m1.small') or die $ec2->error; } When you attempt to change an attribute of an instance, the method will return true on success, false on failure. On failure, the detailed error messages can be recovered from the VM::EC2 object's error() method. =head1 LIFECYCLE METHODS In addition, the following convenience functions are provided =head2 $state = $instance->current_status This method queries AWS for the instance's current state and returns it as a VM::EC2::Instance::State object. This enables you to poll the instance until it is in the desired state: while ($instance->current_status eq 'pending') { sleep 5 } =head2 $state = $instance->current_state An alias for current_status(). =head2 $state_change = $instance->start([$wait]) This method will start the current instance and returns a VM::EC2::Instance::State::Change object that can be used to monitor the status of the instance. By default the method returns immediately, but you can pass a true value as an argument in order to pause execution until the instance is in the "running" state. Here's a polling example: $state = $instance->start; while ($state->status eq 'pending') { sleep 5 } Here's an example that will pause until the instance is running: $instance->start(1); Attempting to start an already running instance, or one that is in transition, will throw a fatal error. =head2 $state_change = $instance->stop([$wait]) This method is similar to start(), except that it can be used to stop a running instance. =head2 $state_change = $instance->terminate([$wait]) This method is similar to start(), except that it can be used to terminate an instance. It can only be called on instances that are either "running" or "stopped". =head2 $state_change = $instance->reboot() Reboot the instance. Rebooting doesn't occur immediately; instead the request is queued by the Amazon system and may be satisfied several minutes later. For this reason, there is no "wait" argument. =head2 $seconds = $instance->up_time() Return the number of seconds since the instance was launched. Note that this includes time that the instance was either in the "running" or "stopped" state. =head2 $result = $instance->associate_address($elastic_address) Associate an elastic address with this instance. If you are associating a VPC elastic IP address with the instance, the result code will indicate the associationId. Otherwise it will be a simple perl truth value ("1") if successful, undef if false. In the case of an ordinary EC2 Elastic IP address, the first argument may either be an ordinary string (xx.xx.xx.xx format) or a VM::EC2::ElasticAddress object. However, if it is a VPC elastic IP address, then the argument must be a VM::EC2::ElasticAddress as returned by describe_addresses(). The reason for this is that the allocationId must be retrieved from the object in order to use in the call. =head2 $bool = $instance->disassociate_address Disassociate an elastic IP address from this instance. if any. The result will be true if disassociation was successful. Note that for a short period of time (up to a few minutes) after disassociation, the instance will have no public IP address and will be unreachable from the internet. =head2 @list = $instance->network_interfaces Return the network interfaces attached to this instance as a set of VM::EC2::NetworkInterface objects (VPC only). =head2 $instance->refresh This method will refresh the object from AWS, updating all values to their current ones. You can call it after starting an instance in order to get its IP address. Note that refresh() is called automatically for you if you call start(), stop() or terminate() with a true $wait argument. =head2 $text = $instance->console_output Return the console output of the instance as a VM::EC2::ConsoleOutput object. This object can be treated as a string, or as an object with methods =head1 CREATING IMAGES The create_image() method provides a handy way of creating and registering an AMI based on the current state of the instance. All currently-associated block devices will be snapshotted and associated with the image. Note that this operation can take a long time to complete. You may follow its progress by calling the returned image object's current_status() method. =head2 $imageId = $instance->create_image($name [,$description]) =head2 $imageId = $instance->create_image(-name=>$name,-description=>$description,-no_reboot=>$boolean) Create an image from this instance and return a VM::EC2::Image object. The instance must be in the "stopped" or "running" state. In the latter case, Amazon will stop the instance, create the image, and then restart it unless the -no_reboot argument is provided. Arguments: -name Name for the image that will be created. (required) -description Description of the new image. -no_reboot If true, don't reboot the instance. In the unnamed argument version you can provide the name and optionally the description of the resulting image. =head2 $boolean = $instance->confirm_product_code($product_code) Return true if this instance is associated with the given product code. =head1 VOLUME MANAGEMENT =head2 $attachment = $instance->attach_volume($volume_id,$device) =head2 $attachment = $instance->attach_volume(-volume_id=>$volume_id,-device=>$device) Attach volume $volume_id to this instance using virtual device $device. Both arguments are required. The result is a VM::EC2::BlockDevice::Attachment object which you can monitor by calling current_status(): my $a = $instance->attach_volume('vol-12345'=>'/dev/sdg'); while ($a->current_status ne 'attached') { sleep 2; } print "volume is ready to go\n"; =head2 $attachment = $instance->detach_volume($vol_or_device) =head2 $attachment = $instance->detach_volume(-volume_id => $volume_id -device => $device, -force => $force); Detaches the specified volume. In the single-argument form, you may provide either a volume or a device name. In the named-argument form, you may provide both the volume and the device as a check that you are detaching exactly the volume you think you are. Optional arguments: -volume_id -- ID of the instance to detach from. -device -- How the device is exposed to the instance. -force -- Force detachment, even if previous attempts were unsuccessful. The result is a VM::EC2::BlockDevice::Attachment object which you can monitor by calling current_status(): my $a = $instance->detach_volume('/dev/sdg'); while ($a->current_status ne 'detached') { sleep 2; } print "volume is ready to go\n"; =head1 NETWORK INTERFACE MANAGEMENT =head2 $attachment_id = $instance->attach_network_interface($interface_id => $device) =head2 $attachment_id = $instance->attach_network_interface(-network_interface_id=>$id, -device_index => $device) This method attaches a network interface to the current instance using the indicated device index. You can use either an elastic network interface ID, or a VM::EC2::NetworkInterface object. You may use an integer for -device_index, or use the strings "eth0", "eth1" etc. Required arguments: -network_interface_id ID of the network interface to attach. -device_index Network device number to use (e.g. 0 for eth0). On success, this method returns the attachmentId of the new attachment (not a VM::EC2::NetworkInterface::Attachment object, due to an AWS API inconsistency). =head2 $boolean = $instance->detach_network_interface($interface_id [,$force]) This method detaches a network interface from the current instance. If a true second argument is provided, then the detachment will be forced, even if the interface is in use. On success, this method returns a true value. =head1 ACCESSING INSTANCE METADATA =head2 $meta = $instance->metadata B This method returns a VM::EC2::Instance::Metadata object that will return information about the currently running instance using the HTTP:// metadata fields described at http://docs.amazonwebservices.com/AWSEC2/latest/UserGuide/index.html?instancedata-data-categories.html. This is usually fastest way to get runtime information on the current instance. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the instanceId. =head1 SEE ALSO L L L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::Group; use VM::EC2::Instance::State; use VM::EC2::Instance::State::Reason; use VM::EC2::BlockDevice::Mapping; use VM::EC2::NetworkInterface; use VM::EC2::Instance::Placement; use VM::EC2::ProductCode; use VM::EC2::Instance::IamProfile; use MIME::Base64 qw(encode_base64 decode_base64); use Carp 'croak'; sub new { my $self = shift; my %args = @_; return bless { data => $args{-instance}, reservation => $args{-reservation}, requester => $args{-requester}, owner => $args{-owner}, groups => $args{-groups}, aws => $args{-aws}, xmlns => $args{-xmlns}, requestId => $args{-requestId}, },ref $self || $self; } sub reservationId {shift->{reservation} } sub requesterId {shift->{requester} } sub ownerId {shift->{owner} } sub groups { my $self = shift; my $groups = $self->{groups}; if (@_) { return $self->aws->modify_instance_attribute($self,-group_id=>\@_); } else { return @$groups; } } sub group {shift()->{groups}[0] } sub primary_id {shift()->instanceId } sub valid_fields { my $self = shift; return qw(instanceId imageId instanceState privateDnsName dnsName reason keyName amiLaunchIndex productCodes instanceType launchTime placement kernelId ramdiskId platform monitoring subnetId vpcId privateIpAddress ipAddress sourceDestCheck networkInterfaceSet iamInstanceProfile ebsOptimized groupSet stateReason architecture rootDeviceType rootDeviceName blockDeviceMapping instanceLifeCycle spotInstanceRequestId virtualizationType clientToken hypervisor tagSet ); } sub keyPair { my $self = shift; my $name = $self->keyName or return; return $self->aws->describe_key_pairs($name); } sub instanceState { my $self = shift; my $state = $self->SUPER::instanceState; return VM::EC2::Instance::State->new($state); } sub sourceDestCheck { my $self = shift; my $check = $self->SUPER::sourceDestCheck; if (@_) { my $c = shift() ? 'true' : 'false'; return $self->aws->modify_instance_attribute($self,-source_dest_check=>$c); } return $check eq 'true'; } sub ebsOptimized { my $self = shift; my $opt = $self->SUPER::ebsOptimized; return $opt eq 'true'; } sub groupSet { my $self = shift; my $groupSet = $self->SUPER::groupSet; return map {VM::EC2::Group->new($_,$self->aws,$self->xmlns,$self->requestId)} @{$groupSet->{item}}; } sub placement { my $self = shift; my $p = $self->SUPER::placement or return; return VM::EC2::Instance::Placement->new($p,$self->aws,$self->xmlns,$self->requestId); } sub availabilityZone { shift->placement } sub monitoring { my $self = shift; if (@_) { my $enable = shift; if ($enable && $enable ne 'disabled') { return $self->aws->monitor_instances($self); } else { return $self->aws->unmonitor_instances($self); } } return $self->SUPER::monitoring->{state}; } sub blockDeviceMapping { my $self = shift; $self->refresh; my $mapping = $self->SUPER::blockDeviceMapping or return; my @mapping = map { VM::EC2::BlockDevice::Mapping->new($_,$self->aws)} @{$mapping->{item}}; foreach (@mapping) { $_->instance($self) } return @mapping; } sub blockDeviceMappings {shift->blockDeviceMapping} sub stateReason { my $self = shift; my $reason = $self->SUPER::stateReason; return VM::EC2::Instance::State::Reason->new($reason,$self->_object_args); } sub kernelId { my $self = shift; my $kernel = $self->SUPER::kernelId; if (@_) { return $self->aws->modify_instance_attribute($self,-kernel=>shift()); } else { return $kernel; } } sub ramdiskId { my $self = shift; my $ramdisk = $self->SUPER::ramdiskId; if (@_) { return $self->aws->modify_instance_attribute($self,-ramdisk=>shift()); } else { return $ramdisk; } } sub rootDeviceName { my $self = shift; my $root = $self->SUPER::rootDeviceName; if (@_) { return $self->aws->modify_instance_attribute($self,-root_device_name => shift()); } else { return $root; } } sub instanceType { my $self = shift; return $self->aws->modify_instance_attribute($self, -instance_type=>shift()) if @_; return $self->SUPER::instanceType; } sub userData { my $self = shift; if (@_) { my $encoded = encode_base64(shift); return $self->aws->modify_instance_attribute($self,-user_data=>$encoded); } my $data = $self->aws->describe_instance_attribute($self,'userData') or return; VM::EC2::Dispatch::load_module('MIME::Base64'); return decode_base64($data); } sub disableApiTermination { my $self = shift; return $self->aws->modify_instance_attribute($self, -disable_api_termination=>shift()) if @_; return $self->aws->describe_instance_attribute($self,'disableApiTermination') eq 'true'; } sub instanceInitiatedShutdownBehavior { my $self = shift; return $self->aws->modify_instance_attribute($self, -shutdown_behavior=>shift()) if @_; return $self->aws->describe_instance_attribute($self,'instanceInitiatedShutdownBehavior'); } sub networkInterfaceSet { my $self = shift; my $set = $self->SUPER::networkInterfaceSet or return; return map {VM::EC2::NetworkInterface->new($_,$self->aws)} @{$set->{item}}; } sub network_interfaces { shift->networkInterfaceSet } sub iamInstanceProfile { my $self = shift; my $profile = $self->SUPER::iamInstanceProfile or return; return VM::EC2::Instance::IamProfile->new($profile,$self->aws); } sub current_status { my $self = shift; my ($i) = $self->aws->describe_instances(-instance_id=>$self->instanceId); $i or croak "invalid instance: ",$self->instanceId; $self->refresh($i) or return VM::EC2::Instance::State->invalid_state($self->aws); return $i->instanceState; } sub current_state { shift->current_status } # alias sub status { shift->current_status } # legacy sub start { my $self = shift; my $wait = shift; my $s = $self->current_status; croak "Can't start $self: run state=$s" unless $s eq 'stopped'; my ($i) = $self->aws->start_instances($self) or return; if ($wait) { while ($i->current_status eq 'pending') { sleep 5; } $self->refresh; } return $i; } sub stop { my $self = shift; my $wait = shift; my $s = $self->current_status; croak "Can't stop $self: run state=$s" unless $s eq 'running'; my ($i) = $self->aws->stop_instances($self); if ($wait) { while ($i->current_status ne 'stopped') { sleep 5; } $self->refresh; } return $i; } sub terminate { my $self = shift; my $wait = shift; my $s = $self->current_status; croak "Can't terminate $self: run state=$s" unless $s eq 'running' or $s eq 'stopped'; my $i = $self->aws->terminate_instances($self) or return; if ($wait) { while ($i->current_status ne 'terminated') { sleep 5; } $self->refresh; } return $i; } sub reboot { my $self = shift; my $s = $self->current_status; croak "Can't reboot $self: run state=$s"unless $s eq 'running'; return $self->aws->reboot_instances($self); } sub upTime { my $self = shift; my $start = $self->launchTime; VM::EC2::Dispatch::load_module('Date::Parse'); my $sec = Date::Parse::str2time($start); return time()-$sec; } sub up_time { shift->upTime } sub associate_address { my $self = shift; my $addr = shift or croak "Usage: \$instance->associate_address(\$elastic_address)"; my $r = $self->aws->associate_address($addr => $self->instanceId); return $r; } sub disassociate_address { my $self = shift; my $addr = $self->aws->describe_addresses(-filter=>{'instance-id'=>$self->instanceId}); $addr or croak "Instance $self is not currently associated with an elastic IP address"; my $r = $self->aws->disassociate_address($addr); return $r; } sub refresh { my $self = shift; my $i = shift; local $self->aws->{raise_error} = 1; ($i) = $self->aws->describe_instances(-instance_id=>$self->instanceId) unless $i; %$self = %$i; } sub console_output { my $self = shift; my $output = $self->aws->get_console_output(-instance_id=>$self->instanceId); return $output->output; } sub create_image { my $self = shift; my %args; if ($_[0] !~ /^-/) { my ($name,$description) = @_; $args{-name} = $name; $args{-description} = $description if defined $description; } else { %args = @_; } $args{-name} or croak "Usage: create_image(\$image_name)"; return $self->aws->create_image(%args,-instance_id=>$self->instanceId); } sub attach_volume { my $self = shift; my %args; if (@_==2 && $_[0] !~ /^-/) { my ($volume,$device) = @_; $args{-volume_id} = $volume; $args{-device} = $device; } else { %args = @_; } $args{-volume_id} && $args{-device} or croak "usage: \$vol->attach(\$instance_id,\$device)"; $args{-instance_id} = $self->instanceId; my $result = $self->aws->attach_volume(%args); $self->refresh if $result; return $result; } sub detach_volume { my $self = shift; my %args; if (@_ == 1 && $_[0] !~ /^-/) { my $vol_or_device = shift; $self->refresh; my @mappings = $self->blockDeviceMapping; my ($mapping) = grep {$_->deviceName eq $vol_or_device} @mappings; if ($mapping) { $args{-volume_id} = $mapping->volumeId; $args{-device} = $mapping->deviceName; } else { $args{-volume_id} = $vol_or_device; } } else { %args = @_; } $args{-instance_id} = $self->instanceId; my $result = $self->aws->detach_volume(%args); $self->refresh if $result; return $result; } sub attach_network_interface { my $self = shift; my %args; if (@_==2 && $_[0] !~ /^-/) { @args{qw(-network_interface_id -device_index)} = @_; } else { %args = @_; } $args{-network_interface_id} && $args{-device_index} or croak "usage: \$instance->attach_network_interface(\$network_interface_id,\$device_index)"; $args{-instance_id} = $self->instanceId; my $result = $self->aws->attach_network_interface(%args); $self->refresh if $result; eval {$args{-network_interface_id}->refresh} if $result; return $result; } sub detach_network_interface { my $self = shift; my ($nid,$force) = @_; $nid or croak "usage: \$instance=>detach_network_interface(\$network_interface_id [,\$force])"; my ($attachment) = map {$_->attachment} grep { $_->networkInterfaceId eq $nid } $self->network_interfaces; $attachment or croak "$self is not attached to $nid"; my $result = $self->aws->detach_network_interface($attachment,$force); $self->refresh if $result; eval {$nid->refresh} if $result; return $result; } sub metadata { my $self = shift; return $self->aws->instance_metadata; } sub productCodes { my $self = shift; my $codes = $self->SUPER::productCodes or return; return map {VM::EC2::ProductCode->new($_)} @{$codes->{item}}; } sub confirm_product_code { my $self = shift; my $code = shift; return $self->aws->confirm_product_instance($self,$code); } 1; VM-EC2-1.23/lib/VM/EC2/Dispatch.pm000444001751001751 6534412100273360 16232 0ustar00lsteinlstein000000000000package VM::EC2::Dispatch; use strict; use XML::Simple; use URI::Escape; =head1 NAME VM::EC2::Dispatch - Create Perl objects from AWS XML requests =head1 SYNOPSIS use VM::EC2; VM::EC2::Dispatch->add_override('DescribeRegions'=>\&mysub); VM::EC2::Dispatch->add_override('DescribeTags'=>'My::Type'); sub mysub { my ($parsed_xml_object,$ec2) = @_; my $payload = $parsed_xml_object->{regionInfo} return My::Type->new($payload,$ec2); } =head1 DESCRIPTION This class handles turning the XML response to AWS requests into perl objects. Only one method is likely to be useful to developers, the add_override() class method. This allows you to replace the handlers used to map the response onto objects. =head2 VM::EC2::Dispatch->add_override($request_name => \&sub) =head2 VM::EC2::Dispatch->add_override($request_name => 'Class::Name') =head2 VM::EC2::Dispatch->add_override($request_name => 'method_name,arg1,arg2,...') Before invoking a VM::EC2 request you wish to customize, call the add_override() method with two arguments. The first argument is the name of the request you wish to customize, such as "DescribeVolumes". The second argument is either a code reference, a VM::EC2::Dispatch method name and arguments (separated by commas), or a class name. In the case of a code reference as the second argument, the subroutine you provide will be invoked with four arguments consisting of the parsed XML response, the VM::EC2 object, the XML namespace string from the request, and the Amazon-assigned request ID. In practice, only the first two arguments are useful. In the case of a string containing a classname, the class will be loaded if it needs to be, and then its new() method invoked as follows: Your::Class->new($parsed_xml,$ec2,$xmlns,$requestid) Your new() method should return one or more objects. It is suggested that you subclass VM::EC2::Generic and use the inherited new() method to store the parsed XML and EC2 object. See the code for L for a simple template. If the second argument is neither a code reference nor a classname, it will be treated as a VM::EC2::Dispatch method name and its arguments, separated by commas. The method will be invoked as follows: $dispatch->$method_name($raw_xml,$ec2,$arg1,$arg2,$arg3,...) There are two methods currently defined for this purpose, boolean(), and fetch_items(), which handle the preprocessing of several common XML representations of EC2 data. Note that in this form, the RAW XML is passed in, not the parsed data structure. The parsed XML response is generated by the XML::Simple module using these options: $parser = XML::Simple->new(ForceArray => ['item', 'member'], KeyAttr => ['key'], SuppressEmpty => undef); $parsed = $parser->XMLin($raw_xml) In general, this will give you a hash of hashes. Any tag named 'item' or 'member' will be forced to point to an array reference, and any tag named "key" will be flattened as described in the XML::Simple documentation. A simple way to examine the raw parsed XML is to invoke any VM::EC2::Object's as_string method: my ($i) = $ec2->describe_instances; print $i->as_string; This will give you a Data::Dumper representation of the XML after it has been parsed. Look at the data structure "ObjectRegistration" in the source code for this module to see many examples of response to object mapping. =head1 OBJECT CREATION METHODS The following methods perform simple pre-processing of the parsed XML (a hash of hashes) before passing the modified data structure to the designated object class. They are used as the second argument to add_override() =cut my %OVERRIDE; use constant ObjectRegistration => { Error => 'VM::EC2::Error', DescribeInstances => sub { load_module('VM::EC2::ReservationSet'); my $r = VM::EC2::ReservationSet->new(@_) or return; return $r->instances; }, RunInstances => sub { load_module('VM::EC2::Instance::Set'); my $s = VM::EC2::Instance::Set->new(@_) or return; return $s->instances; }, EnableVolumeIO => 'boolean', DescribeSnapshots => 'fetch_items,snapshotSet,VM::EC2::Snapshot', DescribeVolumes => 'fetch_items,volumeSet,VM::EC2::Volume', DescribeImages => 'fetch_items,imagesSet,VM::EC2::Image', DescribeRegions => 'fetch_items,regionInfo,VM::EC2::Region', DescribeInstanceStatus => 'fetch_items_iterator,instanceStatusSet,VM::EC2::Instance::StatusItem,instance_status', DescribeAvailabilityZones => 'fetch_items,availabilityZoneInfo,VM::EC2::AvailabilityZone', DescribeSecurityGroups => 'fetch_items,securityGroupInfo,VM::EC2::SecurityGroup', DescribeVolumeStatus => 'fetch_items_iterator,volumeStatusSet,VM::EC2::Volume::StatusItem,volume_status', CreateSecurityGroup => 'VM::EC2::SecurityGroup', DeleteSecurityGroup => 'boolean', AuthorizeSecurityGroupIngress => 'boolean', AuthorizeSecurityGroupEgress => 'boolean', RevokeSecurityGroupIngress => 'boolean', RevokeSecurityGroupEgress => 'boolean', DescribeTags => 'fetch_items,tagSet,VM::EC2::Tag,nokey', CreateVolume => 'VM::EC2::Volume', DeleteVolume => 'boolean', AttachVolume => 'VM::EC2::BlockDevice::Attachment', DetachVolume => 'VM::EC2::BlockDevice::Attachment', CreateSnapshot => 'VM::EC2::Snapshot', DeleteSnapshot => 'boolean', CopySnapshot => sub { shift->{snapshotId} }, ModifySnapshotAttribute => 'boolean', ResetSnapshotAttribute => 'boolean', ModifyInstanceAttribute => 'boolean', ModifyImageAttribute => 'boolean', ResetInstanceAttribute => 'boolean', ResetImageAttribute => 'boolean', CreateImage => sub { my ($data,$aws) = @_; my $image_id = $data->{imageId} or return; sleep 2; # wait for the thing to register return $aws->describe_images($image_id); }, RegisterImage => sub { my ($data,$aws) = @_; my $image_id = $data->{imageId} or return; sleep 2; # wait for the thing to register return $aws->describe_images($image_id); }, DeregisterImage => 'boolean', DescribeAddresses => 'fetch_items,addressesSet,VM::EC2::ElasticAddress', AssociateAddress => sub { my $data = shift; return $data->{associationId} || ($data->{return} eq 'true'); }, DisassociateAddress => 'boolean', AllocateAddress => 'VM::EC2::ElasticAddress', ReleaseAddress => 'boolean', CreateTags => 'boolean', DeleteTags => 'boolean', StartInstances => 'fetch_items,instancesSet,VM::EC2::Instance::State::Change', StopInstances => 'fetch_items,instancesSet,VM::EC2::Instance::State::Change', TerminateInstances => 'fetch_items,instancesSet,VM::EC2::Instance::State::Change', RebootInstances => 'boolean', ConfirmProductInstance => 'boolean', MonitorInstances => 'fetch_items,instancesSet,VM::EC2::Instance::MonitoringState', UnmonitorInstances => 'fetch_items,instancesSet,VM::EC2::Instance::MonitoringState', GetConsoleOutput => 'VM::EC2::Instance::ConsoleOutput', GetPasswordData => 'VM::EC2::Instance::PasswordData', DescribeKeyPairs => 'fetch_items,keySet,VM::EC2::KeyPair', CreateKeyPair => 'VM::EC2::KeyPair', ImportKeyPair => 'VM::EC2::KeyPair', DeleteKeyPair => 'boolean', DescribeReservedInstancesOfferings => 'fetch_items,reservedInstancesOfferingsSet,VM::EC2::ReservedInstance::Offering', DescribeReservedInstances => 'fetch_items,reservedInstancesSet,VM::EC2::ReservedInstance', PurchaseReservedInstancesOffering => sub { my ($data,$ec2) = @_; my $ri_id = $data->{reservedInstancesId} or return; return $ec2->describe_reserved_instances($ri_id); }, CreateSpotDatafeedSubscription => 'fetch_one,spotDatafeedSubscription,VM::EC2::Spot::DatafeedSubscription', DescribeSpotDatafeedSubscription => 'fetch_one,spotDatafeedSubscription,VM::EC2::Spot::DatafeedSubscription', DeleteSpotDatafeedSubscription => 'boolean', DescribeSpotPriceHistory => 'fetch_items_iterator,spotPriceHistorySet,VM::EC2::Spot::PriceHistory,spot_price_history', RequestSpotInstances => 'fetch_items,spotInstanceRequestSet,VM::EC2::Spot::InstanceRequest', CancelSpotInstanceRequests => 'fetch_items,spotInstanceRequestSet,VM::EC2::Spot::InstanceRequest', DescribeSpotInstanceRequests => 'fetch_items,spotInstanceRequestSet,VM::EC2::Spot::InstanceRequest', GetFederationToken => 'fetch_one,GetFederationTokenResult,VM::EC2::Security::Token', GetSessionToken => 'fetch_one,GetSessionTokenResult,VM::EC2::Security::Token', # placement groups DescribePlacementGroups => 'fetch_items,placementGroupSet,VM::EC2::PlacementGroup', CreatePlacementGroup => 'boolean', DeletePlacementGroup => 'boolean', # vpcs CreateVpc => 'fetch_one,vpc,VM::EC2::VPC', DescribeVpcs => 'fetch_items,vpcSet,VM::EC2::VPC', DeleteVpc => 'boolean', # dhcp options DescribeDhcpOptions => 'fetch_items,dhcpOptionsSet,VM::EC2::VPC::DhcpOptions,nokey', CreateDhcpOptions => 'fetch_one,dhcpOptions,VM::EC2::VPC::DhcpOptions,nokey', DeleteDhcpOptions => 'boolean', AssociateDhcpOptions => 'boolean', # network interfaces CreateNetworkInterface => 'fetch_one,networkInterface,VM::EC2::NetworkInterface', DeleteNetworkInterface => 'boolean', DescribeNetworkInterfaces => 'fetch_items,networkInterfaceSet,VM::EC2::NetworkInterface', ModifyNetworkInterfaceAttribute => 'boolean', ResetNetworkInterfaceAttribute => 'boolean', AttachNetworkInterface => sub { shift->{attachmentId} }, DetachNetworkInterface => 'boolean', AssignPrivateIpAddresses => 'boolean', UnassignPrivateIpAddresses => 'boolean', # subnets CreateSubnet => 'fetch_one,subnet,VM::EC2::VPC::Subnet', DeleteSubnet => 'boolean', DescribeSubnets => 'fetch_items,subnetSet,VM::EC2::VPC::Subnet', # internet gateways DescribeInternetGateways => 'fetch_items,internetGatewaySet,VM::EC2::VPC::InternetGateway', # route tables CreateRouteTable => 'fetch_one,routeTable,VM::EC2::VPC::RouteTable', DeleteRouteTable => 'boolean', DescribeRouteTables => 'fetch_items,routeTableSet,VM::EC2::VPC::RouteTable', AssociateRouteTable => sub { shift->{associationId} }, ReplaceRouteTableAssociation => sub { shift->{newAssociationId} }, # route rules CreateRoute => 'boolean', DeleteRoute => 'boolean', ReplaceRoute => 'boolean', # internet gateways CreateInternetGateway => 'fetch_one,internetGateway,VM::EC2::VPC::InternetGateway', DescribeInternetGateways => 'fetch_items,internetGatewaySet,VM::EC2::VPC::InternetGateway', DeleteInternetGateway => 'boolean', AttachInternetGateway => 'boolean', DetachInternetGateway => 'boolean', # network acls DescribeNetworkAcls => 'fetch_items,networkAclSet,VM::EC2::VPC::NetworkAcl', CreateNetworkAcl => 'fetch_one,networkAcl,VM::EC2::VPC::NetworkAcl', DeleteNetworkAcl => 'boolean', CreateNetworkAclEntry => 'boolean', DeleteNetworkAclEntry => 'boolean', ReplaceNetworkAclAssociation => sub { shift->{newAssociationId} }, ReplaceNetworkAclEntry => 'boolean', # virtual private networks DescribeVpnGateways => 'fetch_items,vpnGatewaySet,VM::EC2::VPC::VpnGateway', CreateVpnGateway => 'fetch_one,vpnGateway,VM::EC2::VPC::VpnGateway', DeleteVpnGateway => 'boolean', AttachVpnGateway => sub { shift->{attachment}{state} }, DetachVpnGateway => 'boolean', DescribeVpnConnections => 'fetch_items,vpnConnectionSet,VM::EC2::VPC::VpnConnection', CreateVpnConnection => 'fetch_one,vpnConnection,VM::EC2::VPC::VpnConnection', DeleteVpnConnection => 'boolean', DescribeCustomerGateways => 'fetch_items,customerGatewaySet,VM::EC2::VPC::CustomerGateway', CreateCustomerGateway => 'fetch_one,customerGateway,VM::EC2::VPC::CustomerGateway', DeleteCustomerGateway => 'boolean', CreateVpnConnectionRoute => 'boolean', DeleteVpnConnectionRoute => 'boolean', DisableVgwRoutePropagation => 'boolean', EnableVgwRoutePropagation => 'boolean', # elastic load balancers DescribeLoadBalancers => 'fetch_members,LoadBalancerDescriptions,VM::EC2::ELB', ConfigureHealthCheck => 'elb_fetch_one,HealthCheck,VM::EC2::ELB::HealthCheck', CreateAppCookieStickinessPolicy => sub { exists shift->{CreateAppCookieStickinessPolicyResult} }, CreateLBCookieStickinessPolicy => sub { exists shift->{CreateLBCookieStickinessPolicyResult} }, CreateLoadBalancer => sub { shift->{CreateLoadBalancerResult}{DNSName} }, DeleteLoadBalancer => sub { exists shift->{DeleteLoadBalancerResult} }, CreateLoadBalancerListeners => sub { exists shift->{CreateLoadBalancerListenersResult} }, DeleteLoadBalancerListeners => sub { exists shift->{DeleteLoadBalancerListenersResult} }, DisableAvailabilityZonesForLoadBalancer => 'elb_member_list,AvailabilityZones', EnableAvailabilityZonesForLoadBalancer => 'elb_member_list,AvailabilityZones', RegisterInstancesWithLoadBalancer => 'elb_member_list,Instances,InstanceId', DeregisterInstancesFromLoadBalancer => 'elb_member_list,Instances,InstanceId', SetLoadBalancerListenerSSLCertificate => sub { exists shift->{SetLoadBalancerListenerSSLCertificateResult} }, DescribeInstanceHealth => 'fetch_members,InstanceStates,VM::EC2::ELB::InstanceState', CreateLoadBalancerPolicy => sub { exists shift->{CreateLoadBalancerPolicyResult} }, DeleteLoadBalancerPolicy => sub { exists shift->{DeleteLoadBalancerPolicyResult} }, DescribeLoadBalancerPolicies => 'fetch_members,PolicyDescriptions,VM::EC2::ELB::PolicyDescription', DescribeLoadBalancerPolicyTypes => 'fetch_members,PolicyTypeDescriptions,VM::EC2::ELB::PolicyTypeDescription', SetLoadBalancerPoliciesOfListener => sub { exists shift->{SetLoadBalancerPoliciesOfListenerResult} }, ApplySecurityGroupsToLoadBalancer => 'elb_member_list,SecurityGroups', AttachLoadBalancerToSubnets => 'elb_member_list,Subnets', DetachLoadBalancerFromSubnets => 'elb_member_list,Subnets', SetLoadBalancerPoliciesForBackendServer => sub { exists shift->{SetLoadBalancerPoliciesForBackendServerResult} }, # auto scaling and launch controls DescribeLaunchConfigurations => 'fetch_members,LaunchConfigurations,VM::EC2::LaunchConfiguration', DescribeAutoScalingGroups => 'fetch_members,AutoScalingGroups,VM::EC2::ASG', }; sub new { my $self = shift; return bless {},ref $self || $self; } sub add_override { my $self = shift; my ($request_name,$object_creator) = @_; $OVERRIDE{$request_name} = $object_creator; } sub response2objects { my $self = shift; my ($response,$ec2) = @_; my $handler = $self->class_from_response($response) or return; my $content = $response->decoded_content; my ($method,@params) = split /,/,$handler; if (ref $handler eq 'CODE') { my $parsed = $self->new_xml_parser->XMLin($content); $handler->($parsed,$ec2,@{$parsed}{'xmlns','requestId'}); } elsif ($self->can($method)) { return $self->$method($content,$ec2,@params); } else { load_module($handler); my $parser = $self->new(); $parser->parse($content,$ec2,$handler); } } sub class_from_response { my $self = shift; my $response = shift; my ($action) = $response->request->content =~ /Action=([^&]+)/; $action = uri_unescape($action); return $OVERRIDE{$action} || ObjectRegistration->{$action} || 'VM::EC2::Generic'; } sub parser { my $self = shift; return $self->{xml_parser} ||= $self->new_xml_parser; } sub parse { my $self = shift; my ($content,$ec2,$class) = @_; $self = $self->new unless ref $self; my $parsed = $self->parser->XMLin($content); return $self->create_objects($parsed,$ec2,$class); } sub new_xml_parser { my $self = shift; my $nokey = shift; return XML::Simple->new(ForceArray => ['item', 'member'], KeyAttr => $nokey ? [] : ['key'], SuppressEmpty => undef, ); } =head2 $bool = $dispatch->boolean($raw_xml,$ec2,$tag) This is used for XML responses like this: 59dbff89-35bd-4eac-99ed-be587EXAMPLE true It looks inside the structure for the tag named $tag ("return" if not provided), and returns a true value if the contents equals "true". Pass it to add_override() like this: VM::EC2::Dispatch->add_override(DeleteVolume => 'boolean,return'; or, since "return" is the default tag: VM::EC2::Dispatch->add_override(DeleteVolume => 'boolean'; =cut sub boolean { my $self = shift; my ($content,$ec2,$tag) = @_; my $parsed = $self->new_xml_parser()->XMLin($content); $tag ||= 'return'; return $parsed->{$tag} eq 'true'; } =head2 @list = $dispatch->elb_member_list($raw_xml,$ec2,$tag) This is used for XML responses from the ELB API such as this: us-west-2a us-west-2b 02eadcfc-fc38-11e1-a1bf-9de31EXAMPLE It looks inside the Result structure for the tag named $tag and returns the list wrapped in member elements. In this case the tag is 'AvailabilityZones' and the return value would be: ( 'us-west-2a', 'us-west-2b' ) If $embedded_tag is passed, then it is used for XML responses such as this, where the member list has an embedded tag: i-12345678 i-90abcdef f4f12596-fc3b-11e1-be5a-f71ecEXAMPLE It looks inside the Result structure for the tag named $tag and returns the list wrapped in a member element plus the embedded tag. In this case the tag is 'Instances', the embedded tag is 'InstanceId' and the return value would be: ( 'i-12345678', 'i-90abcdef' ) =cut sub elb_member_list { my $self = shift; my ($content,$ec2,$tag,$embedded_tag) = @_; my $parsed = $self->new_xml_parser()->XMLin($content); my ($result_key) = grep /Result$/,keys %$parsed; return $embedded_tag ? map { $_->{$embedded_tag} } @{$parsed->{$result_key}{$tag}{member}} : @{$parsed->{$result_key}{$tag}{member}}; } # identical to fetch_one, except looks inside the *Result tag that ELB API calls # return sub elb_fetch_one { my $self = shift; my ($content,$ec2,$tag,$class,$nokey) = @_; load_module($class); my $parser = $self->new_xml_parser($nokey); my $parsed = $parser->XMLin($content); my ($result_key) = grep /Result$/,keys %$parsed; my $obj = $parsed->{$result_key}{$tag} or return; return $class->new($obj,$ec2,@{$parsed}{'xmlns','requestId'}); } sub fetch_one { my $self = shift; my ($content,$ec2,$tag,$class,$nokey) = @_; load_module($class); my $parser = $self->new_xml_parser($nokey); my $parsed = $parser->XMLin($content); my $obj = $parsed->{$tag} or return; return $class->new($obj,$ec2,@{$parsed}{'xmlns','requestId'}); } =head2 @objects = $dispatch->fetch_items($raw_xml,$ec2,$container_tag,$object_class,$nokey) This is used for XML responses like this: 59dbff89-35bd-4eac-99ed-be587EXAMPLE gsg-keypair 1f:51:ae:28:bf:89:e9:d8:1f:25:5d:37:2d:7d:b8:ca:9f:f5:f1:6f default-keypair 0a:93:bb:e8:c2:89:e9:d8:1f:42:5d:37:1d:8d:b8:0a:88:f1:f1:1a It looks inside the structure for the tag named $container_tag, pulls out the items that are stored under and then passes the parsed contents to $object_class->new(). The optional $nokey argument is used to suppress XML::Simple's default flattening behavior turning tags named "key" into hash keys. Pass it to add_override() like this: VM::EC2::Dispatch->add_override(DescribeVolumes => 'fetch_items,volumeSet,VM::EC2::Volume') =cut sub fetch_items { my $self = shift; my ($content,$ec2,$tag,$class,$nokey) = @_; load_module($class); my $parser = $self->new_xml_parser($nokey); my $parsed = $parser->XMLin($content); my $list = $parsed->{$tag}{item} or return; return map {$class->new($_,$ec2,@{$parsed}{'xmlns','requestId'})} @$list; } =head2 @objects = $dispatch->fetch_members($raw_xml,$ec2,$container_tag,$object_class,$nokey) Used for XML responses from ELB API calls which contain a key that is the name of the API call with 'Result' appended. All these XML responses contain 'member' as the item delimter instead of 'item' =cut sub fetch_members { my $self = shift; my ($content,$ec2,$tag,$class,$nokey) = @_; load_module($class); my $parser = $self->new_xml_parser($nokey); my $parsed = $parser->XMLin($content); my ($result_key) = grep /Result$/,keys %$parsed; my $list = $parsed->{$result_key}{$tag}{member} or return; return map {$class->new($_,$ec2,@{$parsed}{'xmlns','requestId'})} @$list; } =head2 @objects = $dispatch->fetch_items_iterator($raw_xml,$ec2,$container_tag,$object_class,$token_name) This is used for requests that have a -max_results argument. In this case, the response will have a nextToken field, which can be used to fetch the "next page" of results. The $token_name is some unique identifying token. It will be turned into two temporary EC2 instance variables, one named "${token_name}_token", which contains the nextToken value, and the other "${token_name}_stop", which flags the caller that no more results will be forthcoming. This must all be coordinated with the request subroutine. See how describe_instance_status() and describe_spot_price_history() do it. =cut sub fetch_items_iterator { my $self = shift; my ($content,$ec2,$tag,$class,$base_name) = @_; my $token = "${base_name}_token"; my $stop = "${base_name}_stop"; load_module($class); my $parser = $self->new_xml_parser(); my $parsed = $parser->XMLin($content); my $list = $parsed->{$tag}{item} or return; if ($ec2->{$token} && !$parsed->{nextToken}) { delete $ec2->{$token}; $ec2->{$stop}++; } else { $ec2->{$token} = $parsed->{nextToken}; } return map {$class->new($_,$ec2,@{$parsed}{'xmlns','requestId'})} @$list; } sub create_objects { my $self = shift; my ($parsed,$ec2,$class) = @_; return $class->new($parsed,$ec2,@{$parsed}{'xmlns','requestId'}); } sub create_error_object { my $self = shift; my ($content,$ec2,$API_call) = @_; my $class = ObjectRegistration->{Error}; eval "require $class; 1" || die $@ unless $class->can('new'); my $parsed = $self->new_xml_parser->XMLin($content); if (defined $API_call) { $parsed->{Errors}{Error}{Message} =~ s/\.$//; $parsed->{Errors}{Error}{Message} .= " from API call '$API_call'"; } return $class->new($parsed->{Errors}{Error},$ec2,@{$parsed}{'xmlns','requestId'}); } # not a method! sub load_module { my $class = shift; eval "require $class; 1" || die $@ unless $class->can('new'); } =head1 EXAMPLE OF USING OVERRIDE TO SUBCLASS VM::EC2::Volume The author decided that a volume object should not be able to delete itself; you disagree with that decision. Let's subclass VM::EC2::Volume to add a delete() method. First subclass the VM::EC2::Volume class: package MyVolume; use base 'VM::EC2::Volume'; sub delete { my $self = shift; $self->ec2->delete_volume($self); } Now subclass VM::EC2 to add the appropriate overrides to the new() method: package MyEC2; use base 'VM::EC2'; sub new { my $class = shift; VM::EC2::Dispatch->add_override(CreateVolume =>'MyVolume'); VM::EC2::Dispatch->add_override(DescribeVolumes=>'fetch_items,volumeSet,MyVolume'); return $class->SUPER::new(@_); } Now we can test it out: use MyEC2; # find all volumes that are "available" and not in-use my @vol = $ec2->describe_volumes({status=>'available'}); for my $vol (@vol) { $vol->delete && print "$vol deleted\n" } =head1 SEE ALSO L L L L L L L L L L L L L L L L L L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut 1; VM-EC2-1.23/lib/VM/EC2/ElasticAddress.pm000444001751001751 546212100273360 17340 0ustar00lsteinlstein000000000000package VM::EC2::ElasticAddress; =head1 NAME VM::EC2::ElasticAddress - Object describing an Amazon EC2 Elastic Address =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $addr = $ec2->allocate_address; $ip = $addr->publicIp; $domain = $addr->domain; $allId = $addr->allocationId; =head1 DESCRIPTION This object represents an Amazon EC2 elastic address and is returned by by VM::EC2->allocate_address(). =head1 METHODS These object methods are supported: publicIp -- Public IP of the address domain -- Type of address, either "standard" or "vpc" allocationId -- For VPC addresses only, an allocation ID instanceId -- If the address is associated with an instance, the ID of that instance. associationId -- If the address is a VPC elastic IP, and associated with an instance, then the ID of the association. In addition, the following convenience methods are provided: =head2 $result = $addr->associate($instance_id) Associate this address with the given instance ID or VM::EC2::Instance object. If successful, the result code will be true for an ordinary EC2 Elastic IP,or equal to the associationId for a VPC Elastic IP address. =head2 $result = $addr->disassociate() Disassociate this address with any instance it is already associated with. If successful, this method will return true. =head2 $addr->refresh() This is an internal function called after associate() and disassociate(), and is used to refresh the address object's contents. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the publicIp. =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub primary_id {shift->publicIp} sub valid_fields { my $self = shift; return qw(publicIp domain allocationId instanceId associationId); } sub associate { my $self = shift; my $instance = shift or die "Usage: \$elastic_addr->associate(\$instance)"; my $result = $self->aws->associate_address($self,$instance); $self->refresh if $result; $result; } sub disassociate { my $self = shift; my $result = $self->aws->disassociate_address($self); $self->refresh if $result; $result; } sub refresh { my $self = shift; my $i = $self->aws->describe_addresses($self) or return; %$self = %$i; } 1; VM-EC2-1.23/lib/VM/EC2/AvailabilityZone.pm000444001751001751 353112100273360 17707 0ustar00lsteinlstein000000000000package VM::EC2::AvailabilityZone; =head1 NAME VM::EC2::AvailabilityZone - Object describing an Amazon availability zone =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @zones = $ec2->describe_availability_zones(-filter=>{state=>'available'}); $zone = $zones[0]; $name = $zone->zoneName; @messages= $zone->messages; =head1 DESCRIPTION This object represents an Amazon EC2 availability zone, and is returned by VM::EC2->describe_availability_zones(). =head1 METHODS These object methods are supported: zoneName -- Name of the zone, e.g. "eu-west-1a" zoneState -- State of the availability zone, e.g. "available" regionName -- Name of the region region -- A VM::EC2::Region object corresponding to regionName messages -- A list of messages about the zone =head1 STRING OVERLOADING When used in a string context, this object will interpolate the zoneName. =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub primary_id {shift->zoneName} sub valid_fields { my $self = shift; return qw(zoneName zoneState regionName messageSet); } sub messages { my $self = shift; my $m = $self->messageSet or return; return map {$_->{message}} @{$m->{item}}; } sub region { my $self = shift; my $r = $self->regionName; return $self->aws->describe_regions($r); } 1; VM-EC2-1.23/lib/VM/EC2/KeyPair.pm000444001751001751 350212100273360 16003 0ustar00lsteinlstein000000000000package VM::EC2::KeyPair; =head1 NAME VM::EC2::KeyPair - Object describing an Amazon EC2 ssh key pair =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @pairs = $ec2->describe_key_pairs(); foreach (@pairs) { $fingerprint = $_->keyFingerprint; $name = $_->keyName; } $newkey = $ec2->create_key_pair("fred's key"); print $newkey->privateKey; =head1 DESCRIPTION This object represents an Amazon EC2 ssh key pair, and is returned by VM::EC2->describe_key_pairs(). =head1 METHODS These object methods are supported: keyName -- Name of the key, e.g. "fred-default" name -- Shorter version of keyName() keyFingerprint -- Key's fingerprint fingerprint -- Shorter version of keyFingerprint() keyMaterial -- PEM encoded RSA private key (only available when creating a new key) privateKey -- More intuitive version of keyMaterial() =head1 STRING OVERLOADING When used in a string context, this object will interpolate the keyName. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub primary_id {shift->keyName} sub valid_fields { my $self = shift; return qw(requestId keyName keyFingerprint keyMaterial); } sub name { shift->keyName } sub fingerprint { shift->keyFingerprint } sub privateKey { shift->keyMaterial } 1; VM-EC2-1.23/lib/VM/EC2/Region.pm000444001751001751 376512100273360 15675 0ustar00lsteinlstein000000000000package VM::EC2::Region; =head1 NAME VM::EC2::Region - Object describing an Amazon region =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @regions = $ec2->describe_regions(); $region = $regions[0]; $name = $region->regionName; $url = $region->regionEndpoint; @zones = $region->zones; =head1 DESCRIPTION This object represents an Amazon EC2 region, and is returned by VM::EC2->describe_regions(). =head1 METHODS These object methods are supported: regionName -- Name of the region, e.g. "eu-west-1" regionEndpoint -- URL endpoint for AWS API calls, e.g. "ec2.eu-west-1.amazonaws.com" zones -- List of availability zones within this region, as VM::EC2::AvailabilityZone objects. Note that you should prefix the endpoint with http:// or https:// before using it to change the VM::EC2 endpoint with the endpoint() call. If you do not do so, then http:// will be assumed. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the regionName. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub primary_id {shift->regionName} sub valid_fields { my $self = shift; return qw(regionName regionEndpoint); } sub zones { my $self = shift; my $aws = $self->aws; # break encapsulation, but it is elegant this way local $aws->{endpoint} = 'http://'.$self->regionEndpoint; return $aws->describe_availability_zones(-filter=>{'region-name'=>$self}); } 1; VM-EC2-1.23/lib/VM/EC2/ReservedInstance.pm000444001751001751 1007012100273360 17721 0ustar00lsteinlstein000000000000package VM::EC2::ReservedInstance; =head1 NAME VM::EC2::ReservedInstance - Object describing an Amazon EC2 reserved instance =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @offerings = $ec2->describe_reserved_instances(); for my $o (@offerings) { print $o->reservedInstancesId,"\n"; print $o->instanceType,"\n"; print $o->availabilityZone,"\n"; print $o->start,"\n"; print $o->duration,"\n"; print $o->fixedPrice,"\n"; print $o->usagePrice,"\n"; print $o->instanceCount,"\n"; print $o->productDescription,"\n"; print $o->state,"\n"; print $o->instanceTenancy,"\n"; print $o->currencyCode,"\n"; $tags = $o->tags; } =head1 DESCRIPTION This object represents an Amazon EC2 reserved instance reservation that you have purchased, as returned by VM::EC2->describe_reserved_instances(). =head1 METHODS These object methods are supported: reservedInstancesId -- ID of this reserved instance contract instanceType -- The instance type on which these reserved instance can be used. availabilityZone -- The availability zone in which these reserved instances can be used. start -- The date and time that this contract was established. duration -- The duration of this contract, in seconds. fixedPrice -- The purchase price of the reserved instance for the indicated version. usagePrice -- The usage price of the reserved instance, per hour. instanceCount -- The number of instances that were purchased under this contract. productDescription -- The reserved instance description. One of "Linux/UNIX", "Linux/UNIX (Amazon VPC)", "Windows", and "Windows (Amazon VPC)" state -- The state of the reserved instance purchase. One of "payment-pending", "active", "payment-failed", and "retired". tagSet -- Tags for this reserved instance set. More conveniently accessed via the tags(), add_tags() and delete_tags() methods. instanceTenancy -- The tenancy of the reserved instance (VPC only). currencyCode -- The currency of the reserved instance offering prices. This object supports the various tag manipulation methods described in L. In addition it supports the following methods: =head2 $status = $reserved_instance->current_status Refreshes the object and returns its state, one of "payment-pending", "active", "payment-failed", and "retired". You can use this to monitor the progress of a purchase. =head2 $reserved_instance->refresh Calls VM::EC2->describe_reserved_instances() to refresh the object against current information in Amazon. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the reservedInstancesId. =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub primary_id {shift->reservedInstancesId} sub valid_fields { my $self = shift; return qw(reservedInstancesId instanceType availabilityZone start duration fixedPrice usagePrice instanceCount productDescription state tagSet instanceTenancy currencyCode); } sub current_status { my $self = shift; $self->refresh; return $self->state; } sub current_state { shift->current_status } # alias sub refresh { my $self = shift; local $self->aws->{raise_error} = 1; my $i = $self->ec2->describe_reserved_instances($self->reservedInstancesId); %$self = %$i; } 1; VM-EC2-1.23/lib/VM/EC2/NetworkInterface.pm000444001751001751 2710612100273360 17737 0ustar00lsteinlstein000000000000package VM::EC2::NetworkInterface; =head1 NAME VM::EC2::NetworkInterface - Object describing an Amazon Elastic Network Interface (ENI) =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $interface = $ec2->describe_network_interfaces('eni-12345'); print $interface->subNetId,"\n", $interface->description,"\n", $interface->vpcId,"\n", $interface->status,"\n", $interface->privateIpAddress,"\n", $interface->macAddress,"\n"; =head1 DESCRIPTION This object provides access to information about Amazon Elastic Network Interface objects, which are used in conjunction with virtual private cloud (VPC) instances to create multi-homed web servers, routers, firewalls, and so forth. Please see L for methods shared by all VM::EC2 objects. =head1 METHODS These object methods are supported: networkInterfaceId -- The ID of this ENI subnetId -- The ID of the subnet this ENI belongs to vpcId -- The ID of the VPC this ENI belongs to ownerId -- Owner of the ENI status -- ENI status, one of "available" or "in-use" privateIpAddress -- Primary private IP address of the ENI privateDnsName -- Primary private DNS name of the ENI as a set of VM::EC2::Group objects. attachment -- Information about the attachment of this ENI to an instance, as a VM::EC2::NetworkInterface::Attachment object. association -- Information about the association of this ENI with an elastic public IP address. privateIpAddresses -- List of private IP addresses assigned to this ENI, as a list of VM::EC2::NetworkInterface::PrivateIpAddress objects. availabilityZone -- Availability zone for this ENI as a VM::EC2::AvailabilityZone object. macAddress -- MAC address for this interface. In addition, this object supports the following convenience methods: resetAttributes() -- Return attributes to their default states. Currently only sets the SourceDestCheck value to true. description([$new_value]) -- Description of the ENI. Pass a single argument to set a new description sourceDestCheck([$boolean])-- Boolean value. If true, prevent this ENI from forwarding packets between subnets. Value can optionally be set security_groups([@new_groups]) -- List of security groups this ENI belongs to. Pass a list of new security groups to change this value. delete_on_termination([$boolean]) -- Whether the deleteOnTermination flag is set for the current attachment. Pass a boolean value to change the value. =head1 Attaching to an instance The following methods allow the interface to be attached to, and detached from, instances. =head2 $attachment_id = $interface->attach($instance_id => $device) =head2 $attachment_id = $interfacee->attach(-instance_id => $id, -device_index => $device) This method attaches the network interface an instance using the the indicated device index. You can provide either an instance ID, or a VM::EC2::Instance object. You may use an integer for -device_index, or use the strings "eth0", "eth1" etc. Required arguments: -instance_id ID of the instance to attach to. -device_index Network device number to use (e.g. 0 for eth0). On success, this method returns the attachmentId of the new attachment (not a VM::EC2::NetworkInterface::Attachment object, due to an AWS API inconsistency). =head2 $boolean = $interface->detach([$force]) This method detaches the network interface from whatever instance it is currently attached to. If a true argument is provided, then the detachment will be forced, even if the interface is in use. On success, this method returns a true value. =head1 Adding IP addresses =head2 $result = $interface->assign_private_ip_addresses(@addresses) =head2 $result = $interface->assign_private_ip_addresses(%args) Assign one or more secondary private IP addresses to the network interface. You can either set the addresses explicitly, or provide a count of secondary addresses, and let Amazon select them for you. In the list argument form, pass a list of desired IP addresses, or a count of the number of addresses to select for you: $interface->assign_private_ip_addresses(3); # three automatic addresses $interface->assign_private_ip_addresses('192.168.0.10','192.168.0.11'); Required arguments: -private_ip_address One or more secondary IP addresses, as a scalar string -private_ip_addresses or array reference. (The two arguments are equivalent). Optional arguments: -allow_reassignment If true, allow assignment of an IP address is already in use by another network interface or instance. The following are valid arguments to -private_ip_address: -private_ip_address => '192.168.0.12' # single address -private_ip_address => ['192.168.0.12','192.168.0.13] # multiple addresses -private_ip_address => 3 # autoselect three addresses The mixed form of address, such as ['192.168.0.12','auto'] is not allowed in this call. On success, this method returns true. =head2 $result = $interface->unassign_private_ip_addresses(@addresses) =head2 $result = $interface->unassign_private_ip_addresses(-private_ip_address => \@addresses) Unassign one or more secondary private IP addresses from the network interface. In the list argument form, pass a list of desired IP addresses to unassign. $interface->assign_private_ip_addresses('192.168.0.10','192.168.0.11'); In the named argument form, use: -private_ip_address One or more secondary IP addresses, as a scalar string -private_ip_addresses or array reference. (The two arguments are equivalent). The following are valid arguments to -private_ip_address: -private_ip_address => '192.168.0.12' # single address -private_ip_address => ['192.168.0.12','192.168.0.13] # multiple addresses On success, this method returns true. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the networkInterfaceId =head1 SEE ALSO L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use Carp 'croak'; use VM::EC2::Group; use VM::EC2::NetworkInterface::PrivateIpAddress; use VM::EC2::NetworkInterface::Attachment; use VM::EC2::NetworkInterface::Association; sub valid_fields { my $self = shift; return qw(networkInterfaceId subnetId vpcId description ownerId status privateIpAddress privateDnsName sourceDestCheck groupSet attachment association privateIpAddressesSet macAddress requesterManaged availabilityZone); } sub refresh { my $self = shift; my $i = shift; local $self->aws->{raise_error} = 1; ($i) = $self->aws->describe_network_interfaces(-network_interface_id=>$self->networkInterfaceId) unless $i; %$self = %$i; } sub current_status { my $self = shift; $self->refresh; $self->status; } sub primary_id {shift->networkInterfaceId} sub groups { my $self = shift; my $groupSet = $self->SUPER::groupSet; return map {VM::EC2::Group->new($_,$self->aws,$self->xmlns,$self->requestId)} @{$groupSet->{item}}; } sub privateIpAddresses { my $self = shift; my $set = $self->SUPER::privateIpAddressesSet; return map {VM::EC2::NetworkInterface::PrivateIpAddress->new($_,$self->aws)} @{$set->{item}}; } sub attachment { my $self = shift; my $a = $self->SUPER::attachment or return; return VM::EC2::NetworkInterface::Attachment->new($a,$self->aws); } sub association { my $self = shift; my $a = $self->SUPER::association or return; return VM::EC2::NetworkInterface::Association->new($a,$self->aws); } sub vpc { my $self = shift; return $self->describe_vpcs($self->vpcId); } # get/set methods sub description { my $self = shift; my $d = $self->aws->describe_network_interface_attribute($self,'description'); $self->aws->modify_network_interface_attribute($self,-description=>shift) if @_; return $d; } sub security_groups { my $self = shift; my @d = $self->aws->describe_network_interface_attribute($self,'groupSet'); $self->aws->modify_network_interface_attribute($self,-security_group_id=>\@_) if @_; return map {VM::EC2::Group->new($_,$self->aws)} @d; } sub source_dest_check { my $self = shift; my $d = $self->aws->describe_network_interface_attribute($self,'sourceDestCheck'); $self->aws->modify_network_interface_attribute($self,-source_dest_check=>(shift() ? 'true' : 'false')) if @_; return $d eq 'true'; } sub reset_attributes { my $self = shift; return $self->aws->reset_network_interface_attribute($self=>'sourceDestCheck'); } sub delete_on_termination { my $self = shift; my $d = $self->aws->describe_network_interface_attribute($self,'attachment') or return; my $att = VM::EC2::NetworkInterface::Attachment->new($d,$self->aws); $self->aws->modify_network_interface_attribute($self,-delete_on_termination=>[$att=>shift]) if @_; return $att->delete_on_termination; } sub availabilityZone { my $self = shift; my $z = $self->SUPER::availabilityZone or return; return $self->aws->describe_availability_zones($z); } sub attach { my $self = shift; my %args; if (@_==2 && $_[0] !~ /^-/) { @args{qw(-instance_id -device_index)} = @_; } else { %args = @_; } $args{-instance_id} && $args{-device_index} or croak "usage: \$interface->attach(\$instance_id,\$device_index)"; $args{-network_interface_id} = $self->networkInterfaceId; my $result = $self->aws->attach_network_interface(%args); $self->refresh if $result; eval {$args{-instance_id}->refresh} if $result; return $result; } sub detach { my $self = shift; my $force = shift; my $attachment = $self->attachment; $attachment or croak "$self is not attached"; my $result = $self->aws->detach_network_interface($attachment,$force); $self->refresh if $result; return $result; } sub assign_private_ip_addresses { my $self = shift; my %args; if (@_ && $_[0] !~ /^-/) { %args = (-private_ip_address => @_==1 ? $_[0] : \@_); } else { %args = @_; } my $result = $self->aws->assign_private_ip_addresses(-network_interface_id=>$self,%args); $self->refresh if $result; return $result; } sub unassign_private_ip_addresses { my $self = shift; my %args; if (@_ && $_[0] !~ /^-/) { %args = (-private_ip_address => \@_); } else { %args = @_; } my $result = $self->aws->unassign_private_ip_addresses(-network_interface_id=>$self,%args); $self->refresh if $result; return $result; } 1; VM-EC2-1.23/lib/VM/EC2/Tag.pm000444001751001751 365512100273360 15163 0ustar00lsteinlstein000000000000package VM::EC2::Tag; =head1 NAME VM::EC2::Tag -- Object describing a tagged Amazon EC2 resource =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @tags = $ec2->describe_tags(-filter=> {'resource-type'=>'volume'}); for my $t (@tags) { $id = $t->resourceId; $type = $t->resourceType; $key = $t->key; $value = $t->value; } =head1 DESCRIPTION This object is used to describe an Amazon EC2 tag. Each object contains information about the resource it is tagging, the tag key, and the tag value. Tags are returned by the VM::EC2->describe_tags() method. In most cases you will not want to work with this object directly, but instead read tags by calling a resource object's tags() method, which returns a hash of key value pairs, or specify particular tag values as one of the filters in a describe_*() call. =head1 METHODS The following object methods are supported: resourceId -- The ID of the resource being tagged. resourceType -- The type of the resource being tagged e.g. "image" key -- The tag key. value -- The tag value. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the resourceId. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use overload '""' => sub { my $self = shift; return $self->resourceId}, fallback => 1; sub valid_fields { my $self = shift; return qw(resourceId resourceType key value); } 1; VM-EC2-1.23/lib/VM/EC2/Error.pm000444001751001751 405512100273360 15534 0ustar00lsteinlstein000000000000package VM::EC2::Error; =head1 NAME VM::EC2::Error - Object describing an error emitted by the Amazon API =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $instance = $ec2->describe_instance(-instance_id=>'invalid-name'); die $ec2->error if $ec2->is_error; =head1 DESCRIPTION This object represents an error emitted by the Amazon API. VM::EC2 method calls may return undef under either of two conditions: the request may simply have no results that satisfy it (for example, asking to describe an instance whose ID does not exist), or an error occurred due to invalid parameters or communication problems. As described in L, the VM::EC2->is_error method returns true if the last method call resulted in an error, and VM::EC2->error returns the content of the error message. =head1 METHODS These object methods are supported: message -- the error message code -- the error code =head1 STRING OVERLOADING When used in a string context, this object will interpolate the code and message into a single string in the format "Message [Code]". =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use overload '""' => sub { my $self = shift; my $msg = $self->Message; $msg =~ s/\.$//; my $code = $self->Code; return "[$code] $msg";}, fallback => 1; sub valid_fields { my $self = shift; return qw(Code Message); } # because the darn Error XML doesn't adhere # to the conventions elsewhere, in which # the initial letter of the tag is lowercase sub code {shift->payload->{Code}} sub message {shift->payload->{Message}} 1; VM-EC2-1.23/lib/VM/EC2/BlockDevice.pm000444001751001751 751712100273360 16623 0ustar00lsteinlstein000000000000package VM::EC2::BlockDevice; =head1 NAME VM::EC2::BlockDevice - Object describing how to construct an EC2 block device when launching an image =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $image = $ec2->describe_images(-image_id=>'ami-123456'); my @devices = $image->blockDeviceMapping; for my $d (@devices) { my $virtual_device = $d->deviceName; my $snapshot_id = $d->snapshotId; my $volume_size = $d->volumeSize; my $delete = $d->deleteOnTermination; } =head1 DESCRIPTION This object represents an Amazon block device associated with an AMI. The information in it is used to create a new volume when the AMI is launched. The object is returned by VM::EC2->describe_images(). Please see L for methods shared by all VM::EC2 objects. =head1 METHODS These object methods are supported: deviceName -- name of the device, such as /dev/sda1 virtualName -- virtual device name, such as "ephemeral0" noDevice -- true if no device associated ebs -- parameters used to automatically set up Amazon EBS volumes when an instance is booted. This returns a VM::EC2::BlockDevice::EBS object. For your convenience, a number of the ebs() object's methods are passed through: snapshotId -- ID of the snapshot used to create this EBS when an instance is launched from this image. volumeSize -- Size of the EBS volume (in gigs). deleteOnTermination -- Whether this EBS will be deleted when the instance terminates. volumeType -- The volume type, one of "standard" or "io1" iops -- The number of I/O operations per second that the volume supports, an integer between 100 and 2000. Only valid for volumes of type "io1". =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as: deviceName=snapshotId:volumeSize:deleteOnTermination:volumeType:iops The :iops portion is only valid when the volumeType is "io1". e.g. /dev/sdg=snap-12345:20:true:standard This happens to be the same syntax used to specify block device mappings in run_instances(). See L. =head1 SEE ALSO L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::BlockDevice::EBS; use overload '""' => sub {shift()->as_string}, fallback => 1; sub valid_fields { my $self = shift; return qw(deviceName virtualName ebs); } sub noDevice { my $self = shift; return exists $self->payload->{noDevice}; } sub ebs { my $self = shift; return $self->{ebs} = VM::EC2::BlockDevice::EBS->new($self->SUPER::ebs,$self->aws); } sub snapshotId { shift->ebs->snapshotId } sub volumeSize { shift->ebs->volumeSize } sub deleteOnTermination { shift->ebs->deleteOnTermination } sub volumeType { shift->ebs->volumeType } sub iops { shift->ebs->iops } sub as_string { my $self = shift; my $vname = $self->virtualName; return $self->deviceName.'='.$vname if $vname && $vname =~ /^ephemeral/; my $dot = $self->deleteOnTermination ? 'true' : 'false'; my $vtype = $self->volumeType; my @type_iops = $vtype eq 'io1' ? ($vtype,$self->iops) : $vtype; return $self->deviceName.'='. join ':',$self->snapshotId,$self->volumeSize,$dot,@type_iops; } 1; VM-EC2-1.23/lib/VM/EC2/Generic.pm000444001751001751 2712612100273360 16043 0ustar00lsteinlstein000000000000package VM::EC2::Generic; =head1 NAME VM::EC2::Generic - Base class for VM::EC2 objects =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(-access_key => 'access key id', -secret_key => 'aws_secret_key', -endpoint => 'http://ec2.amazonaws.com'); my $object = $ec2->some_method(...); # getting data fields my @field_names = $object->fields; # invoking data fields as methods my $request_id = $object->requestId; my $xmlns = $object->xmlns; # tagging my $tags = $object->tags; if ($tags->{Role} eq 'WebServer') { $object->delete_tags(Role=>undef); $object->add_tags(Role => 'Web Server', Status => 'development'); } # get the parsed XML object as a hash my $hashref = $object->payload; # get the parsed XML object as a Data::Dumper string my $text = $object->as_string; # get the VM::EC2 object back my $ec2 = $object->ec2; # get the most recent error string warn $object->error_str; =head1 DESCRIPTION This is a common base class for objects returned from VM::EC2. It provides a number of generic methods that are used in subclasses, but is not intended to be used directly. =head1 METHODS =cut use strict; use Carp 'croak'; use Data::Dumper; our $AUTOLOAD; $Data::Dumper::Terse++; $Data::Dumper::Indent=1; use overload '""' => sub {my $self = shift; return $self->short_name; }, fallback => 1; sub AUTOLOAD { my $self = shift; my ($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/; return if $func_name eq 'DESTROY'; my %fields = map {$_=>1} $self->valid_fields; my $mixed = VM::EC2->uncanonicalize($func_name);# mixedCase my $flat = VM::EC2->canonicalize($func_name); # underscore_style $flat =~ s/^-//; if ($mixed eq $flat) { return $self->{data}{$mixed} if $fields{$mixed}; return $self->{data}{ucfirst $mixed} if $fields{ucfirst $mixed}; croak "Can't locate object method \"$func_name\" via package \"$pack\""; } if ($func_name eq $flat && $self->can($mixed)) { return $self->$mixed(@_); } elsif ($func_name eq $mixed && $self->can($flat)) { return $self->$flat(@_); } elsif ($fields{$mixed}) { return $self->{data}{$mixed} if $fields{$mixed}; } elsif ($fields{ucfirst($mixed)}) { # very occasionally an API field breaks Amazon's coding # conventions and starts with an uppercase return $self->{data}{ucfirst($mixed)}; } else { croak "Can't locate object method \"$func_name\" via package \"$pack\""; } } sub can { my $self = shift; my $method = shift; my $can = $self->SUPER::can($method); return $can if $can; my %fields = map {$_=>1} $self->valid_fields; return \&AUTOLOAD if $fields{$method}; return; } =head2 $object = VM::EC2::Generic->new($payload,$ec2 [,$xmlns, $requestId]) Given the parsed XML generated by VM::EC2::Dispatch and the VM::EC2 object, return a new object. Two optional additional arguments provide the seldom-needed XML namespace and ID of the request that generated this object. =cut sub new { my $self = shift; @_ >= 2 or croak "Usage: $self->new(\$data,\$ec2)"; my ($data,$ec2,$xmlns,$requestid) = @_; return bless {data => $data, aws => $ec2, xmlns => $xmlns, requestId => $requestid },ref $self || $self; } =head2 $ec2 = $object->ec2 =head2 $ec2 = $object->aws Return the VM::EC2 object that generated this object. This method can be called as either ec2() (preferred) or aws() (deprecated). =cut sub ec2 { my $self = shift; my $d = $self->{aws}; $self->{aws} = shift if @_; $d; } sub aws {shift->ec2} =head2 $id = $object->primary_id (optional method) Resources that have unique Amazon identifiers, such as images, instances and volumes, implement the primary_id() method to return that identifier. Resources that do not have unique identifiers, will throw an exception if this method is called. This method is in addition to the resource-specific ID. For example, volumes have a unique ID, and this ID can be fetched with either of: $vol->volumeId; or $vol->primary_id; =back =head2 $xmlns = $object->xmlns Return the XML namespace of the request that generated this object, if any. All objects generated by direct requests on the VM::EC2 object will return this field, but objects returned via methods calls on these objects (objects once removed) may not. =cut sub xmlns { shift->{xmlns} } =head2 $id = $object->requestId Return the ID of the reuqest that generated this object, if any. All objects generated by direct requests on the VM::EC2 object will return this field, but objects returned via methods calls on these objects (objects once removed) may not. =cut sub requestId { shift->{requestId} } =head2 $name = $object->short_name Return a short name for this object for use in string interpolation. If the object has a primary_id() method, then this returns that ID. Otherwise it returns the default Perl object name (VM::EC2::Generic=HASH(0x99f3850). Some classes override short_name() in order to customized information about the object. See for example L. =cut sub short_name { my $self = shift; if ($self->can('primary_id')) { return $self->primary_id; } else { return overload::StrVal($self); } } =head2 $hashref = $object->payload Return the parsed XML hashref that underlies this object. See L. =cut sub payload { shift->{data} } =head2 @fields = $object->fields Return the data field names that are valid for an object of this type. These field names correspond to tags in the XML returned from Amazon and can then be used as method calls. Internally, this method is called valid_fields() =cut sub fields { shift->valid_fields } sub valid_fields { return qw(xmlns requestId) } =head2 $text = $object->as_string Return a Data::Dumper representation of the contents of this object's payload. =cut sub as_string { my $self = shift; return Dumper($self->{data}); } =head2 $hashref = $object->tags =head2 $hashref = $object->tagSet Return the metadata tags assigned to this resource, if any, as a hashref. Both tags() and tagSet() work identically. =cut sub tags { my $self = shift; my $result = {}; my $set = $self->{data}{tagSet} or return $result; my $innerhash = $set->{item} or return $result; for my $key (keys %$innerhash) { $result->{$key} = $innerhash->{$key}{value}; } return $result; } sub tagSet { return shift->tags(); } =head2 $boolean = $object->add_tags(Tag1=>'value1',Tag2=>'value2',...) =head2 $boolean = $object->add_tags(\%hash) Add one or more tags to the object. You may provide either a list of tag/value pairs or a hashref. If no tag of the indicated name exsists it will be created. If there is already a tag by this name, it will be set to the provided value. The result code is true if the Amazon resource was successfully updated. Also see VM::EC2->add_tags() for a way of tagging multiple resources simultaneously. The alias add_tag() is also provided as a convenience. =cut sub add_tags { my $self = shift; my $taglist = ref $_[0] && ref $_[0] eq 'HASH' ? shift : {@_}; $self->can('primary_id') or croak "You cannot tag objects of type ",ref $self; $self->aws->create_tags(-resource_id => $self->primary_id, -tag => $taglist); } sub add_tag { shift->add_tags(@_) } =head2 $boolean = $object->delete_tags(@args) Delete the indicated tags from the indicated resource. There are several variants you may use: # delete Foo tag if it has value "bar" and Buzz tag if it has value 'bazz' $i->delete_tags({Foo=>'bar',Buzz=>'bazz'}) # same as above but using a list rather than a hashref $i->delete_tags(Foo=>'bar',Buzz=>'bazz') # delete Foo tag if it has any value, Buzz if it has value 'bazz' $i->delete_tags({Foo=>undef,Buzz=>'bazz'}) # delete Foo and Buzz tags unconditionally $i->delete_tags(['Foo','Buzz']) # delete Foo tag unconditionally $i->delete_tags('Foo'); Also see VM::EC2->delete_tags() for a way of deleting tags from multiple resources simultaneously. =cut sub delete_tags { my $self = shift; my $taglist; if (ref $_[0]) { if (ref $_[0] eq 'HASH') { $taglist = shift; } elsif (ref $_[0] eq 'ARRAY') { $taglist = {map {$_=>undef} @{$_[0]} }; } } else { if (@_ == 1) { $taglist = {shift()=>undef}; } else { $taglist = {@_}; } } $self->can('primary_id') or croak "You cannot delete tags from objects of type ",ref $self; $self->aws->delete_tags(-resource_id => $self->primary_id, -tag => $taglist); } sub _object_args { my $self = shift; return ($self->aws,$self->xmlns,$self->requestId); } =head2 $xml = $object->as_xml Returns an XML version of the object. The object will already been parsed by XML::Simple at this point, and so the data returned by this method will not be identical to the XML returned by AWS. =cut sub as_xml { my $self = shift; XML::Simple->new->XMLout($self->payload, NoAttr => 1, KeyAttr => ['key'], RootName => 'xml', ); } =head2 $value = $object->attribute('tag_name') Returns the value of a tag in the XML returned from AWS, using a simple heuristic. If the requested tag has a nested tag named it will return the contents of . If the tag has one or more nested tags named , it will return a list of hashrefs located within the tag. Otherwise it will return the contents of . =cut sub attribute { my $self = shift; my $attr = shift; my $payload = $self->payload or return; my $hr = $payload->{$attr} or return; return $hr->{value} if $hr->{value}; return @{$hr->{item}} if $hr->{item}; return $hr; } =head2 $string = $object->error_str Returns the error string for the last operation, if any, as reported by VM::EC2. =cut sub error_str { my $self = shift; my $ec2 = $self->ec2 or return; $ec2->error_str; } =head2 $string = $object->error Returns the L object from the last operation, if any, as reported by VM::EC2. =cut sub error { my $self = shift; my $ec2 = $self->ec2 or return; $ec2->error; } =head1 STRING OVERLOADING This base class and its subclasses use string overloading so that the object looks and acts like a simple string when used in a string context (such as when printed or combined with other strings). Typically the string corresponds to the Amazon resource ID such as "ami-12345" and is generated by the short_name() method. You can sort and compare the objects as if they were strings, but despite this, object method calls work in the usual way. =head1 SEE ALSO L L L L L L L L L L L L L L L L L L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut 1; VM-EC2-1.23/lib/VM/EC2/Image.pm000444001751001751 2670312100273360 15511 0ustar00lsteinlstein000000000000package VM::EC2::Image; =head1 NAME VM::EC2::Image - Object describing an Amazon Machine Image (AMI) =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $image = $ec2->describe_images(-image_id=>'ami-12345'); $state = $image->imageState; $owner = $image->imageOwnerId; $rootdev = $image->rootDeviceName; @devices = $image->blockDeviceMapping; $tags = $image->tags; @instances = $image->run_instances(-min_count=>10); =head1 DESCRIPTION This object represents an Amazon Machine Image (AMI), and is returned by VM::EC2->describe_images(). In addition to methods to query the image's attributes, the run_instances() method allows you to launch and configure EC2 instances based on the AMI. =head1 METHODS These object methods are supported: imageId -- AMI ID imageLocation -- Location of the AMI imageState -- Current state of the AMI. One of "available", "pending" or "failed". Only "available" AMIs can be launched. imageOwnerId -- AWS account ID of the image owner. isPublic -- Returns true if this image has public launch permissions. Note that this is a Perl boolean, and not the string "true". productCodes -- A list of product codes associated with the image. architecture -- The architecture of the image. imageType -- The image type (machine, kernel or RAM disk). kernelId -- The kernel associated with the image. ramdiskId -- The RAM disk associated with the image. platform -- "Windows" for Windows AMIs, otherwise undef. stateReason -- Explanation of a "failed" imageState. This is a VM::EC2::Instance::State::Reason object. imageOwnerAlias -The AWS account alias (e.g. "self") or AWS account ID that owns the AMI. name -- Name of the AMI provided during image creation. description -- Description of the AMI provided during image creation. rootDeviceType -- The root device type. One of "ebs" or "instance-store". rootDeviceName -- Name of the root device, e.g. "/dev/sda1" blockDeviceMapping -- List of block devices attached to this image. Each element is a VM::EC2::BlockDevice. virtualizationType -- One of "paravirtual" or "hvm". hypervisor -- One of "ovm" or "xen" In addition, the object supports the tags() method described in L: print "ready for production\n" if $image->tags->{Released}; =head2 @instances = $image->run_instances(%args) The run_instance() method will launch one or more instances based on this AMI. The method takes all the arguments recognized by VM::EC2->run_instances(), except for the -image_id argument. The method returns a list of VM::EC2::Instance objects, which you may monitor periodically until they are up and running. All arguments are optional. See run_instances() in L for more information. -min_count Minimum number of instances to launch [1] -max_count Maximum number of instances to launch [1] -key_name Name of the keypair to use -security_group_id Security group ID to use for this instance. Use an arrayref for multiple group IDs -security_group Security group name to use for this instance. Use an arrayref for multiple values. -user_data User data to pass to the instances. Do NOT base64 encode this. It will be done for you. -instance_type Type of the instance to use. See below for a list. -placement_zone The availability zone you want to launch the instance into. Call $ec2->regions for a list. -placement_group An existing placement group to launch the instance into. Applicable to cluster instances only. -placement_tenancy Specify 'dedicated' to launch the instance on a dedicated server. Only applicable for VPC instances. -kernel_id ID of the kernel to use for the instances, overriding the kernel specified in the image. -ramdisk_id ID of the ramdisk to use for the instances, overriding the ramdisk specified in the image. -block_devices Specify block devices to map onto the instances, overriding the values specified in the image. This can be a scalar string or an arrayref for multiple mappings: Example: ['/dev/sdb=ephemeral0','/dev/sdc=snap-12345:80:false'] -monitoring Pass a true value to enable detailed monitoring. -subnet_id ID of the subnet to launch the instance into. Only applicable for VPC instances. -termination_protection Pass true to lock the instance so that it cannot be terminated using the API. Use modify_instance() to unset this if youu wish to terminate the instance later. -disable_api_termination -- Same as above. -shutdown_behavior Pass "stop" (the default) to stop the instance and save its disk state when "shutdown" is called from within the instance. Stopped instances can be restarted later. Pass "terminate" to instead terminate the instance and discard its state completely. -instance_initiated_shutdown_behavior -- Same as above. -private_ip_address Assign the instance to a specific IP address from a VPC subnet (VPC only). -client_token Unique identifier that you can provide to ensure idempotency of the request. You can use $ec2->token() to generate a suitable identifier. See http://docs.amazonwebservices.com/AWSEC2/ latest/UserGuide/Run_Instance_Idempotency.html Note that after launching an instance, you may need to wait a few seconds before adding tags to it or performing other operations. See L for details. =head2 $boolean = $image->make_public($public) Change the isPublic flag. Provide a true value to make the image public, a false one to make it private. =head2 $state = $image->current_status Refreshes the object and then calls imageState() to return one of "pending", "available" or "failed." You can use this to monitor an image_creation process in progress. =head2 @user_ids = $image->launchPermissions Returns a list of user IDs with launch permission for this image. Note that the AWS API calls this "launchPermission", but this module makes it plural to emphasize that the result is a list. =head2 @user_ids = $image->authorized_users The same as launchPermissions. =head2 $boolean = $image->add_authorized_users($id1,$id2,...) =head2 $boolean = $image->remove_authorized_users($id1,$id2,...) These methods add and remove user accounts which have launch permissions for the image. The result code indicates whether the list of user IDs were successfully added or removed. =head2 $boolean = $image->add_authorized_users($id1,$id2,...) =head2 $boolean = $image->remove_authorized_users($id1,$id2,...) =head2 $boolean = $image->reset_authorized_users These methods add and remove user accounts which have launch permissions for the image. The result code indicates whether the list of user IDs were successfully added or removed. reset_authorized_users() resets the list users authored to launch instances from this image to empty, effectively granting launch privileges to the owner only. See also authorized_users(). =head2 $image->refresh This method will refresh the object from AWS, updating all values to their current ones. You can call it after tagging or otherwise changing image attributes. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the imageId. =head1 SEE ALSO L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::BlockDevice; use VM::EC2::Image::LaunchPermission; use VM::EC2::Instance::State::Reason; use VM::EC2::ProductCode; use Carp 'croak'; sub valid_fields { my $self = shift; return qw(imageId imageLocation imageState imageOwnerId isPublic productCodes architecture imageType kernelId ramdiskId platform stateReason imageOwnerAlias name description rootDeviceType rootDeviceName blockDeviceMapping virtualizationType tagSet hypervisor); } sub primary_id { shift->imageId } sub stateReason { my $self = shift; my $state = $self->SUPER::stateReason; return VM::EC2::Instance::State::Reason->new($state); } sub productCodes { my $self = shift; if (@_) { $self->aws->modify_image_attribute($self,-product_code=>\@_); } else { my $codes = $self->SUPER::productCodes or return; return map {VM::EC2::ProductCode->new($_)} @{$codes->{item}}; } } sub blockDeviceMapping { my $self = shift; my $mapping = $self->SUPER::blockDeviceMapping or return; return map { VM::EC2::BlockDevice->new($_,$self->aws)} @{$mapping->{item}}; } sub launchPermissions { my $self = shift; return map {VM::EC2::Image::LaunchPermission->new($_,$self->aws)} $self->aws->describe_image_attribute($self->imageId,'launchPermission'); } sub isPublic { my $self = shift; return $self->SUPER::isPublic eq 'true'; } sub make_public { my $self = shift; @_ == 1 or croak "Usage: VM::EC2::Image->make_public(\$boolean)"; my $public = shift; my @arg = $public ? (-launch_add_group=>'all') : (-launch_remove_group=>'all'); my $result = $self->aws->modify_image_attribute($self->imageId,@arg) or return; $self->payload->{isPublic} = $public ? 'true' : 'false'; return $result } sub authorized_users { shift->launchPermissions } sub add_authorized_users { my $self = shift; @_ or croak "Usage: VM::EC2::Image->add_authorized_users(\@userIds)"; return $self->aws->modify_image_attribute($self->imageId,-launch_add_user=>\@_); } sub remove_authorized_users { my $self = shift; @_ or croak "Usage: VM::EC2::Image->remove_authorized_users(\@userIds)"; return $self->aws->modify_image_attribute($self->imageId,-launch_remove_user=>\@_); } sub reset_authorized_users { my $self = shift; $self->aws->reset_image_attribute($self->imageId,'launchPermission'); } sub run_instances { my $self = shift; my %args = @_; croak "$self is unavailable for launching because its state is ",$self->imageState unless $self->imageState eq 'available'; $args{-image_id} = $self->imageId; $self->aws->run_instances(%args); } sub current_status { my $self = shift; $self->refresh; return $self->imageState; } sub refresh { my $self = shift; my $i = shift; local $self->aws->{raise_error} = 1; ($i) = $self->aws->describe_images(-image_id=>$self->imageId) unless $i; %$self = %$i; } 1; VM-EC2-1.23/lib/VM/EC2/ProductCode.pm000444001751001751 276412100273360 16663 0ustar00lsteinlstein000000000000package VM::EC2::ProductCode; =head1 NAME VM::EC2::ProductCode - Object describing an Amazon EC2 product code =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $volume = $ec2->describe_volumes('vol-123456'); for my $g ($volume->product_codes) { my $id = $g->productCode; my $type = $g->type; } =head1 DESCRIPTION This object represents the code and type of a product code. =head1 METHODS These object methods are supported: productCode -- the product code code -- shorter version of the above type -- the type of product code ('devpay','marketplace') =head1 STRING OVERLOADING When used in a string context, this object will interpolate the productCode =head1 SEE ALSO L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return $self->SUPER::valid_fields, qw(productCode type); } sub code { shift->productCode } sub short_name {shift->productCode} 1; VM-EC2-1.23/lib/VM/EC2/VPC.pm000444001751001751 1224412100273360 15112 0ustar00lsteinlstein000000000000package VM::EC2::VPC; =head1 NAME VM::EC2::VPC =head1 SYNOPSIS use VM::EC2; $ec2 - VM::EC2->new(...); $vpc = $ec2->create_vpc('10.0.0.0/16') or die $ec2->error_str; $subnet1 = $vpc->create_subnet('10.0.0.0/24') or die $vpc->error_str; $gateway = $vpc->create_internet_gateway or die $vpc->error_str; $routeTbl = $subnet1->create_route_table or die $vpc->error_str; $routeTbl->create_route('0.0.0.0/0' => $gateway) or die $vpc->error_str; =head1 DESCRIPTION Please see L for methods shared by all VM::EC2 objects. =head1 METHODS These object methods are supported: vpcId -- ID of the VPC state -- Current state of the VPC (pending, available) cidrBlock -- The CIDR block the VPC covers. dhcpOptionsId -- The ID of the set of DHCP options you've associated with the VPC, or "default". instanceTenancy -- Either "dedicated" or "default" In addition, this object supports the following convenience methods: dhcp_options() -- Return a VM::EC2::VPC::DhcpOptions object. current_state() -- Refresh the object and then return its state current_status() -- Same as above (for module consistency) set_dhcp_options($options) -- Associate the Dhcp option set with this VPC (DhcpOptionsId string or VM::EC2::VPC::DhcpOptions object). Use "default" or pass no arguments to assign no Dhcp options. internet_gateways() -- Return the list of internet gateways attached to this VPC as a list of VM::EC2::VPC::InternetGateway. create_subnet($cidr_block) -- Create a subnet with the indicated CIDR block and return the VM::EC2::VPC::Subnet object. create_internet_gateway() -- Create an internet gateway and immediately attach it to this VPC. If successful returns a VM::EC2::VPC::InternetGateway object. subnets() -- Return the list of subnets attached to this VPC as a list of VM::EC2::VPC::Subnet. route_tables() -- Return the list of route tables attached to this VPC as a list of VM::EC2::VPC::RouteTable. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the VPC ID. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use Carp 'croak'; sub valid_fields { my $self = shift; return qw(vpcId state cidrBlock dhcpOptionsId instanceTenancy); } sub refresh { my $self = shift; my $i = shift; local $self->aws->{raise_error} = 1; ($i) = $self->aws->describe_vpcs(-vpc_id=>$self->vpcId) unless $i; %$self = %$i; } sub current_state { my $self = shift; $self->refresh; $self->state; } sub current_status {shift->current_state(@_)} sub primary_id { shift->vpcId } sub dhcp_options { my $self = shift; return $self->aws->describe_dhcp_options($self->dhcpOptionsId); } sub set_dhcp_options { my $self = shift; my $options = shift || 'default'; return $self->aws->associate_dhcp_options($self => $options); } sub internet_gateways { my $self = shift; return $self->aws->describe_internet_gateways({'attachment.vpc-id'=>$self->vpcId}); } sub subnets { my $self = shift; return $self->aws->describe_subnets({'vpc-id'=>$self->vpcId}); } sub route_tables { my $self = shift; return $self->aws->describe_route_tables({'vpc-id'=>$self->vpcId}); } sub attach_internet_gateway { my $self = shift; my $gw = shift; return $self->aws->attach_internet_gateway($gw => $self->vpcId); } sub detach_internet_gateway { my $self = shift; my $gw = shift || ($self->internet_gateways)[0]; return $self->aws->detach_internet_gateway($gw=>$self->vpcId); } sub create_subnet { my $self = shift; my $cidr_block = shift or croak "usage: create_subnet(\$cidr_block)"; my $result = $self->aws->create_subnet(-vpc_id=>$self->vpcId, -cidr_block=>$cidr_block); $self->refresh if $result; return $result; } sub delete_internet_gateway { my $self = shift; my $gateway = shift || ($self->internet_gateways)[0]; $gateway or return; $self->detach_internet_gateway($gateway) or return; return $self->aws->delete_internet_gateway($gateway); } sub create_internet_gateway { my $self = shift; my $gateway = $self->aws->create_internet_gateway() or return; my $attach = $self->attach_internet_gateway($gateway); unless ($attach) { local $self->aws->{error}; # so that we get the error from the attach call $self->aws->delete_internet_gateway($gateway); return; } return $gateway; } 1; VM-EC2-1.23/lib/VM/EC2/ReservationSet.pm000444001751001751 325212100273360 17416 0ustar00lsteinlstein000000000000package VM::EC2::ReservationSet; =head1 NAME VM::EC2::Reservation - Object describing an instance reservation set =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @instances = $ec2->describe_instances(); for my $i (@instances) { $res = $i->reservationId; $req = $i->requesterId; $owner = $i->ownerId; @groups = $i->groups; } =head1 DESCRIPTION This object is used internally to manage the output of VM::EC2->describe_instances(). Because reservations are infrequently used, this object is not used directly; instead the reservation and requester IDs contained within it are stored in the VM::EC2::Instance objects returned by describe_instances(). =head1 METHODS One object method is supported: =head2 @instances = $reservation_set->instances() This will return the instances contained within the reservation set. =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::Instance::Set; use VM::EC2::Group; sub instances { my $self = shift; my $r = $self->payload->{reservationSet}{item} or return; return map {VM::EC2::Instance::Set->new($_,$self->aws,$self->xmlns,$self->requestId)->instances} @$r; } 1; VM-EC2-1.23/lib/VM/EC2/Volume.pm000444001751001751 2132612100273360 15732 0ustar00lsteinlstein000000000000package VM::EC2::Volume; =head1 NAME VM::EC2::Volume - Object describing an Amazon EBS volume =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @vol = $ec2->describe_volumes; for my $vol (@vols) { $id = $vol->volumeId; $size = $vol->size; $snap = $vol->snapshotId; $zone = $vol->availabilityZone; $status = $vol->status; $ctime = $vol->createTime; @attachments = $vol->attachments; $attachment = $vol->attachment; $origin = $vol->from_snapshot; @snapshots = $vol->to_snapshots; } $vols[0]->attach('i-12345','/dev/sdg1'); $vols[0]->deleteOnTermination('true'); $vols[0]->detach; $vols[0]->create_snapshot('automatic snapshot') =head1 DESCRIPTION This object is used to describe an Amazon EBS volume. It is returned by VM::EC2->describe_volumes(). =head1 METHODS The following object methods are supported: volumeId -- ID of this volume. size -- Size of this volume (in GB). snapshotId -- ID of snapshot this volume was created from. availabilityZone -- Availability zone in which this volume resides. status -- Volume state, one of "creating", "available", "in-use", "deleting", "deleted", "error" createTime -- Timestamp for when volume was created. volumeType -- The volume type, one of "standard" or "io1" iops -- The number of I/O operations per second that the volume supports, an integer between 100 and 2000. Only valid for volumes of type "io1". tags -- Hashref containing tags associated with this group. See L. In addition, this class provides several convenience functions: =head2 $attachment = $vol->attachment =head2 @attachments = $vol->attachments The attachment() method returns a VM::EC2::BlockDevice::Attachment object describing the attachment of this volume to an instance. If the volume is unused, then this returns undef. The attachments() method is similar, except that it returns a list of the attachments. Currently an EBS volume can only be attached to one instance at a time, but the Amazon call syntax supports multiple attachments and this method is provided for future compatibility. =head2 $attachment = $vol->attach($instance,$device) =head2 $attachment = $vol->attach(-instance_id=>$instance,-device=>$device) Attach this volume to an instance using virtual device $device. Both arguments are required. The result is a VM::EC2::BlockDevice::Attachment object which you can monitor by calling current_status(): my $a = $volume->attach('i-12345','/dev/sdg'); while ($a->current_status ne 'attached') { sleep 2; } print "volume is ready to go\n"; =head2 $attachment = $volume->detach() =head2 $attachment = $volume->detach(-instance_id=>$instance_id, -device=>$device, -force=>$force); Detaches this volume. With no arguments, will detach the volume from whatever instance it is currently attached to. Provide -instance_id and/or -device as a check that you are detaching the volume from the expected instance and device. Optional arguments: -instance_id -- ID of the instance to detach from. -device -- How the device is exposed to the instance. -force -- Force detachment, even if previous attempts were unsuccessful. The result is a VM::EC2::BlockDevice::Attachment object which you can monitor by calling current_status(): my $a = $volume->detach; while ($a->current_status ne 'detached') { sleep 2; } print "volume is ready to go\n"; =head2 $boolean = $vol->deleteOnTermination([$boolean]) Get or set the deleteOnTermination flag for attached volumes. If the volume is unattached, then this causes a fatal error. Called with no arguments, this method returns the current state of the deleteOnTermination flag for the volume's attachment. Called with a true/false argument, the method sets the flag by calling modify_instance_attributes() on the corresponding instance and returns true if successful. =head2 $snap = $vol->from_snapshot Returns the VM::EC2::Snapshot object that this volume was originally derived from. It will return undef if the resource no longer exists, or if the volume was created from scratch. =head2 @snap = $vol->to_snapshots If this volume has been used to create one or more snapshots, this method will return them as a list of VM::EC2::Snapshot objects. =head2 $snapshot = $vol->create_snapshot('Description') Create a snapshot of the volume and return a VM::EC2::Snapshot object. To ensure a consistent snapshot, you should unmount the volume before snapshotting it. The optional argument allows you to add a description to the snapshot. Here is an example: $s = $volume->create_snapshot("Backed up at ".localtime); while ($s->current_status eq 'pending') { print "Progress: ",$s->progress,"% done\n"; } print "Snapshot status: ",$s->current_status,"\n"; =head2 $status = $vol->current_status This returns the up-to-date status of the volume. It works by calling refresh() and then returning status(). =head2 $boolean = $vol->auto_enable_io([$new_boolean]) Get or set the auto-enable IO flag. =head2 $boolean = $vol->enable_volume_io() Enable volume I/O after it has been disabled by an Amazon health check. If successful, the call will return true. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the volumeId. =head1 SEE ALSO L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::BlockDevice::Attachment; use VM::EC2::ProductCode; use Carp 'croak'; sub valid_fields { my $self = shift; return qw(volumeId size snapshotId availabilityZone status createTime attachmentSet volumeType iops tagSet); } sub primary_id {shift->volumeId} sub attachment { my $self = shift; my $attachments = $self->attachmentSet or return; my $id = $attachments->{item}[0] or return; return VM::EC2::BlockDevice::Attachment->new($id,$self->aws) } sub attachments { my $self = shift; my $attachments = $self->attachmentSet or return; my $items = $self->attachmentSet->{item} or return; my @a = map {VM::EC2::BlockDevice::Attachment->new($_,$self->aws)} @$items; return @a; } sub deleteOnTermination { my $self = shift; $self->refresh; my $attachment = $self->attachment or croak "$self is not attached"; return $attachment->deleteOnTermination(@_); } sub from_snapshot { my $self = shift; my $sid = $self->snapshotId or return; return $self->aws->describe_snapshots(-filter=>{'snapshot-id' => $sid}); } sub to_snapshots { my $self = shift; return $self->aws->describe_snapshots(-filter=>{'volume-id' => $self->volumeId}); } sub create_snapshot { my $self = shift; my $description = shift; my @param = (-volume_id=>$self->volumeId); push @param,(-description=>$description) if defined $description; return $self->aws->create_snapshot(@param); } sub attach { my $self = shift; my %args; if (@_==2 && $_[0] !~ /^-/) { @args{'-instance_id','-device'} = @_; } else { %args = @_; } $args{-instance_id} && $args{-device} or croak "usage: \$vol->attach(\$instance_id,\$device)"; $args{-volume_id} = $self->volumeId; return $self->aws->attach_volume(%args); } sub detach { my $self = shift; return $self->aws->detach_volume(-volume_id=>$self->volumeId,@_); } sub current_status { my $self = shift; $self->refresh; $self->status; } sub refresh { my $self = shift; local $self->aws->{raise_error} = 1; my $v = $self->aws->describe_volumes($self->volumeId); %$self = %$v; } sub auto_enable_io { my $self = shift; return $self->aws->modify_volume_attribute($self, -auto_enable_io => shift) if @_; return $self->aws->describe_volume_attribute($self,'autoEnableIO'); } sub enable_io { my $self = shift; $self->aws->enable_volume_io($self); } sub product_codes { my $self = shift; my @codes = $self->aws->describe_volume_attribute($self,'productCodes'); return map {VM::EC2::ProductCode->new($_,$self->aws)} @codes; } 1; VM-EC2-1.23/lib/VM/EC2/Volume000755001751001751 012100273360 15213 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/Volume/Status.pm000444001751001751 341712100273360 17176 0ustar00lsteinlstein000000000000package VM::EC2::Volume::Status; =head1 NAME VM::EC2::Volume::Status - Object describing an volume/system status check =head1 SYNOPSIS @status_items = $ec2->describe_volume_status(); for my $i (@status_items) { print $i->volume_id,': ',$i->status,"\n"; if ($i->status ne 'ok') { print $i->status->details,"\n"; } } =head1 DESCRIPTION This object represents the result of a volume status check operation. =head1 METHODS The following methods are supported: status() -- The status, one of "ok", "impaired", "insufficient-data", or "not-applicable" details() -- A list of information about system volume health or application volume health. In a string context, this object interpolates with the status string. =head1 SEE ALSO L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::Volume::Status::Details; use strict; sub valid_fields { my $self = shift; return qw(status details); } sub details { my $self = shift; my $e = $self->SUPER::details or return; my @e = map { VM::EC2::Volume::Status::Details->new($_,$self->ec2)} @{$e->{item}}; return @e; } sub short_name {shift->status} 1; VM-EC2-1.23/lib/VM/EC2/Volume/StatusItem.pm000444001751001751 652312100273360 20016 0ustar00lsteinlstein000000000000package VM::EC2::Volume::StatusItem; =head1 NAME VM::EC2::Volume::StatusItem - Object describing a volume status event =head1 SYNOPSIS @status_items = $ec2->describe_volume_status(); for my $i (@status_items) { print $i->volume_id,': ',$i->status,"\n"; if (my $e = $i->events) { print $i->volume_id,' event = ',$e; } } =head1 DESCRIPTION This object represents an volume status returned by $ec2->describe_volume_status(). =head1 METHODS These object methods are supported: volumeId -- The ID of the affected volume. volume -- The VM::EC2::Volume object corresponding to the volume_id. availability_zone -- The availability zone of this volume. volumeStatus -- A VM::EC2::Volume::Status object indicating the status of the volume. status -- Shorter version of the above. actionsSet -- The list of actions that you might wish to take in response to this status, represented as VM::EC2::Volume::Status::Action objects. actions -- Shorter version of the above. eventsSet -- A list of VM::EC2::Volume::Status::Event objects which provide information about the nature and time of the event. events -- Shorter version of the above. NOTE: There are a number of inconsistencies in the AWS documentation for this data type. The event and action fields are described as being named eventSet and actionSet, but the XML example and practical experience show the fields being named eventsSet and actionsSet. The volumeStatus is documented as being a list, but practice shows that it is a single value only. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::Volume::Status; use VM::EC2::Volume::Status::Event; use VM::EC2::Volume::Status::Action; sub valid_fields { my $self = shift; return qw(volumeId availabilityZone volumeStatus eventsSet actionsSet); } sub volume { my $self = shift; return $self->ec2->describe_volumes($self->volumeId); } sub volumeStatus { my $self = shift; my $s = $self->SUPER::volumeStatus or return; return VM::EC2::Volume::Status->new($s,$self->ec2); } sub status { shift->volumeStatus } sub eventsSet { my $self = shift; my $e = $self->SUPER::eventsSet or return; return map {VM::EC2::Volume::Status::Event->new($_,$self->ec2)} @{$e->{item}}; } sub events { shift->eventsSet } sub actionsSet { my $self = shift; my $e = $self->SUPER::actionsSet or return; return map {VM::EC2::Volume::Status::Action->new($_,$self->ec2)} @{$e->{item}}; } sub actions { shift->actionsSet } sub short_name { my $self = shift; my $volume = $self->volumeId; my $status = ($self->status)[0]; return "$volume: $status"; } 1; VM-EC2-1.23/lib/VM/EC2/Volume/Status000755001751001751 012100273360 16476 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/Volume/Status/Action.pm000444001751001751 355012100273360 20411 0ustar00lsteinlstein000000000000package VM::EC2::Volume::Status::Action; =head1 NAME VM::EC2::Volume::Status::Action - Object describing a scheduled volume maintenance event =head1 SYNOPSIS @status_items = $ec2->describe_volume_status(); for my $i (@status_items) { for my $event ($i->events) { print $i->volume_id,': ', $event->code,' ', $event->type, ' ', $event->description,"\n"; } } =head1 DESCRIPTION This objects reflects the actions you may have to take in response to a volume event, as described at: http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeVolumeStatus.html =head1 METHODS code -- The code identifying the action. eventType -- The ID of the action. description -- A description of the action. type -- Alias for eventType id -- Alias for eventId When used in a string context, this object interpolates as a string using the action code. =head1 SEE ALSO L L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use strict; sub valid_fields { my $self = shift; return qw(code eventType eventId description); } sub type {shift->eventType} sub id {shift->eventId} sub short_name { my $self = shift; return $self->code; } 1; VM-EC2-1.23/lib/VM/EC2/Volume/Status/Details.pm000444001751001751 351612100273360 20563 0ustar00lsteinlstein000000000000package VM::EC2::Volume::Status::Details; =head1 NAME VM::EC2::Volume::Status::Details - Object describing the details of an volume status check =head1 SYNOPSIS @status_items = $ec2->describe_volume_status(); for my $i (@status_items) { print $i->volume_id,': ',$i->status,"\n"; if ($i->volume ne 'ok') { my @details = $i->volume_status->details; for my $d (@details) { print $d->name,"\n"; print $d->status,"\n"; } } } =head1 DESCRIPTION This object represents additional details about a failed system or volume status check. =head1 METHODS These methods are supported: name() -- The type of volume status detail, such as "reachability". status() -- The status of the check, "passed", "failed" or "insufficient-data". impaired_since() -- The time when a status check failed as a DateTime string. In a string context, this object interpolates as the name(). =head1 SEE ALSO L L L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use strict; sub valid_fields { my $self = shift; return qw(name status); } sub short_name { my $self = shift; my $status = $self->status; my $name = $self->name; return "$name $status"; } 1; VM-EC2-1.23/lib/VM/EC2/Volume/Status/Event.pm000444001751001751 453512100273360 20261 0ustar00lsteinlstein000000000000package VM::EC2::Volume::Status::Event; =head1 NAME VM::EC2::Volume::Status::Event - Object describing a scheduled volume maintenance event =head1 SYNOPSIS @status_items = $ec2->describe_volume_status(); for my $i (@status_items) { for my $event ($i->events) { print $i->volume_id,': ', $event->type,' ', $event->description, ' ', $event->notBefore, ' ', $event->notAfter,"\n"; } } =head1 DESCRIPTION This objects describes a scheduled maintenance event on an volume, and is returned by calling the events() method of one of the status item objects returned by $ec2->describe_volume_status(). NOTE: There is an inconsistency in the AWS documentation for this data type. The events field is documented as being a list, but the examples shown show a single object. At release time, I was unable to verify which is correct and have written the code such that it will detect a single value in the response object and return this as a single-element list. =head1 METHODS eventType -- The type of event eventId -- The ID of the event description -- A description of the event. notBefore -- The earliest scheduled start time for the event. notAfter -- The latest scheduled end time for the event. type -- Alias for eventType id -- Alias for eventId When used in a string context, this object interpolates as a string using the eventType. =head1 SEE ALSO L L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use strict; sub valid_fields { my $self = shift; return qw(eventType eventId description notBefore notAfter); } sub type {shift->eventType} sub id {shift->eventId} sub short_name { my $self = shift; return $self->eventType; } 1; VM-EC2-1.23/lib/VM/EC2/Instance000755001751001751 012100273360 15510 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/Instance/Placement.pm000444001751001751 275412100273360 20123 0ustar00lsteinlstein000000000000package VM::EC2::Instance::Placement; =head1 NAME VM::EC2::Instance::Placement - Object describing an Amazon EC2 instance's placement =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); =head1 DESCRIPTION This object represents the placement of an instance in an Amazon EC2 availability region and cluster group. It is returned by VM::EC2->describe_instances =head1 METHODS These object methods are supported: availabilityZone -- The availability zone of the instance. groupName -- The name of the placement group in a cluster computing instance. tenancy -- Tenancy of the instance, e.g. "dedicated". =head1 STRING OVERLOADING When used in a string context, this object will interpolate the availabilityZone. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use overload '""' => sub {shift()->availabilityZone}, fallback => 1; sub valid_fields { my $self = shift; return qw(availabilityZone groupName tenancy); } 1; VM-EC2-1.23/lib/VM/EC2/Instance/PasswordData.pm000444001751001751 331712100273360 20603 0ustar00lsteinlstein000000000000package VM::EC2::Instance::PasswordData; =head1 NAME VM::EC2::PasswordData - Object describing the administrative password stored in an EC2 Windows instance =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $instance = $ec2->describe_instances(-instance_id=>'i-12345'); $pass = $instance->password_data; print $pass->password,"\n"; print $pass->timestamp,"\n" =head1 DESCRIPTION This object represents the administrative password stored in a Windows EC2 instance. It is returned by calling either VM::EC2->get_password_data or a VM::EC2::Instance object's password_data() method. =head1 METHODS These object methods are supported: instanceId -- ID of the instance timestamp -- The time the data was last updated. passwordData -- The password of the instance. password() -- Same as passwordData(). =head1 STRING OVERLOADING When used in a string context, this object will interpolate the password. =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use overload '""' => 'password', fallback => 1; sub valid_fields { my $self = shift; return $self->SUPER::valid_fields, qw(requestId instanceId timestamp passwordData); } sub password {shift->passwordData} 1; VM-EC2-1.23/lib/VM/EC2/Instance/ConsoleOutput.pm000444001751001751 400512100273360 21025 0ustar00lsteinlstein000000000000package VM::EC2::Instance::ConsoleOutput; =head1 NAME VM::EC2::ConsoleOutput - Object describing console output from an Amazon EC2 instance =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $instance = $ec2->describe_instance(-instance_id=>'i-123456'); my $out = $instance->console_output; print $out,"\n"; my $ts = $out->timestamp; my $instance = $out->instanceId; =head1 DESCRIPTION This object represents the output from the console of a Amazon EC2 instance. The instance may be running, pending or stopped. It is returned by VM::EC2->get_console_output(), as well as VM::EC2::Instance->console_output. Please see L for methods shared by all VM::EC2 objects. =head1 METHODS These object methods are supported: requestId -- ID of the request that generated this object instanceId -- ID of the instance that generated this output timestamp -- Time that this output was generated output -- Text of the console output =head1 STRING OVERLOADING When used in a string context, this object will act as if its output() method was called, allowing it to be printed or searched directly. =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use MIME::Base64; use overload '""' => 'output', fallback => 1; sub valid_fields { my $self = shift; return $self->SUPER::valid_fields, qw(requestId instanceId timestamp output); } sub output { my $self = shift; my $out = $self->SUPER::output; return decode_base64($out); } 1; VM-EC2-1.23/lib/VM/EC2/Instance/MonitoringState.pm000444001751001751 420112100273360 21326 0ustar00lsteinlstein000000000000package VM::EC2::Instance::MonitoringState; =head1 NAME VM::EC2::MonitoringState - Object describing the monitoring state of an EC2 instance =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $monitor = $ec2->monitor_instances('i-12345'); $instance = $monitor->instanceId; $monitoring = $monitor->monitoring; $monitor->enable; $monitor->disable; =head1 DESCRIPTION This object represents the monitoring state of an Amazon EC2 instance. =head1 METHODS These object methods are supported: instanceId -- The instance that is being reported monitoring -- The monitoring state: one of "disabled", "enabled", "pending" To turn monitoring of an instance on, call: $monitor->enable(); to unmonitor an instance, call: $monitor>disable(); It is probably easier to control this using the Instance object's monitoring() method. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the string "$instanceId monitoring is $monitoring". =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use overload '""' => sub { my $self = shift; my $instance = $self->instanceId; my $monitoring = $self->monitoring; return "$instance monitoring is $monitoring"; }, fallback => 1; sub valid_fields { return qw(instanceId monitoring); } sub monitoring { my $self = shift; my $m = $self->SUPER::monitoring; return $m->{state}; } sub enable { my $self = shift; return $self->aws->monitor_instances($self->instanceId); } sub disable { my $self = shift; return $self->aws->unmonitor_instances($self->instanceId); } 1; VM-EC2-1.23/lib/VM/EC2/Instance/Status.pm000444001751001751 363012100273360 17470 0ustar00lsteinlstein000000000000package VM::EC2::Instance::Status; =head1 NAME VM::EC2::Instance::Status - Object describing an instance/system status check =head1 SYNOPSIS @status_items = $ec2->describe_instance_status(); for my $i (@status_items) { print $i->instance_id, ': instance check=',$i->instance_status, ', system check=',$i->system_status,"\n"; if ($i->instance_status ne 'ok') { print $i->instance_status->details,"\n"; } } =head1 DESCRIPTION This object represents the result of a system or instance status check operation. =head1 METHODS The following methods are supported: status() -- The status, one of "ok", "impaired", "insufficient-data", or "not-applicable" details() -- A list of information about system instance health or application instance health. In a string context, this object interpolates with the status string. =head1 SEE ALSO L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::Instance::Status::Details; use strict; sub valid_fields { my $self = shift; return qw(status details); } sub details { my $self = shift; my $e = $self->SUPER::details or return; my @e = map { VM::EC2::Instance::Status::Details->new($_,$self->ec2)} @{$e->{item}}; return @e; } sub short_name {shift->status} 1; VM-EC2-1.23/lib/VM/EC2/Instance/Set.pm000444001751001751 441112100273360 16736 0ustar00lsteinlstein000000000000package VM::EC2::Instance::Set; =head1 NAME VM::EC2::Instance::Set - Object describing a set of instances =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @instances = $ec2->run_instances(-image_id=>'ami-12345'); for my $i (@instances) { $res = $i->reservationId; $req = $i->requesterId; $owner = $i->ownerId; @groups = $i->groups; } =head1 DESCRIPTION This object is used internally to manage the output of VM::EC2->run_instances(), which returns information about the reservation and security groups as well as the list of launched instances. Because reservations are infrequently used, this object is not used directly; instead the reservation and requester IDs contained within it are stored in the VM::EC2::Instance objects returned by run_instances(). =head1 METHODS One object method is supported: =head2 @instances = $reservation_set->instances() This will return the instances contained within the instance set. =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::Instance; use VM::EC2::Group; sub instances { my $self = shift; my $p = $self->payload; my $reservation_id = $p->{reservationId}; my $owner_id = $p->{ownerId}; my $requester_id = $p->{requesterId}; my @groups = map {VM::EC2::Group->new($_,$self->aws, $self->xmlns,$self->requestId)} @{$p->{groupSet}{item}}; my $instances = $p->{instancesSet}{item}; return map {VM::EC2::Instance->new( -instance => $_, -aws => $self->aws, -xmlns => $self->xmlns, -requestId => $self->requestId, -reservation => $reservation_id, -requester => $requester_id, -owner => $owner_id, -groups => \@groups) } @$instances; } 1; VM-EC2-1.23/lib/VM/EC2/Instance/IamProfile.pm000444001751001751 264112100273360 20235 0ustar00lsteinlstein000000000000package VM::EC2::Instance::IamProfile; =head1 NAME VM::EC2::Instance::IamProfile - Object describing an Amazon EC2 Identity Access Management profile =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); my $instance = $ec2->describe_instances('i-123456'); my $profile = $instance->iamInstanceProfile; print $profile->arn,"\n"; print $profile->id,"\n"; =head1 DESCRIPTION This object represents an Amazon IAM profile associated with an instance. =head1 METHODS These object methods are supported: arn The Amazon resource name (ARN) of the IAM Instance Profile (IIP) associated with the instance. id The ID of the IIP associated with the instance. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the arn. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub short_name {shift->arn}; sub valid_fields { my $self = shift; return qw(arn id); } 1; VM-EC2-1.23/lib/VM/EC2/Instance/StatusItem.pm000444001751001751 755112100273360 20315 0ustar00lsteinlstein000000000000package VM::EC2::Instance::StatusItem; =head1 NAME VM::EC2::Instance::StatusItem - Object describing a instance status event =head1 SYNOPSIS @status_items = $ec2->describe_instance_status(); for my $i (@status_items) { print $i->instance_id, ': instance check=',$i->instance_status, ', system check=',$i->system_status,"\n"; if (my $e = $i->events) { print $i->instance_id,' event = ',$e; } } =head1 DESCRIPTION This object represents an instance status returned by $ec2->describe_instance_status(). =head1 METHODS These object methods are supported: instanceId -- The ID of the affected instance. instance -- The VM::EC2::Instance object availabilityZone -- The availability zone of this instance. events -- A list of VM::EC2::Instance::Status::Event objects representing a scheduled maintenance events on this instance (see note). instanceState -- The state of this instance (e.g. "running") systemStatus -- A VM::EC2::Instance::Status object indicating the status of the system check. instanceStatus -- A VM::EC2::Instance::Status object indicating the status of the instance availability check. NOTE: There is an inconsistency in the AWS documentation for this data type. The events field is documented as being a list, but the examples shown return a single object. At release time, I was unable to verify which is correct and have written the code such that it will always return a list, which may be single elementin length. In a string context, this object will interpolate as: "$instanceId: XX/2 tests passed" where XX is the number of checks that passed. In the case of an instance that is not running, the interpolation will be: "$instanceId: $state" Where $state is the state of the instance (e.g. "stopped"). =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::Instance::State; use VM::EC2::Instance::Status; use VM::EC2::Instance::Status::Event; sub valid_fields { my $self = shift; return qw(instanceId availabilityZone eventsSet instanceState systemStatus instanceStatus); } sub events { my $self = shift; my $e = $self->eventsSet or return; if (ref $e && $e->{item}) { return map {VM::EC2::Instance::Status::Event->new($_,$self->ec2)} @{$e->{item}}; } else { return VM::EC2::Instance::Status::Event->new($e,$self->ec2); } } sub instance { my $self = shift; return $self->ec2->describe_instances($self->instanceId); } sub instanceState { my $self = shift; my $s = $self->SUPER::instanceState or return; return VM::EC2::Instance::State->new($s,$self->ec2); } sub systemStatus { my $self = shift; my $s = $self->SUPER::systemStatus or return; return VM::EC2::Instance::Status->new($s,$self->ec2); } sub instanceStatus { my $self = shift; my $s = $self->SUPER::systemStatus or return; return VM::EC2::Instance::Status->new($s,$self->ec2); } sub short_name { my $self = shift; my $instance = $self->instanceId; my $passed = grep {$_ eq 'ok'} ($self->instanceStatus,$self->systemStatus); my $state = $self->instance_state; return $state eq 'running' ? "$instance: $passed/2 checks passed" : "$instance: $state"; } 1; VM-EC2-1.23/lib/VM/EC2/Instance/State.pm000444001751001751 421012100273360 17260 0ustar00lsteinlstein000000000000package VM::EC2::Instance::State; =head1 NAME VM::EC2::State - Object describing the state of an EC2 instance =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $instance = $ec2->describe_instances(-instance_id=>'i-12345'); $state = $instance->state; $code = $state->code; $name = $state->name; =head1 DESCRIPTION This object represents the state of an Amazon EC2 instance. It is returned by calling the state() method of an VM::EC2::Instance, and is also returned by VM::EC2->start_instances(), stop_instances() and terminate_instances(). =head1 METHODS These object methods are supported: code -- The state code name -- The state name Code Name ---- ------- 0 pending 16 running 32 shutting-down 48 terminated 64 stopping 80 stopped 272 Code 272 is said to correspond to a problem with the instance host. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the name. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use overload '""' => 'name', fallback => 1; sub new { my $self = shift; my $state = shift; return bless \$state,ref $self || $self; } sub code { ${shift()}->{code} } sub name { ${shift()}->{name} } sub invalid_state { my $self = shift; my $aws = shift; return $self->new({code=>undef,name=>'invalid'},$aws); } 1; VM-EC2-1.23/lib/VM/EC2/Instance/Metadata.pm000444001751001751 3305312100273360 17747 0ustar00lsteinlstein000000000000package VM::EC2::Instance::Metadata; =head1 NAME VM::EC2::Instance::Metadata - Object describing the metadata of a running instance =head1 SYNOPSIS # For use within a running EC2 instance only! use VM::EC2::Instance::Metadata; my $meta = VM::EC2::Instance::Metadata->new; # alternatively... my $meta = VM::EC2->instance_metadata; my $meta = $instance->metadata; # image information $image_id = $meta->imageId; $index = $meta->imageLaunchIndex; $path = $meta->amiManifestPath; $location = $meta->imageLocation; # same as previous @ancestors = $meta->ancestorAmiIds; @ancestors = $meta->imageAncestorIds; # same as previous @codes = $meta->productCodes; # launch and runtime information $inst_id = $meta->instanceId; $kern_id = $meta->kernelId; $rd_id = $meta->ramdiskId; $res_id = $meta->reservationId; $type = $meta->instanceType; $zone = $meta->availabilityZone; $userdata = $meta->userData; @groups = $meta->securityGroups; @keys = $meta->publicKeys; $block_dev = $meta->blockDeviceMapping; # a hashref # Network information $priv_name = $meta->localHostname; $priv_name = $meta->privateDnsName; # same as previous $priv_ip = $meta->localIpv4; $priv_ip = $meta->privateIpAddress; $mac = $meta->mac; $pub_name = $meta->publicHostname; $pub_name = $meta->dnsName; # same as previous $pub_ip = $meta->publicIpv4; $pub_ip = $meta->ipAddress; $interfaces= $meta->interfaces; # a hashref # IAM information $iam_info = $metadata->iam_info; # a hashref $iam_role = $metadata->iam_role; # name of the role $credentials= $metadata->iam_credentials; # VM::EC2::Security::Credentials object # Undocumented fields $action = $meta->instanceAction; $profile = $meta->profile; =head1 DESCRIPTION This is an interface to the metadata that is provided to a running instance via the http://169.254.169.254/latest URL, as described in http://docs.amazonwebservices.com/AWSEC2/latest/UserGuide/index.html?instancedata-data-categories.html. Each metadata object caches its values, so there is no overhead in calling a method repeatedly. Methods return scalar values, lists and hashrefs as appropriate. The methods from this class should only be called within the context of a running EC2 instance. Attempts to call outside of this context will result in long delays as the module attempts to connect to an invalid hostname. =head1 METHODS =head2 $meta = VM::EC2::Instance::Metadata->new() =head2 $meta = $ec2->instance_metadata() =head2 $meta = $instance->metadata() You can create a new metadata object either using this class's new() constructor, or by calling an VM::EC2 object's instance_metadata() method, or by calling a VM::EC2::Instance object's metadata () method. =head2 Methods that return scalar values The following methods all return single-valued results: =over 4 =item Image information: imageId -- ID of AMI used to launch this instance imageLaunchIndex -- This index's launch index. If four instances were launched by one $image->run_instances() call, they will be numbered from 0 to 3. amiManifestPath -- S3 path to the image imageLocation -- Same as amiManifestPath(), for consistency with VM::EC2::Image =item Launch and runtime information: instanceId -- ID of this instance kernelId -- ID of this instance's kernel. ramdiskId -- This instance's ramdisk ID reservationId -- This instance's reservation ID instanceType -- Machine type, e.g. "m1.small" availabilityZone -- This instance's availability zone. region -- This instance's region. endpoint -- This instance's endpoint. userData -- User data passed at launch time. =item Network information: localHostname -- The instance hostname corresponding to its internal EC2 IP address. privateDnsName -- Same as localHostname(), for consistency with VM::EC2::Instance localIpv4 -- The instance IP address on the internal EC2 network. privateIpAddress -- Same as localIpv4(), for consistency with VM::EC2::Instance. mac -- This instance's MAC (ethernet) address. publicHostname -- This instance's public hostname. dnsName -- Same as publicHostname() for consistency with VM::EC2::Instance. publicIpv4 -- This instance's public IP address. ipAddress -- Same as publicIpv4() for consistency with VM::EC2::Instance. =item IAM information These routines return information about the instance's IAM role, if any. These calls also provide a temporary security credentials for making EC2 calls, as described here: http://docs.amazonwebservices.com/AWSEC2/latest/UserGuide/UsingIAM.html. Note that these routines require installation of the perl JSON module, and will cause a fatal error if this module cannot be loaded. iam_info -- Returns a hash containing the fields 'LastUpdated', 'InstanceProfileArn', and 'InstanceProfileId'. These provide information about the instance's IAM role. iam_role -- Returns the IAM role name for the currently running instance. iam_credentials -- Returns a VM::EC2::Security::Credentials object that can be passed to VM::EC2->new(-security_token=>$credentials). =item Unknown information: profile -- An undocumented field that contains the virtualization type in the form "default-paravirtual". instanceAction -- Undocumented metadata field named "instance-action" =back =head2 Methods that return lists The following methods all return lists. =over 4 =item Image information ancestorAmiIds -- List of AMIs from which the current one was derived imageAncestorIds -- Same as ancestorAmiIds() but easier to read. productCodes -- List of product codes applying to the image from which this instance was launched. =item Launch and runtime information securityGroups -- List of security groups to which this instance is assigned. For non-VPC instances, this will be the security group name. For VPC instances, this will be the security group ID. publicKeys -- List of public key pair names attached to this instance. =back =head2 Methods that return a hashref The following methods return a hashref for representing complex data structures: =over 4 =item $devices = $meta->blockDeviceMapping This returns a hashref in which the keys are the names of instance block devices, such as "/dev/sda1", and the values are the EC2 virtual machine names. For example: x $meta->blockDeviceMapping 0 HASH(0x9b4f2f8) '/dev/sda1' => 'root' '/dev/sda2' => 'ephemeral0' '/dev/sdg' => 'ebs1' '/dev/sdh' => 'ebs9' '/dev/sdi' => 'ebs10' 'sda3' => 'swap' For reasons that are not entirely clear, the swap device is reported as "sda3" rather than as "/dev/sda3". =item $interfaces = $meta->interfaces Returns a mapping of all virtual ethernet devices owned by this instance. This is primarily useful for VPC instances, which can have more than one device. The hash keys are the MAC addresses of each ethernet device, and the values are hashes that have the following keys: mac localHostname localIpv4s (an array ref) publicIpv4s (an array ref) securityGroupIds (an array ref) subnetId subnetIpv4CidrBlock vpcId vpcIpv4CidrBlock For example: D x $meta->interfaces 0 HASH(0x9b4f518) '12:31:38:01:b8:97' => HASH(0x9eaa090) 'localHostname' => 'domU-12-31-38-01-B8-97.compute-1.internal' 'localIpv4s' => ARRAY(0x9b4f8a8) 0 '10.253.191.101' 'mac' => '12:31:38:01:b8:97' 'publicIpv4s' => ARRAY(0x9ea9e40) 0 '184.73.241.210' 'securityGroupIds' => ARRAY(0x9eaa490) empty array 'subnetId' => undef 'subnetIpv4CidrBlock' => undef 'vpcId' => undef 'vpcIpv4CidrBlock' => undef =back =head1 SEE ALSO L L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use LWP::UserAgent; use URI::Escape 'uri_unescape'; use Carp 'croak'; use constant TIMEOUT => 5; # seconds my $global_cache = {}; sub new { my $pack = shift; return bless { cache => {} },ref $pack || $pack; } sub imageId { shift->fetch('ami-id') } sub imageLaunchIndex { shift->fetch('ami-launch-index') } sub amiManifestPath { shift->fetch('ami-manifest-path')} sub imageLocation { shift->amiManifestPath } sub ancestorAmiIds { split /\s+/,shift->fetch('ancestor-ami-ids') } sub imageAncestorIds { shift->ancestorAmiIds } sub instanceAction { shift->fetch('instance-action') } sub instanceId { shift->fetch('instance-id') } sub instanceType { shift->fetch('instance-type') } sub localHostname { shift->fetch('local-hostname') } sub privateDnsName { shift->localHostname } sub localIpv4 { shift->fetch('local-ipv4') } sub privateIpAddress { shift->localIpv4 } sub kernelId { shift->fetch('kernel-id') } sub mac { shift->fetch('mac') } sub availabilityZone { shift->fetch('placement/availability-zone') } sub region { my $r = shift->availabilityZone; $r =~ s/[a-z]$//; return $r; } sub endpoint { 'http://ec2.'.shift->region.'.amazonaws.com'} sub productCodes { split /\s+/,shift->fetch('product-codes') } sub publicHostname { shift->fetch('public-hostname') } sub dnsName { shift->publicHostname } sub publicIpv4 { shift->fetch('public-ipv4') } sub ipAddress { shift->publicIpv4 } sub ramdiskId { shift->fetch('ramdisk-id') } sub reservationId { shift->fetch('reservation-id') } sub securityGroups { split /\s+/,shift->fetch('security-groups') } sub profile { shift->fetch('profile') } sub userData { shift->fetch('../user-data') } sub blockDeviceMapping { my $self = shift; my @devices = split /\s+/,$self->fetch('block-device-mapping'); my %map = map {$self->fetch("block-device-mapping/$_") => $_} @devices; return \%map; } sub interfaces { my $self = shift; my @macs = split /\s+/,$self->fetch('network/interfaces/macs'); my %result; for my $m (@macs) { $m =~ s/\/$//; # get rid of hanging slash for my $pair ([localHostname => 'local-hostname'], [localIpv4s => 'local-ipv4s'], [mac => 'mac'], [publicIpv4s => 'public-ipv4s'], [securityGroupIds => 'security-groupids'], [subnetId => 'subnet-id'], [subnetIpv4CidrBlock => 'subnet-ipv4-cidr-block'], [vpcId => 'vpc-id'], [vpcIpv4CidrBlock => 'vpc-ipv4-cidr-block']) { my ($tag,$attribute) = @$pair; my $value = $self->fetch("network/interfaces/macs/$m/$attribute"); my @value = split /\s+/,$value; $result{$m}{$tag} = $attribute =~ /s$/ ? \@value : $value; } } return \%result; } sub publicKeys { my $self = shift; my @keys = split /\s+/,$self->fetch('public-keys'); return map {/^\d+=(.+)/ && $1} @keys; } sub iam_info { my $self = shift; $self->_load_json; return JSON::from_json($self->fetch('iam/info')); } sub iam_role { my $self = shift; return $self->fetch('iam/security-credentials'); } sub iam_credentials { my $self = shift; my $role = $self->iam_role or return; my $data = $self->fetch("iam/security-credentials/$role") or return; eval "require VM::EC2::Security::Credentials" unless VM::EC2::Security::Credentials->can('new_from_json'); return VM::EC2::Security::Credentials->new_from_json($data,$self->endpoint); } sub _load_json { return if JSON->can('decode'); eval "require JSON; 1" or croak "no JSON module installed: $@"; } sub fetch { my $self = shift; my $attribute = shift or croak "Usage: VM::EC2::Instance::Metadata->get('attribute')"; my $cache = $self->{cache} || $global_cache; # protect against class invocation return $cache->{$attribute} if exists $cache->{$attribute}; my $ua = $self->{ua} ||= LWP::UserAgent->new(); $ua->timeout(TIMEOUT); my $response = $ua->get("http://169.254.169.254/latest/meta-data/$attribute"); if ($response->is_success) { return $cache->{$attribute} = uri_unescape($response->decoded_content); # don't know why, but URI escapes used here. } else { print STDERR $response->status_line,"\n" unless $response->code == 404; return; } } 1; VM-EC2-1.23/lib/VM/EC2/Instance/Status000755001751001751 012100273360 16773 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/Instance/Status/Details.pm000444001751001751 415412100273360 21057 0ustar00lsteinlstein000000000000package VM::EC2::Instance::Status::Details; =head1 NAME VM::EC2::Instance::Status::Details - Object describing the details of an instance status check =head1 SYNOPSIS @status_items = $ec2->describe_instance_status(); for my $i (@status_items) { print $i->instance_id, ': instance check=',$i->instance_status, ', system check=',$i->system_status,"\n"; if ($i->instance_status ne 'ok') { my @details = $i->instance_status->details; for my $d (@details) { print $d->name,"\n"; print $d->status,"\n"; print $d->impaired_since,"\n"; } } } =head1 DESCRIPTION This object represents additional details about a failed system or instance status check. =head1 METHODS These methods are supported: name() -- The type of instance status detail, such as "reachability". status() -- The status of the check, "passed", "failed" or "insufficient-data". impaired_since() -- The time when a status check failed as a DateTime string. In a string context, this object interpolates as the name(). =head1 SEE ALSO L L L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use strict; sub valid_fields { my $self = shift; return qw(name status impairedSince); } sub short_name { my $self = shift; my $status = $self->status; my $name = $self->name; my $since = $self->impairedSince; if ($since) { return "$name $status since $since"; } else { return "$name $status"; } } 1; VM-EC2-1.23/lib/VM/EC2/Instance/Status/Event.pm000444001751001751 463712100273360 20561 0ustar00lsteinlstein000000000000package VM::EC2::Instance::Status::Event; =head1 NAME VM::EC2::Instance::Status::Event - Object describing a scheduled instance maintenance event =head1 SYNOPSIS @status_items = $ec2->describe_instance_status(); for my $i (@status_items) { for my $event ($i->events) { print $i->instance_id,': ', $event->code,' ', $event->description, ' ', $event->notBefore, ' ', $event->notAfter,"\n"; } } =head1 DESCRIPTION This objects describes a scheduled maintenance event on an instance, and is returned by calling the events() method of one of the status item objects returned by $ec2->describe_instance_status(). NOTE: There is an inconsistency in the AWS documentation for this data type. The events field is documented as being a list, but the examples shown show a single object. At release time, I was unable to verify which is correct and have written the code such that it will detect a single value in the response object and return this as a single-element list. =head1 METHODS code() -- The code for this event, one of "instance-reboot", "system-reboot", "instance-retirement" description() -- A description of the event. notBefore() -- The earliest scheduled start time for the event. notAfter() -- The latest scheduled end time for the event. When used in a string context, this object interpolates as a string in the form: system-reboot [2011-12-05T13:00:00+0000 - 2011-12-06T13:00:00+000] =head1 SEE ALSO L L L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use strict; sub valid_fields { my $self = shift; return qw(code description notBefore notAfter); } sub short_name { my $self = shift; return $self->code . '['.$self->notBefore.' - '.$self->notAfter.']';; } 1; VM-EC2-1.23/lib/VM/EC2/Instance/State000755001751001751 012100273360 16570 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/Instance/State/Change.pm000444001751001751 624212100273360 20454 0ustar00lsteinlstein000000000000package VM::EC2::Instance::State::Change; =head1 NAME VM::EC2::Instance::State::Change - Represent an EC2 instance's change in state. =head1 SYNOPSIS # find all stopped instances @instances = $ec2->describe_instances(-filter=>{'instance-state-name'=>'stopped'}); # start them @state_change = $ec2->start_instances(@instances) foreach my $sc (@state_change) { my $instanceId = $sc->instanceId; my $currentState = $sc->currentState; my $previousState = $sc->previousState; } # poll till the first instance is running sleep 2 until $state_change[0]->current_status eq 'running'; =head1 DESCRIPTION This object represents a state change in an Amazon EC2 instance. It is returned by VM::EC2 start_instances(), stop_instances(), terminate_instances(), reboot_instances() and the corresponding VM::EC2::Instance methods. In addition, this object is returned by calls to VM::EC2::Instance->instanceState(). =head1 METHODS These object methods are supported: instanceId -- The instanceId. currentState -- The instanceId's current state AT THE TIME THE STATECHANGE OBJECT WAS CREATED. One of "terminated", "running", "stopped", "stopping", "shutting-down". previousState -- The instanceID's previous state AT THE TIME THE STATECHANGE OBJECT WAS CREATED. Note that currentState and previousState return a VM::EC2::Instance::State object, which provides both string-readable forms and numeric codes representing the state. In addition, the method provides the following convenience method: =head2 $state = $state_change->current_status() This method returns the current state of the instance. This is the correct method to call if you are interested in knowing what the instance is doing right now. =head2 STRING OVERLOADING In a string context, the method will return the string representation of currentState. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use Carp 'croak'; use VM::EC2::Instance::State; use overload '""' => sub {shift()->currentState}, fallback => 1; sub valid_fields { my $self = shift; return qw(instanceId currentState previousState); } sub currentState { return VM::EC2::Instance::State->new(shift->SUPER::currentState); } sub previousState { return VM::EC2::Instance::State->new(shift->SUPER::previousState); } sub current_status { my $self = shift; my $ec2 = $self->aws; my $id = $self->instanceId; my ($instance) = $ec2->describe_instances(-instance_id=>$id); $instance or croak "invalid instance: $id"; return $instance->instanceState; } 1; VM-EC2-1.23/lib/VM/EC2/Instance/State/Reason.pm000444001751001751 556612100273360 20526 0ustar00lsteinlstein000000000000package VM::EC2::State::Reason; =head1 NAME VM::EC2::State::Reason - Object describing the reason for an EC2 instance state change =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $instance = $ec2->describe_instances(-instance_id=>'i-12345'); $reason = $instance->reason; $code = $reason->code; $message = $reason->message; =head1 DESCRIPTION This object represents the reason that an Amazon EC2 instance underwent a state change. It is returned by calling the reason() method of VM::EC2::Instance. =head1 METHODS These object methods are supported: code -- The state change reason code. message -- The state change reason method. The following table lists the codes and messages (source: http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/ApiReference-ItemType-StateReasonType.html): Code Message ---- ------- Server.SpotInstanceTermination A Spot Instance was terminated due to an increase in the market price. Server.InternalError An internal error occurred during instance launch, resulting in termination. Server.InsufficientInstanceCapacity There was insufficient instance capacity to satisfy the launch request. Client.InternalError A client error caused the instance to terminate on launch. Client.InstanceInitiatedShutdown The instance initiated shutdown by a shutdown -h command issued from inside the instance. Client.UserInitiatedShutdown The instance was shutdown by a user via an API call. Client.VolumeLimitExceeded The volume limit was exceeded. Client.InvalidSnapshot.NotFound The specified snapshot was not found. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the message. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use overload '""' => 'message', fallback => 1; sub new { my $self = shift; my $state = shift; return bless \$state,ref $self || $self; } sub code { ${shift()}->{code} } sub message { ${shift()}->{message} } 1; VM-EC2-1.23/lib/VM/EC2/NetworkInterface000755001751001751 012100273360 17216 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/NetworkInterface/PrivateIpAddress.pm000444001751001751 275312100273360 23131 0ustar00lsteinlstein000000000000package VM::EC2::NetworkInterface::PrivateIpAddress; =head1 NAME VM::EC2::NetworkInterface::PrivateIpAddress =head1 SYNOPSIS use VM::EC2; ... =head1 DESCRIPTION Please see L for methods shared by all VM::EC2 objects. =head1 METHODS These object methods are supported: privateIpAddress primary association In addition, this object supports the following convenience methods: =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the VPC ID. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::NetworkInterface::Association; sub valid_fields { my $self = shift; return qw(privateIpAddress primary association); } sub primary { my $self = shift; my $p = $self->SUPER::primary; return $p eq 'true'; } sub short_name { shift->privateIpAddress } sub association { my $self = shift; my $ass = $self->SUPER::association; return VM::EC2::NetworkInterface::Association->new($ass,$self->ec2); } 1; VM-EC2-1.23/lib/VM/EC2/NetworkInterface/Association.pm000444001751001751 361012100273360 22165 0ustar00lsteinlstein000000000000package VM::EC2::NetworkInterface::Association; =head1 NAME VM::EC2::NetworkInterface::Association -- Object representing an association of a network interface with an elastic public IP address =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $interface = $ec2->describe_network_interfaces('eni-12345'); my $association = $interface->association; my $id = $association->associationId; my $public_ip = $association->ipOwnerId; my $address = $association->address; =head1 DESCRIPTION This object provides access to an elastic address association object, which reversibly associates an elastic public IP address with an elastic network interface (ENI). Please see L for methods shared by all VM::EC2 objects. =head1 METHODS These object methods are supported: associationId publicIp ipOwnerId In addition, this object supports the following convenience method: address() -- Returns the VM::EC2::Address object involved in the association. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the public IP address. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(associationId publicIp ipOwnerId); } sub address { my $self = shift; return $self->aws->describe_addresses($self->publicIp); } sub short_name { shift->publicIp} 1; VM-EC2-1.23/lib/VM/EC2/NetworkInterface/Attachment.pm000444001751001751 576712100273360 22020 0ustar00lsteinlstein000000000000package VM::EC2::NetworkInterface::Attachment; =head1 NAME VM::EC2::NetworkInterface::Attachment -- Object representing attachment of a network interface to an instance =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $instance = $ec2->describe_instances('i-123456'); my @interfaces = $instance->network_interfaces(); for my $i (@interfaces) { my $attachment = $i->attachment; my $att_id = $attachment->attachmentId; my $ins_id = $attachment->instanceId; my $instance = $attachment->instance; my $device = $attachment->device; my $status = $attachment->status; my $time = $attachment->attachmentTime; my $delete = $attachment->deleteOnTermination; } =head1 DESCRIPTION This object describes the attachment of a elastic network interface (ENI) to an instance, and allows you to manipulate the attachment. Please see L for methods shared by all VM::EC2 objects. =head1 METHODS These object methods are supported: attachmentId -- ID of the attachment instanceId -- ID of the instance instanceOwnerId -- ID of the owner of the instance deviceIndex -- Ethernet device number, e.g. "0" for eth0 status -- Always "attached"; see below. attachmentTime -- Time this ENI was attached to the instance, as a DateTime deleteOnTermination -- If true, this ENI will be deleted when the instance terminates. Amazon does not document the network interface attachment object well, and many of these fields are inferred by inspection of EC2 REST responses. In particular, the status field always seems to be "attached", but there may be another state, such as "pending", which is too short lived to be apparent. In addition, this object supports the following convenience methods: instance -- The VM::EC2::Instance to which the ENI is attached. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the attachmentId. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { return qw(attachmentId instanceId instanceOwnerId deviceIndex status attachTime deleteOnTermination) } sub short_name { shift->attachmentId } sub device { my $index = shift->deviceIndex; return "eth${index}"} sub instance { my $self = shift; my $id = $self->instanceId; return $self->aws->describe_instances($id); } sub deleteOnTermination { return shift->SUPER::deleteOnTermination =~ /true/i; } 1; VM-EC2-1.23/lib/VM/EC2/SecurityGroup000755001751001751 012100273360 16570 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/SecurityGroup/IpPermission.pm000444001751001751 1051212100273360 21723 0ustar00lsteinlstein000000000000package VM::EC2::SecurityGroup::IpPermission; =head1 NAME VM::EC2::SecurityGroup::IpPermission - Object describing a firewall rule in an EC2 security group. =head1 SYNOPSIS $ec2 = VM::EC2->new(...); $sg = $ec2->describe_security_groups(-name=>'My Group'); my @rules = $sg->ipPermissions; for my $rule (@rules) { # each rule is a VM::EC2::SecurityGroup::IpPermission $protocol = $rule->ipProtocol; $fromPort = $rule->fromPort; $toPort = $rule->toPort; @ranges = $rule->ipRanges; @groups = $rule->groups; } =head1 DESCRIPTION This object is used to describe the firewall rules defined within an Amazon EC2 security group. It is returned by the L object's ipPermissions() and ipPermissionsEgress() methods (these are also known as inbound_permissions() and outbound_permissions()). =head1 METHODS =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::SecurityGroup::GroupPermission; =head2 $protocol = $rule->ipProtocol Return the IP protocol for this rule: one of "tcp", "udp" or "icmp". =head2 $port = $rule->fromPort Start of the port range defined by this rule, or the ICMP type code. This will be a numeric value, like 80, or -1 to indicate all ports/codes. =head2 $port = $rule->toPort End of the port range defined by this rule, or the ICMP type code. This will be a numeric value, like 80, or -1 to indicate all ports/codes. =cut sub valid_fields { qw(ipProtocol fromPort toPort groups ipRanges); } sub short_name { my $s = shift; local $^W = 0; my $from = ($s->ipRanges && (' FROM CIDR '.join(',',sort $s->ipRanges))) . ($s->groups && (' GRPNAME '.join(',', sort $s->groups))); sprintf("%s(%s..%s)%s",$s->ipProtocol,$s->fromPort,$s->toPort,$from); } =head2 @ips = $rule->ipRanges This method will return a list of the IP addresses that are allowed to originate or receive traffic, provided that the rule defines IP-based firewall filtering. Each address is a CIDR (classless internet domain routing) address in the form a.b.c.d/n, such as 10.23.91.0/24 (http://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing). The "any" address is in the form 0.0.0.0/0. =cut sub ipRanges { my $self = shift; my $r = $self->SUPER::ipRanges or return; return map {$_->{cidrIp}} @{$r->{item}}; } =head2 @groups = $rule->groups This method will return a list of the security groups that are allowed to originate or receive traffic from instances assigned to this security group, provided that the rule defines group-based traffic filtering. Each returned object is a L, not a L. The reason for this is that these traffic filtering groups can include security groups owned by other accounts The GroupPermission objects define the methods userId(), groupId() and groupName(). =cut sub groups { my $self = shift; my $g = $self->SUPER::groups or return; my @g = map { VM::EC2::SecurityGroup::GroupPermission->new($_,$self->aws) } @{$g->{item}}; foreach (@g) {$_->ownerId($self->ownerId)}; return @g; } sub ownerId { my $self = shift; my $d = $self->{ownerId}; $self->{ownerId} = shift if @_; $d; } =head1 STRING OVERLOADING When used in a string context, this object will interpolate the rule using the following templates: TCP port 22 open to any host: "tcp(22..22) FROM CIDR 0.0.0.0/0" TCP ports 23 through 39 open to the two class C networks 192.168.0.* and 192.168.1.*: "tcp(23..29) FROM CIDR 192.168.0.0/24,192.168.1.0/24" UDP port 80 from security group "default" owned by you and the group named "farmville" owned by user 9999999: "udp(80..80) GRPNAME default,9999999/farmville" =head1 SEE ALSO L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut 1; VM-EC2-1.23/lib/VM/EC2/SecurityGroup/GroupPermission.pm000444001751001751 634412100273360 22437 0ustar00lsteinlstein000000000000package VM::EC2::SecurityGroup::GroupPermission; =head1 NAME VM::EC2::SecurityGroup::GroupPermission - Object describing an authorized group within a security group firewall rule =head1 SYNOPSIS $ec2 = VM::EC2->new(...); $sg = $ec2->describe_security_groups(-name=>'My Group'); @rules = $sg->ipPermissions; $rule = $rules[0]; @groups = $rule->groups; for my $g (@groups) { $userId = $g->userId; $name = $g>groupName; $id = $g->groupId; $group_object = $g->security_group; } =head1 DESCRIPTION This object describes a security group whose instances are granted permission to exchange data traffic with another group of instances. It is returned by the groups() method of L. Note that this object is not the same as a bona fide L, which has access to the group's firewall rules. This object contains just the name, id and owner of a group used within a firewall rule. For groups that belong to you, you can get the full VM::EC2::SecurityGroup object by calling the security_group() method. These details are not available to groups that belong to other accounts. =head1 METHODS =cut use strict; use base 'VM::EC2::Generic'; =head2 $id = $group->groupId Return the group's unique ID. =head2 $id = $group->userId Return the account ID of the owner of this group. =head2 $id = $group->groupName Return this group's name. =cut sub valid_fields { qw(userId groupId groupName); } =head2 $string = $group->short_name Return a string for use in string overloading. See L. =cut sub short_name { my $self = shift; my $name = $self->groupName or return $self->groupId; my $userid = $self->userId; my $ownerid= $self->ownerId; my $gname = $userid eq $ownerid ? $name : "$userid/$name"; return $gname; } =head2 $sg = $group->security_group For groups that belong to the current account, calls VM::EC2->describe_security_groups() to turn the group name into a L. For groups that belong to a different account, will return undef, since describe_security_groups() on other accounts is not allowed by Amazon. =cut sub security_group { my $self = shift; my $gid = $self->groupId or return; return $self->aws->describe_security_groups($gid); } sub ownerId { my $self = shift; my $d = $self->{ownerId}; $self->{ownerId} = shift if @_; $d; } =head1 STRING OVERLOADING When used in a string context, this object will interpolate the user id and group name in the form "userId/groupName" for groups that belong to other accounts, and the groupName alone in the case of groups that belong to you. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut 1; VM-EC2-1.23/lib/VM/EC2/ReservedInstance000755001751001751 012100273360 17210 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/ReservedInstance/Offering.pm000444001751001751 646212100273360 21452 0ustar00lsteinlstein000000000000package VM::EC2::ReservedInstance::Offering; =head1 NAME VM::EC2::ReservedInstance::Offering - Object describing an Amazon EC2 reserved instance offering =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); @offerings = $ec2->describe_reserved_instances_offerings(); for my $o (@offerings) { print $o->reservedInstancesOfferingId,"\n"; print $o->instanceType,"\n"; print $o->availabilityZone,"\n"; print $o->duration,"\n"; print $o->fixedPrice,"\n"; print $o->usagePrice,"\n"; print $o->productDescription,"\n"; print $o->instanceTenancy,"\n"; print $o->currencyCode,"\n"; } # purchase the first one $offerings[0]->purchase() && print "offer purchased\n"; =head1 DESCRIPTION This object represents an Amazon EC2 reserved instance offering, as returned by VM::EC2->describe_reserved_instances_offerings. =head1 METHODS These object methods are supported: reservedInstancesOfferingId -- ID of this offer instanceType -- The instance type on which this reserved instance can be used. availabilityZone -- The availability zone in which this reserved instance can be used. duration -- The duration of the reserved instance contract, in seconds. fixedPrice -- The purchase price of the reserved instance for the indicated version. usagePrice -- The usage price of the reserved instance, per hour. productDescription -- The reserved instance description. One of "Linux/UNIX", "Linux/UNIX (Amazon VPC)", "Windows", and "Windows (Amazon VPC)" instanceTenancy -- The tenancy of the reserved instance (VPC only). currencyCode -- The currency of the reserved instance offering prices. In addition, this object supports the purchase() method: =head2 $boolean = $offering->purchase($count) Purchases the offering and returns true on success. The optional $count argument specifies the number of reserved instances to purchase (default 1). =head1 STRING OVERLOADING When used in a string context, this object will interpolate the reservedInstancesOfferingId. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub primary_id {shift->reservedInstancesOfferingId} sub valid_fields { my $self = shift; return qw(reservedInstancesOfferingId instanceType availabilityZone duration fixedPrice usagePrice productDescription instanceTenancy currencyCode); } sub purchase { my $self = shift; my $count = shift || 1; return $self->ec2->purchase_reserved_instances_offering (-instance_count=>$count, -reserved_instances_offering_id=>$self->reservedInstancesOfferingId ); } 1; VM-EC2-1.23/lib/VM/EC2/BlockDevice000755001751001751 012100273360 16116 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/BlockDevice/EBS.pm000444001751001751 516012100273360 17224 0ustar00lsteinlstein000000000000package VM::EC2::BlockDevice::EBS; =head1 NAME VM::EC2::BlockDevice::EBS - Object describing how to initialize an Amazon EBS volume from an image =head1 SYNOPSIS use VM::EC2; $image = $ec2->describe_images(-image_id=>'ami-123456'); my @devices = $image->blockDeviceMapping; for my $d (@devices) { my $ebs = $d->ebs; my $snapshot_id = $ebs->snapshotId; my $size = $ebs->volumeSize; my $delete = $ebs->deleteOnTermination; } =head1 DESCRIPTION This object is used to describe the parameters used to create an Amazon EBS volume when running an image. Generally you will not call this directly, as all its methods are passed through by the VM::EC2::BlockDevice object returned from the blockDeviceMapping() call. See L for a simpler way to get the information needed. It is easy to confuse this with VM::EC2::BlockDevice::Mapping::EBS, which describes the attachment of an existing EBS volume to an instance. This class is instead used to store the parameters that will be used to generate a new EBS volume when an image is launched. =head1 METHODS The following object methods are supported: snapshotId -- ID of the snapshot used to create this EBS when an instance is launched from this image. volumeSize -- Size of the EBS volume (in gigs). deleteOnTermination -- Whether this EBS will be deleted when the instance terminates. Note that this will return perl 0/1 values rather than the strings "false"/"true" volumeType -- The volume type, one of "standard" or "io1" iops -- The number of I/O operations per second that the volume supports, an integer between 100 and 2000. Only valid for volumes of type "io1". =head1 STRING OVERLOADING NONE. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(snapshotId volumeSize deleteOnTermination volumeType iops); } sub deleteOnTermination { my $self = shift; my $dot = $self->SUPER::deleteOnTermination; return $dot eq 'true'; } 1; VM-EC2-1.23/lib/VM/EC2/BlockDevice/Mapping.pm000444001751001751 742112100273360 20210 0ustar00lsteinlstein000000000000package VM::EC2::BlockDevice::Mapping; =head1 NAME VM::EC2::BlockDevice::Mapping - Object describing an EC2 block device attached to an instance =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $instance = $ec2->describe_instances(-instance_id=>'i-123456'); my @devices = $instance->blockDeviceMapping; for my $dev (@devices) { $dev = $dev->deviceName; $volume_id = $dev->volumeId; $status = $dev->status; $atime = $dev->attachmentTime; $delete = $dev->deleteOnTermination; $volume = $dev->volume; } =head1 DESCRIPTION This object represents an Amazon block device associated with an instance; it is returned by Instance->blockDeviceMapping(). Please see L for methods shared by all VM::EC2 objects. =head1 METHODS These object methods are supported: deviceName -- Name of the device, such as /dev/sda1. instance -- Instance object associated with this volume. ebs -- A VM::EC2::BlockDevice::Mapping::EBS object describing the characteristics of the attached EBS volume For your convenience, a number of the ebs() object's methods are passed through: volumeId -- ID of the volume. status -- One of "attaching", "attached", "detaching", "detached" attachTime -- Time this volume was attached deleteOnTermination -- Whether the volume will be deleted when its attached instance is deleted. Note that this will return perl true/false vales, rather than the strings "true" "false". The deleteOnTermination() method can be used to retrieve or modify this flag: # get current deleteOnTermination flag my $current_flag = $dev->deleteOnTermination; # if flag is true, then set it to false if ($current_flag) { $dev->deleteOnTermination(0) } In addition, the following convenience function is provided: =head2 $volume = $dev->volume This returns a VM::EC2::Volume object from which more information about the volume, such as its size, can be derived. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the deviceName. =head1 SEE ALSO L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::BlockDevice::Mapping::EBS; use overload '""' => sub {shift()->deviceName}, fallback => 1; sub valid_fields { my $self = shift; return qw(deviceName ebs); } sub ebs { my $self = shift; return $self->{ebs} ||= VM::EC2::BlockDevice::Mapping::EBS->new($self->SUPER::ebs,$self->aws); } sub instance { my $self = shift; my $d = $self->{instance}; $self->{instance} = shift if @_; return $d; } sub volumeId { shift->ebs->volumeId } sub status { shift->ebs->status } sub attachTime { shift->ebs->attachTime } sub volume { shift->ebs->volume } sub deleteOnTermination { my $self = shift; my $ebs = $self->ebs; my $flag = $ebs->deleteOnTermination; if (@_) { my $deleteOnTermination = shift; $deleteOnTermination ||= 0; my $flag = $self->deviceName.'='.$self->volumeId.":$deleteOnTermination"; return $self->aws->modify_instance_attribute($self->instance,-block_devices=>$flag); } return $flag; } 1; VM-EC2-1.23/lib/VM/EC2/BlockDevice/Attachment.pm000444001751001751 1161612100273360 20726 0ustar00lsteinlstein000000000000package VM::EC2::BlockDevice::Attachment; =head1 NAME VM::EC2::BlockDevice::Attachment - Object describing the attachment of an EBS volume to an instance =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $volume = $ec2->describe_volumes(-volume_id=>'vol-12345'); $attachment = $ec2->attachment; $volId = $attachment->volumeId; $device = $attachment->device; $instanceId = $attachment->instanceId; $status = $attachment->status; $time = $attachment->attachTime; $delete = $attachment->deleteOnTermination; $attachment->deleteOnTermination(1); # change delete flag =head1 DESCRIPTION This object is used to describe the attachment of an Amazon EBS volume to an instance. It is returned by VM::EC2::Volume->attachment(). =head1 METHODS The following object methods are supported: volumeId -- ID of the volume. instanceId -- ID of the instance status -- Attachment state, one of "attaching", "attached", "detaching", "detached". attachTime -- Timestamp for when volume was attached deleteOnTermination -- True if the EBS volume will be deleted when its attached instance terminates. Note that this is a Perl true, and not the string "true". The deleteOnTermination method is slightly more sophisticated than the result from the standard AWS API because it returns the CURRENT deleteOnTermination flag for the attachment, which might have been changed by VM::EC2->modify_instance_attributes(). You may also change the deleteOnTermination state by passing a boolean argument to the method: $attachment->deleteOnTermination(1); In addition, this class provides several convenience functions: =head2 $instance = $attachment->instance Returns the VM::EC2::Instance corresponding to this attachment. =head2 $volume = $attachment->volume Returns the VM::EC2::Volume object corresponding to this attachment. =head2 $device = $attachment->deviceName Alias for device() to be compatible with VM::EC2::BlockDevice::Mapping call. =head2 $result = $attachment->deleteOnTermination($boolean) Change the deleteOnTermination flag on this attachment. =head2 $status = $attachment->current_status Refreshes the information in the object and returns status(). =head2 $attachment->refresh Calls AWS to refresh the attachment information. =head1 STRING OVERLOADING When used in a string context, this object will interpolate into a string of the format "volumeId=>instanceId". =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(volumeId instanceId device status attachTime deleteOnTermination); } sub primary_id { my $self = shift; return join ('=>',$self->volumeId,$self->instanceId); } sub current_status { my $self = shift; my $v = $self->aws->describe_volumes($self->volumeId) or return; my $a = $v->attachment or return 'detached'; return $a->status; } sub refresh { my $self = shift; my $v = $self->aws->describe_volumes($self->volumeId); my $a = $v->attachment; %$self = %$a; } sub deviceName { shift->device } sub deleteOnTermination { my $self = shift; if (@_) { my $deleteOnTermination = shift; $deleteOnTermination ||= 0; my $flag = $self->device.'='.$self->volumeId.":$deleteOnTermination"; return $self->aws->modify_instance_attribute($self->instanceId,-block_devices=>$flag); } my $device = $self->device; my $instance = $self->instance or die $self->aws->error_str; my @mapping = $instance->blockDeviceMapping; my ($map) = grep {$_ eq $device} @mapping; $map or die "Didn't find blockDeviceMapping corresponding to this attachment"; return $map->deleteOnTermination; } sub instance { my $self = shift; return $self->{instance} if exists $self->{instance}; my @i = $self->aws->describe_instances(-instance_id => $self->instanceId); @i == 1 or die "describe_instances(-instance_id=>",$self->instanceId,") returned more than one volume"; return $self->{instance} = $i[0]; } sub volume { my $self = shift; return $self->{volume} if exists $self->{volume}; my @i = $self->aws->describe_volumes(-volume_id => $self->volumeId); @i == 1 or die "describe_volumes(-volume_id=>",$self->volumeId,") returned more than one volume"; return $self->{volume} = $i[0]; } 1; VM-EC2-1.23/lib/VM/EC2/BlockDevice/Mapping000755001751001751 012100273360 17511 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/BlockDevice/Mapping/EBS.pm000444001751001751 644612100273360 20627 0ustar00lsteinlstein000000000000package VM::EC2::BlockDevice::Mapping::EBS; =head1 NAME VM::EC2::BlockDevice::Mapping::EBS - Object describing an EBS volume that has been mapped onto an Amazon EC2 instance =head1 SYNOPSIS use VM::EC2; my $instance = $ec2->describe_instances(-instance_id=>'i-123456'); my @devices = $instance->blockDeviceMapping; for my $d (@devices) { my $ebs = $d->ebs; $volume_id = $ebs->volumeId; $status = $ebs->status; $atime = $ebs->attachmentTime; $delete = $ebs->delete; $volume = $ebs->volume; } =head1 DESCRIPTION This object is used to describe an Amazon EBS volume that is mapped onto an EC2 block device. It is returned by VM::EC2->describe_instances(). It is easy to confuse this with VM::EC2::BlockDevice::EBS, which describes the parameters needed to create the EBS volume when an image is launched. This class is instead used to describe an active mapping between an instance's block device and the underlying EBS volume. Because all the methods in this class are passed through to VM::EC2::BlockDeviceMapping, it is somewhat simpler to call them directly on the BlockDeviceMapping object: my $instance = $ec2->describe_instances(-instance_id=>'i-123456'); my @devices = $instance->blockDeviceMapping; for my $d (@devices) { $volume_id = $d->volumeId; $status = $d->status; $atime = $d->attachmentTime; $delete = $d->delete; $volume = $d->volume; } =head1 METHODS The following object methods are supported: volumeId -- ID of the volume. status -- One of "attaching", "attached", "detaching", "detached" attachTime -- Time this volume was attached deleteOnTermination -- Whether the volume will be deleted when its attached instance is deleted. Note that this returns the perl 0/1 booleans rather than "false"/"true" strings. In addition, the following convenience method is supported: =head2 $vol = $ebs->volume This returns the VM::EC2::Volume object that corresponds to this EBS. The volume will provide additional information, such as availabilit zone. =head1 STRING OVERLOADING NONE =head1 SEE ALSO L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(volumeId status attachTime deleteOnTermination); } sub volume { my $self = shift; return $self->{volume} if exists $self->{volume}; my @vols = $self->aws->describe_volumes(-volume_id=>$self->volumeId) or return; @vols == 1 or die "describe_volumes(-volume_id=>",$self->volumeId,") returned more than one volume"; return $self->{volume} = $vols[0]; } sub deleteOnTermination { my $self = shift; my $dot = $self->SUPER::deleteOnTermination; return $dot eq 'true'; } 1; VM-EC2-1.23/lib/VM/EC2/Snapshot000755001751001751 012100273360 15543 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/Snapshot/CreateVolumePermission.pm000444001751001751 274612100273360 22713 0ustar00lsteinlstein000000000000package VM::EC2::Snapshot::CreateVolumePermission; =head1 NAME VM::EC2::Snapshot::CreateVolumePermission - Object describing AMI create volume permissions =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $snapshot = $ec2->describe_snapshots('snap-12345'); @users = $image->createVolumePermissions; for (@users) { $group = $_->group; $user = $_->userId; } =head1 DESCRIPTION This object represents an Amazon volume snapshot create volume permission, and is return by VM::EC2::Snapshot createVolumePermissions(). =head1 METHODS These object methods are supported: group -- Name of a group with launch permissions. Only valid value is "all" userId -- Name of a user with launch permissions. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the userId. If the userId is blank, then interpolates as the group. =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Image::LaunchPermission'; 1; VM-EC2-1.23/lib/VM/EC2/Staging000755001751001751 012100273360 15340 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/Staging/Server.pm000444001751001751 13460412100273360 17351 0ustar00lsteinlstein000000000000package VM::EC2::Staging::Server; # high level interface for transferring data, and managing data snapshots # via a series of Staging VMs. =head1 NAME VM::EC2::Staging::Server - High level interface to EC2-based servers =head1 SYNOPSIS use VM::EC2::Staging::Manager; # get a new staging manager my $ec2 = VM::EC2->new; my $staging = $ec2->staging_manager(); ); # Fetch a server named 'my_server'. Create it if it does not already exist. my $server1 = $staging->get_server(-name => 'my_server', -availability_zone => 'us-east-1a', -architecture => 'i386', -instance_type => 't1.micro'); # As above, but force a new server to be provisioned. my $server2 = $staging->provision_server(-name => 'my_server', -availability_zone => 'us-east-1a', -architecture => 'i386', -instance_type => 't1.micro'); # open up a terminal emulator in a separate window $server1->shell; # Run a command over ssh on the server. Standard in and out will be connected to # STDIN/OUT $server1->ssh('whoami'); # run a command over ssh on the server, returning standard output as an array of lines or a # scalar string, similar to backticks (``) my @password_lines = $server1->scmd('cat /etc/passwd'); # run a command on the server and read from it using a filehandle my $fh = $server1->scmd_read('ls -R /usr/lib'); while (<$fh>) { # do something } # run a command on the server and write to it using a filehandle my $fh = $server1->scmd_write('sudo -s "cat >>/etc/fstab"'); print $fh "/dev/sdf3 /mnt/demo ext3 0 2\n"; close $fh; # provision and mount a 5 gig ext3 volume mounted on /opt, returning # VM::EC2::Staging::Volume object my $opt = $server1->provision_volume(-mtpt => '/opt', -fstype => 'ext3', -size => 5); # copy some data from the local filesystem onto the opt volume $server1->rsync("$ENV{HOME}/local_staging_volume/" => $opt); # same thing, but using server path name $server1->put("$ENV{HOME}/local_staging_volume/" => '/opt'); # provision a volume attached to another server, and let the # system choose the filesystem and mount point for us my $backups = $server2->provision_volume(-name => 'Backup', -size => 10); # copy some data from opt to the new volume using rsync $server1->rsync($opt => "$backups/opt"); # Do a block-level copy between disks - warning, the filesystem must be unmounted # before you attempt this. $backups->unmount; $server1->dd($opt => $backups); =head1 DESCRIPTION VM::EC2::Staging::Server objects are an extension of VM::EC2::Instance to allow for higher-level access, including easy management of ssh keys, remote copying of data from one server to another, and executing of remote commands on the server from within Perl. See L for an overview of staging servers and volumes. Note that proper functioning of this module is heavily dependent on running on a host system that has access to ssh, rsync and terminal emulator command-line tools. It will most likely fail when run on a Windows host. =cut use strict; use VM::EC2; use Carp 'croak'; use Scalar::Util 'weaken'; use File::Spec; use File::Path 'make_path','remove_tree'; use File::Basename 'dirname'; use POSIX 'setsid'; use overload '""' => sub {my $self = shift; return $self->short_name; # "inherited" from VM::EC2::Server }, fallback => 1; use constant GB => 1_073_741_824; our $AUTOLOAD; sub AUTOLOAD { my $self = shift; my ($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/; return if $func_name eq 'DESTROY'; my $inst = eval {$self->instance} or croak "Can't locate object method \"$func_name\" via package \"$pack\"";; return $inst->$func_name(@_); } sub can { my $self = shift; my $method = shift; my $can = $self->SUPER::can($method); return $can if $can; my $inst = $self->instance or return; return $inst->can($method); } =head1 Staging Server Creation Staging servers are usually created via a staging manager's get_server() or provision_server() methods. See L. There is also a new() class method that is intended to be used internally in most cases. It is called like this: =head2 $server = VM::EC2::Staging::Server->new(%args) With the arguments: -keyfile path to the ssh public/private keyfile for this instance -username username for remote login on this instance -instance VM::EC2::Instance to attach this server to -manager VM::EC2::Staging::Manager in same zone as the instance Note that you will have to launch a staging manager, start an instance, and appropriate provision the SSH credentials for that instance before invoking new() directly. =cut sub new { my $class = shift; my %args = @_; $args{-keyfile} or croak 'need -keyfile path'; $args{-username} or croak 'need -username'; $args{-instance} or croak 'need a -instance VM::EC2::Instance argument'; $args{-manager} or croak 'need a -manager argument'; my $endpoint = $args{-manager}->ec2->endpoint; my $self = bless { endpoint => $endpoint, instance => $args{-instance}, username => $args{-username}, keyfile => $args{-keyfile}, name => $args{-name} || undef, },ref $class || $class; return $self; } =head1 Information about the Server VM::EC2::Staging::Server objects have all the methods of VM::EC2::Instance, such as dnsName(), but add several new methods. The new methods involving getting basic information about the server are listed in this section. =head2 $name = $server->name This method returns the server's symbolic name, if any. Servers can optionally be assigned a symbolic name at the time they are created by the manager's get_server() or provision_server() methods. The name persists as long as the underlying instance exists (including in stopped state for EBS-backed instances). Calling $manager->get_server() with this name returns the server object. =cut sub name { shift->{name} } =head2 $ec2 = $server->ec2 Return the VM::EC2 object associated with the server. =cut sub ec2 { shift->manager->ec2 } =head2 $ec2 = $server->endpoint Return the endpoint URL associated with this server. =cut sub endpoint { shift->{endpoint} } =head2 $instance = $server->instance Return the VM::EC2::Instance associated with this server. =cut sub instance { shift->{instance} } =head2 $file = $server->keyfile Return the full path to the SSH PEM keyfile used to log into this server. =cut sub keyfile { shift->{keyfile} } =head2 $user = $server->username Return the name of the user (e.g. 'ubuntu') used to ssh into this server. =cut sub username { my $self = shift; my $d = $self->{username}; $self->{username} = shift if @_; $d; } =head2 $manager = $server->manager Returns the VM::EC2::Staging::Manager that manages this server. =cut sub manager { my $self = shift; my $ep = $self->endpoint; return VM::EC2::Staging::Manager->find_manager($ep); } =head1 Lifecycle Methods The methods in this section manage the lifecycle of a server. =head2 $flag = $server->ping The ping() method returns true if the server is running and is reachable via ssh. It is different from checking that the underlying instance is "running" via a call to current_status, because it also checks the usability of the ssh daemon, the provided ssh key and username, firewall rules, and the network connectivity. The result of ping is cached so that subsequent invocations return quickly. =cut sub ping { my $self = shift; return unless $self->instance->status eq 'running'; return 1 if $self->is_up; return unless $self->ssh('pwd >/dev/null 2>&1'); $self->is_up(1); return 1; } =head2 $result = $server->start Attempt to start a stopped server. The method will wait until a ping() is successful, or until a timeout of 120 seconds. The result code will be true if the server was successfully started and is reachable. If you wish to start a set of servers without waiting for each one individually, then you may call the underling instance's start() method: $server->instance->start; You may then wish to call the staging manager's wait_for_instances() method to wait on all of the servers to start: $manager->wait_for_servers(@servers); Also check out $manager->start_all_servers(). =cut sub start { my $self = shift; return if $self->is_up; $self->manager->info("Starting staging server\n"); eval { local $SIG{ALRM} = sub {die 'timeout'}; alarm(VM::EC2::Staging::Manager::SERVER_STARTUP_TIMEOUT()); $self->ec2->start_instances($self); $self->manager->wait_for_servers($self); }; alarm(0); if ($@) { $self->manager->warn("could not start $self\n"); return; } $self->is_up(1); 1; } =head2 $result = $server->stop Attempt to stop a running server. The method will wait until the server has entered the "stopped" state before returning. It will return a true result if the underlying instance stopped successfully. If you wish to stop a set of servers without waiting for each one individually, then you may call the underling instance's start() method: $server->instance->stop; You may then wish to call the staging manager's wait_for_instances() method to wait on all of the servers to start: $status = $manager->wait_for_servers(@servers); Also check out $manager->stop_all_servers(). =cut sub stop { my $self = shift; return unless $self->instance->status eq 'running'; $self->instance->stop; $self->is_up(0); my $status = $self->manager->wait_for_instances($self); return $status->{$self->instance} eq 'stopped'; } =head2 $result = $server->terminate Terminate a server and unregister it from the manager. This method will stop and wait until the server is terminated. If you wish to stop a set of servers without waiting for each one individually, then you may call the underling instance's start() method: $server->instance->terminate; =cut sub terminate { my $self = shift; $self->manager->_terminate_servers($self); $self->is_up(0); 1; } =head1 Remote Shell Methods The methods in this section allow you to run remote commands on the staging server and interrogate the results. Since the staging manager handles the creation of SSH keys internally, you do not need to worry about finding the right public/private keypair. =head2 $result = $server->ssh(@command) The ssh() method invokes a command on the remote server. You may provide the command line as a single string, or broken up by argument: $server->ssh('ls -lR /var/log'); $server->ssh('ls','-lR','/var/log'); The output of the command will appear on STDOUT and STDERR of the perl process. Input, if needed, will be read from STDIN. If no command is provided, then an interactive ssh session will be started on the remote server and the script will wait until you have logged out. If the remote command was successful, the method result will be true. =cut sub ssh { my $self = shift; my @extra_args; if (ref($_[0]) && ref($_[0]) eq 'ARRAY') { my $extra = shift; @extra_args = @$extra; } my @cmd = @_; my $Instance = $self->instance or die "Remote instance not set up correctly"; my $host = $Instance->dnsName; system('ssh',$self->_ssh_args,@extra_args,$host,@cmd)==0; } =head2 $output = $server->scmd(@command) This is similar to ssh(), except that the standard output of the remote command will be captured and returned as the function result, similar to the way backticks work in perl: my $output = $server->scmd('date'); print "The localtime for the server is $output"; =cut sub scmd { my $self = shift; my @extra_args; if (ref($_[0]) && ref($_[0]) eq 'ARRAY') { my $extra = shift; @extra_args = @$extra; } my @cmd = @_; my $Instance = $self->instance or die "Remote instance not set up correctly"; my $host = $Instance->dnsName; my $pid = open my $kid,"-|"; #this does a fork die "Couldn't fork: $!" unless defined $pid; if ($pid) { my @results; while (<$kid>) { push @results,$_; } close $kid; if (wantarray) { chomp(@results); return @results; } else { return join '',@results; } } # in child exec 'ssh',$self->_ssh_args,@extra_args,$host,@cmd; } =head2 $fh = $server->scmd_write(@command) This method executes @command on the remote server, and returns a filehandle that is attached to the standard input of the command. Here is a slightly dangerous example that appends a line to /etc/passwd: my $fh = $server->scmd_write('sudo -s "cat >>/etc/passwd"'); print $fh "whoopsie:x:119:130::/nonexistent:/bin/false\n"; close $fh; =cut # return a filehandle that you can write to: # e.g. # my $fh = $server->scmd_write('cat >/tmp/foobar'); # print $fh, "testing\n"; # close $fh; sub scmd_write { my $self = shift; return $self->_scmd_pipe('write',@_); } =head2 $fh = $server->scmd_read(@command) This method executes @command on the remote server, and returns a filehandle that is attached to the standard output of the command. Here is an example of reading syslog: my $fh = $server->scmd_read('sudo cat /var/log/syslog'); while (<$fh>) { next unless /kernel/; print $_; } close $fh; =cut # same thing, but you read from it: # my $fh = $server->scmd_read('cat /tmp/foobar'); # while (<$fh>) { # print $_; #} sub scmd_read { my $self = shift; return $self->_scmd_pipe('read',@_); } =head2 $server->shell() This method works in an X Windowing environment by launching a new terminal window and running an interactive ssh session on the server host. The terminal window is executed in a fork()ed session, so that the rest of the script continues running. If X Windows is not running, then the method behaves the same as calling ssh() with no arguments. The terminal emulator to run is determined by calling the method get_xterm(). =cut sub shell { my $self = shift; return $self->ssh() unless $ENV{DISPLAY}; fork() && return; setsid(); # so that we are independent of parent signals my $host = $self->instance->dnsName; my $ssh_args = $self->_ssh_escaped_args; my $emulator = $self->get_xterm; exec $emulator,'-e',"ssh $ssh_args $host" or die "$emulator: $!"; } sub get_xterm { my $self = shift; return 'xterm'; } sub _ssh_args { my $self = shift; return ( '-o','CheckHostIP no', '-o','StrictHostKeyChecking no', '-o','UserKnownHostsFile /dev/null', '-o','LogLevel QUIET', '-i',$self->keyfile, '-l',$self->username, ); } sub _ssh_escaped_args { my $self = shift; my @args = $self->_ssh_args; for (my $i=1;$i<@args;$i+=2) { $args[$i] = qq("$args[$i]") if $args[$i]; } my $args = join ' ',@args; return $args; } sub _scmd_pipe { my $self = shift; my ($op,@cmd) = @_; my @extra_args; if (ref($cmd[0]) && ref($cmd[0]) eq 'ARRAY') { my $extra = shift @cmd; @extra_args = @$extra; } my $operation = $op eq 'write' ? '|-' : '-|'; my $host = $self->dnsName; my $pid = open(my $fh,$operation); # this does a fork defined $pid or croak "piped open failed: $!" ; return $fh if $pid; # writing to the filehandle writes to an ssh session exec 'ssh',$self->_ssh_args,@extra_args,$host,@cmd; exit 0; } =head1 Volume Management Methods The methods in this section allow you to create and manage volumes attached to the server. These supplement the EC2 facilities for creating and attaching EBS volumes with the ability to format the volumes with a variety of filesystems, and mount them at a desired location. =head2 $volume = $server->provision_volume(%args) Provision and mount a new volume. If successful, the volume is returned as a VM::EC2::Staging::Volume object. Arguments (default): -name Symbolic name for the desired volume (autogenerated) -fstype Filesystem type for desired volume (ext4) -size Size for the desired volume in GB (1) -mtpt Mountpoint for this volume (/mnt/Staging/$name) -mount Alias for -mtpt -volume_id ID of existing volume to attach & mount (none) -snapshot_id ID of existing snapshot to use to create this volume (none) -reuse Reuse an existing managed volume of same name (false) -label Disk label to assign during formatting ($name) -uuid UUID to assign during formatting (none) None of the arguments are required, and reasonable defaults will be chosen if they are missing. The B<-name> argument specifies the symbolic name to be assigned to the newly-created staging volume. The name allows the staging manager to retrieve this volume at a later date if it is detached from the server and returned to the available pool. If no name is provided, then an arbitrary one will be autogenerated. The B<-fstype> argument specifies the filesystem to be generated on the volume, ext4 by default. The following filesystems are currently supported: ext2, ext3, ext4, xfs, reiserfs, jfs, ntfs, nfs, vfat, msdos. In addition, you can specify a filesystem of "raw", which means to provision and attach the volume to the server, but not to format it. This can be used to set up LVM and RAID devices. Note that if the server does not currently have the package needed to manage the desired filesystem, it will use "apt-get" to install it. The B<-mtpt> and B<-mount> arguments (they are equivalent) specify the mount point for the volume on the server filesystem. The default is "/mnt/Staging/$name", where $name is the symbolic name provided by -name or autogenerated. No checking is done on the sensibility of the mount point, so try to avoid mounting disks over essential parts of the system. B<-volume_id> and B<-snapshot_id> instruct the method to construct the staging volume from an existing EBS volume or snapshot. -volume_id is an EBS volume ID. If provided, the volume must be located in the server's availability zone and be in the "available" state. -snapshot_id is an EBS snapshot ID in the server's region. In no case will provision_volume() attempt to reformat the resulting volume, even if the -fstype argument is provided. However, in the case of a volume created from a snapshot, you may specify a -size argument larger than the snapshot and the filesystem will be dynamically resized to fill the requested space. This currently only works with ext2, ext3 and ext4 volumes, and cannot be used to make filesystems smaller. If the B<-reuse> argument is true, and a symbolic name is provided in B<-name>, then the method will look for an available staging volume of the same name and mount this at the specified location. If no suitable staging volume is found, then the method will look for a snapshot created earlier from a staging volume of the same name. If neither a suitable volume nor a snapshot is available, then a new volume is provisioned. This is intended to support the following use case of synchronizing a filesystem somewhere to an EBS snapshot: my $server = $staging_manager->get_server('my_server'); my $volume = $server->provision_volume(-name=>'backup_1', -reuse => 1, -fstype => 'ext3', -size => 10); $volume->put('fred@gw.harvard.edu:my_music'); $volume->create_snapshot('music_backups'); $volume->delete; The B<-label> and B<-uuid> arguments are used to set the volume label and UUID during formatting of new filesystems. The default behavior is to create no label and to allow the server to choose an arbitrary UUID. =cut sub provision_volume { my $self = shift; my %args = @_; my $name = $args{-name} ||= VM::EC2::Staging::Manager->new_volume_name; my $size = $args{-size}; my $volid = $args{-volume_id}; my $snapid = $args{-snapshot_id}; my $reuse = $args{-reuse}; my $label = $args{-label}; my $uuid = $args{-uuid}; $self->manager->find_volume_by_name($args{-name}) && croak "There is already a volume named $args{-name} in this region"; if ($volid || $snapid) { $name ||= $volid || $snapid; $size ||= -1; } else { $name =~ /^[a-zA-Z0-9_.,&-]+$/ or croak "Volume name must contain only characters [a-zA-Z0-9_.,&-]; you asked for '$name'"; } my $ec2 = $self->ec2; my $fstype = $args{-fstype} || 'ext4'; my $mtpt = $fstype eq 'raw' ? 'none' : ($args{-mount} || $args{-mtpt} || $self->default_mtpt($name)); my $username = $self->username; $size = int($size) < $size ? int($size)+1 : $size; # dirty ceil() function my $instance = $self->instance; my $zone = $instance->placement; my ($vol,$needs_mkfs,$needs_resize) = $self->_create_volume($name,$size,$zone,$volid,$snapid,$reuse); $vol->add_tag(Name => $self->volume_description($name)) unless exists $vol->tags->{Name}; $vol->add_tags(StagingName => $name, StagingMtPt => $mtpt, StagingFsType => $fstype, StagingRole => 'StagingVolume'); my ($ebs_device,$mt_device) = eval{$self->unused_block_device()} or die "Couldn't find suitable device to attach this volume to"; my $s = $instance->attach_volume($vol=>$ebs_device) or die "Couldn't attach $vol to $instance via $ebs_device: ",$ec2->error_str; $ec2->wait_for_attachments($s) or croak "Couldn't attach $vol to $instance via $ebs_device"; $s->current_status eq 'attached' or croak "Couldn't attach $vol to $instance via $ebs_device"; if ($needs_resize) { $self->scmd("sudo blkid -p $mt_device") =~ /"ext\d"/ or croak "Sorry, but can only resize ext volumes "; $self->info("Checking filesystem...\n"); $self->ssh("sudo /sbin/e2fsck -fy $mt_device") or croak "Couldn't check $mt_device"; $self->info("Resizing previously-used volume to $size GB...\n"); $self->ssh("sudo /sbin/resize2fs $mt_device ${size}G") or croak "Couldn't resize $mt_device"; } elsif ($needs_mkfs && $fstype ne 'raw') { local $_ = $fstype; my $label_cmd =!$label ? '' :/^ext/ ? "-L '$label'" :/^xfs/ ? "-L '$label'" :/^reiser/ ? "-l '$label'" :/^jfs/ ? "-L '$label'" :/^vfat/ ? "-n '$label'" :/^msdos/ ? "-n '$label'" :/^ntfs/ ? "-L '$label'" :/^hfs/ ? "-v '$label'" :''; my $uu = $uuid ? ( /^ext/ ? "-U $uuid" :/^xfs/ ? '' :/^reiser/ ? "-u $uuid" :/^jfs/ ? '' :/^vfat/ ? '' :/^msdos/ ? '' :/^ntfs/ ? "-U $uuid" :/^hfs/ ? '' :'') : ''; my $quiet = $self->manager->verbosity < 3 && !/msdos|vfat|hfs/ ? "-q" : ''; my $apt_packages = $self->_mkfs_packages(); if (my $package = $apt_packages->{$fstype}) { $self->info("checking for /sbin/mkfs.$fstype\n"); $self->ssh("if [ ! -e /sbin/mkfs.$fstype ]; then sudo apt-get -q update; sudo apt-get -q -y install $package; fi"); } $self->info("Making $fstype filesystem on staging volume...\n"); $self->ssh("sudo /sbin/mkfs.$fstype $quiet $label_cmd $uu $mt_device") or croak "Couldn't make filesystem on $mt_device"; if ($uuid && !$uu) { $self->info("Setting the UUID for the volume\n"); $self->ssh("sudo xfs_admin -U $uuid $mt_device") if $fstype =~ /^xfs/; $self->ssh("sudo jfs_tune -U $uuid $mt_device") if $fstype =~ /^jfs/; # as far as I know you cannot set a uuid for FAT and VFAT volumes } } my $volobj = $self->manager->volume_class->new({ -volume => $vol, -mtdev => $mt_device, -mtpt => $mtpt, -server => $self, -name => $name}); # make sure the guy is mountable before trying it if ($volid || $snapid) { my $isfs = $self->scmd("sudo blkid -p $mt_device") =~ /filesystem/i; $self->mount_volume($volobj) if $isfs; $volobj->mtpt('none') unless $isfs; $fstype = $volobj->get_fstype; $volobj->fstype($fstype); } else { $volobj->fstype($fstype); $self->mount_volume($volobj); } $self->manager->register_volume($volobj); return $volobj; } =head2 $volume = $server->add_volume(%args) This is the same as provision_volume(). =cut sub add_volume { shift->provision_volume(@_) } =head2 @volumes = $server->volumes() Return a list of all the staging volumes attached to this server. Unmanaged volumes, such as the root volume, are not included in the list. =cut sub volumes { my $self = shift; $self->refresh; my @volIds = map {$_->volumeId} $self->blockDeviceMapping; my @volumes = map {$self->manager->find_volume_by_volid($_)} @volIds; return grep {defined $_} @volumes; } =head2 $server->unmount_volume($volume) Unmount the volume $volume. The volume will remain attached to the server. This method will die with a fatal error if the operation fails. See VM::EC2::Staging::Volume->detach() for the recommended way to unmount and detach the volume. =cut sub unmount_volume { my $self = shift; my $vol = shift; my $mtpt = $vol->mtpt; return unless $mtpt; return if $mtpt eq 'none'; return unless $vol->mounted; $self->info("unmounting $vol...\n"); $self->ssh('sudo','umount',$mtpt) or croak "Could not umount $mtpt"; $vol->delete_tags('StagingMtPt'); $vol->mounted(0); } =head2 $server->detach_volume($volume) Unmount and detach the volume from the server, waiting until EC2 reports that the detachment completed. A fatal error will occur if the operation fails. =cut sub detach_volume { my $self = shift; my $vol = shift; return unless $vol->server; return unless $vol->current_status eq 'in-use'; $vol->server eq $self or croak "Volume is not attached to this server"; my $status = $vol->detach(); $self->ec2->wait_for_attachments($status); $vol->refresh; } =head2 $server->mount_volume($volume [,$mountpt]) Mount the volume $volume using the mount information recorded inside the VM::EC2::Staging::Volume object (returned by its mtpt() and mtdev() methods). If the volume has not previously been mounted on this server, then it will be attached to the server and a new mountpoint will be allocated automatically. You can change the mount point by specifying it explicitly in the second argument. Here is the recommended way to detach a staging volume from one server and attach it to another: $server1->detach_volume($volume); $server2->mount_volume($volume); This method will die in case of error. =cut sub mount_volume { my $self = shift; my ($vol,$mtpt) = @_; $vol->mounted and return; if ($vol->mtdev && $vol->mtpt) { return if $vol->mtpt eq 'none'; $self->_mount($vol->mtdev,$vol->mtpt); } else { $self->_find_or_create_mount($vol,$mtpt); } $vol->add_tags(StagingMtPt => $vol->mtpt); $vol->server($self); $vol->mounted(1); } =head2 $server->remount_volume($volume) This is similar to mount_volume(), except that it will fail with a fatal error if the volume was not previously mounted on this server. This is to be used when temporarily unmounting and remounting a volume on the same server: $server->unmount_volume($volume); # do some work on the volume $server->remount_volume($volume) =cut sub remount_volume { my $self = shift; my $vol = shift; my $mtpt = $vol->mtpt; return if $mtpt eq 'none'; my $device = $vol->mtdev; my $server = $vol->server; ($mtpt && $device && $server eq $self) or croak "attempt to remount a volume that was not previously mounted on this server"; $self->info("remounting $vol\n"); $self->ssh('sudo','mount',$device,$mtpt) or croak "Could not remount $mtpt"; $vol->mounted(1); } =head2 $server->delete_volume($volume) Unmount, detach, and then delete the indicated volume entirely. =cut sub delete_volume { my $self = shift; my $vol = shift; my $ec2 = $self->ec2; $self->manager->unregister_volume($vol); $self->unmount_volume($vol); # call underlying EBS function to avoid the volume trying to spin up the # server just to unmount itself. $ec2->wait_for_attachments( $vol->ebs->detach() ); $self->info("deleting $vol...\n"); $ec2->delete_volume($vol->volumeId); $vol->mounted(0); } =head2 $snap = $server->create_snapshot($volume,$description) Unmount the volume, snapshot it using the provided description, and then remount the volume. If successful, returns the snapshot. The snapshot is tagged with the identifying information needed to associate the snapshot with the staging volume. This information then used when creating new volumes from the snapshot with $server->provision_volume(-reuse=>1). =cut sub create_snapshot { my $self = shift; my ($vol,$description) = @_; my $was_mounted = $vol->mounted; $self->unmount_volume($vol) if $was_mounted; $self->info("snapshotting $vol\n"); my $volume = $vol->ebs; my $snap = $volume->create_snapshot($description) or croak "Could not snapshot $vol: ",$vol->ec2->error_str; $snap->add_tag(StagingName => $vol->name ); $snap->add_tag(Name => "Staging volume ".$vol->name); $self->remount_volume($vol) if $was_mounted; return $snap; } sub _create_volume { my $self = shift; my ($name,$size,$zone,$volid,$snapid,$reuse_staging_volume) = @_; my $ec2 = $self->ec2; my (@vols,@snaps); if ($volid) { my $vol = $ec2->describe_volumes($volid) or croak "Unknown volume $volid"; croak "$volid is not in server availability zone $zone." unless $vol->availabilityZone eq $zone; croak "$vol is unavailable for use, status ",$vol->status unless $vol->status eq 'available'; @vols = $vol; } elsif ($snapid) { my $snap = $ec2->describe_snapshots($snapid) or croak "Unknown snapshot $snapid"; @snaps = $snap; } elsif ($reuse_staging_volume) { @vols = sort {$b->createTime cmp $a->createTime} $ec2->describe_volumes({status => 'available', 'availability-zone' => $zone, 'tag:StagingName' => $name}); @snaps = sort {$b->startTime cmp $a->startTime} $ec2->describe_snapshots(-owner => $ec2->account_id, -filter => {'tag:StagingName' => $name}) unless @vols; } my ($vol,$needs_mkfs,$needs_resize); if (@vols) { $vol = $vols[0]; $size = $vol->size unless $size > 0; $self->info("Using volume $vol...\n"); $vol->size == $size or croak "Cannot (yet) resize live volumes. Please snapshot first and restore from the snapshot" } elsif (@snaps) { my $snap = $snaps[0]; $size = $snap->volumeSize unless $size > 0; $self->info("Using snapshot $snap...\n"); $snap->volumeSize <= $size or croak "Cannot (yet) shrink volumes derived from snapshots. Please choose a size >= snapshot size"; $vol = $snap->create_volume(-availability_zone=>$zone, -size => $size); $needs_resize = $snap->volumeSize < $size; } else { unless ($size > 0) { $self->info("No size provided. Defaulting to 10 GB.\n"); $size = 10; } $self->info("Provisioning a new $size GB volume...\n"); $vol = $ec2->create_volume(-availability_zone=>$zone, -size =>$size); $needs_mkfs++; } return unless $vol; return ($vol,$needs_mkfs,$needs_resize); } sub _mount { my $self = shift; my ($mt_device,$mtpt) = @_; $self->info("Mounting staging volume at $mt_device on $mtpt.\n"); $self->ssh("sudo mkdir -p $mtpt; sudo mount $mt_device $mtpt") or croak "mount failed"; } sub _mkfs_packages { my $self = shift; return { xfs => 'xfsprogs', reiserfs => 'reiserfsprogs', jfs => 'jfsutils', ntfs => 'ntfsprogs', hfs => 'hfsprogs', } } sub _find_or_create_mount { my $self = shift; my ($vol,$mtpt) = @_; $vol->refresh; my ($ebs_device,$mt_device,$old_mtpt); # handle the case of the volme already being attached if (my $attachment = $vol->attachment) { if ($attachment->status eq 'attached') { $attachment->instanceId eq $self->instanceId or die "$vol is attached to wrong server"; ($mt_device,$old_mtpt) = $self->_find_mount($attachment->device); $mtpt ||= $old_mtpt || $vol->tags->{StagingMtPt} || $self->default_mtpt($vol); $self->_mount($mt_device,$mtpt); #oops, device is in a semi-attached state. Let it settle then reattach. } else { $self->info("$vol was recently used. Waiting for attachment state to settle...\n"); $self->ec2->wait_for_attachments($attachment); } } unless ($mt_device && $mtpt) { ($ebs_device,$mt_device) = $self->unused_block_device; $self->info("attaching $vol to $self via $ebs_device\n"); my $s = $vol->attach($self->instanceId,$ebs_device) or croak "Can't attach $vol to $self: ",$self->ec2->error_str; $self->ec2->wait_for_attachments($s); $s->current_status eq 'attached' or croak "Can't attach $vol to $self"; $mtpt ||= $vol->tags->{StagingMtPt} || $self->default_mtpt($vol); $self->_mount($mt_device,$mtpt); } $vol->mtpt($mtpt); $vol->mtdev($mt_device); } # this gets called to find a device that is already mounted sub _find_mount { my $self = shift; my $device = shift; my @mounts = $self->scmd('cat /proc/mounts'); my (%mounts,$xvd); for my $m (@mounts) { my ($dev,$mtpt) = split /\s+/,$m; $xvd++ if $dev =~ m!^/dev/xvd!; $mounts{$dev} = $mtpt; } $device =~ s!^/dev/sd!/dev/xvd! if $xvd; return ($device,$mounts{$device}); } =head1 Data Copying Methods The methods in this section are used to copy data from one staging server to another, and to copy data from a local file system to a staging server. =head2 $result = $server->rsync($src1,$src2,$src3...,$dest) This method is a passthrough to VM::EC2::Staging::Manager->rsync(), and provides efficient file-level synchronization (rsync) file-level copying between one or more source locations and a destination location via an ssh tunnel. Copying among arbitrary combinations of local and remote filesystems is supported, with the caveat that the remote filesystems must be contained on volumes and servers managed by this module (see below for a workaround). You may provide two or more directory paths. The last path will be treated as the copy destination, and the source paths will be treated as copy sources. All copying is performed using the -avz options, which activates recursive directory copying in which ownership, modification times and permissions are preserved, and compresses the data to reduce network usage. Source paths can be formatted in one of several ways: /absolute/path Copy the contents of the directory /absolute/path located on the local machine to the destination. This will create a subdirectory named "path" on the destination disk. Add a slash to the end of the path (i.e. "/absolute/path/") in order to avoid creating this subdirectory on the destination disk. ./relative/path Relative paths work the way you expect, and depend on the current working directory. The terminating slash rule applies. $staging_server:/absolute/path Pass a staging server object and absolute path to copy the contents of this path to the destination disk. Because of string interpolation you can include server objects in quotes: "$my_server:/opt" $staging_server:relative/path This form will copy data from paths relative to the remote user's home directory on the staging server. Typically not very useful, but supported. $staging_volume Pass a VM::EC2::Staging::Volume to copy the contents of the volume to the destination disk starting at the root of the volume. Note that you do *not* need to have any knowledge of the mount point for this volume in order to copy its contents. $staging_volume:/absolute/path Copy a subdirectory of a staging volume to the destination disk. The root of the volume is its top level, regardless of where it is mounted on the staging server. Because of string interpolation magic, you can enclose staging volume object names in quotes in order to construct the path, as in "$picture_volume:/family/vacations/". As in local paths, a terminating slash indicates that the contents of the last directory in the path are to be copied without creating the enclosing directory on the desetination. Note that you do *not* need to have any knowledge of the mount point for this volume in order to copy its contents. $staging_volume:absolute/path $staging_volume/absolute/path These are alternatives to the previous syntax, and all have the same effect as $staging_volume:relative/path. There is no The same syntax is supported for destination paths, except that it makes no difference whether a path has a trailing slash or not. Note that neither the source nor destination paths need to reside on this server. See VM::EC2::Staging::Manager->rsync() for examples and more details. =cut sub rsync { shift->manager->rsync(@_); } =head2 $server->dd($source_vol=>$dest_vol) This method is a passthrough to VM::EC2::Staging::Manager->dd(), and performs block-level copying of the contents of $source_vol to $dest_vol by using dd over an SSH tunnel, where both source and destination volumes are VM::EC2::Staging::Volume objects. The volumes must be attached to a server but not mounted. Everything in the volume, including its partition table, is copied, allowing you to make an exact image of a disk. The volumes do B actually need to reside on this server, but can be attached to any staging server in the zone. =cut sub dd { shift->manager->dd(@_); } =head2 $server->put($source1,$source2,$source3,...,$dest) Use rsync to copy the indicated source directories into the destination path indicated by $dest. The destination is either a path on the server machine, or a staging volume object mounted on the server (string interpolation is accepted). The sources can be local paths on the machine the perl script is running on, or any of the formats described for rsync(). Examples: $server1->put("$ENV{HOME}/my_pictures" => '/var/media'); $server1->put("$ENV{HOME}/my_pictures","$ENV{HOME}/my_audio" => '/var/media'); $server1->put("$ENV{HOME}/my_pictures" => "$backup_volume/home_media"); $server1->put("fred@gw.harvard.edu:media/" => "$backup_volume/home_media"); =cut # last argument is implied on this server sub put { my $self = shift; my @paths = @_; @paths >= 2 or croak "usage: VM::EC2::Staging::Server->put(\$source1,\$source2...,\$dest)"; $paths[-1] =~ m/:/ && croak "invalid pathname; must not contain a hostname"; $paths[-1] = "$self:$paths[-1]" unless $paths[-1] =~ /^vol-[0-9a-f]{8}/; $self->manager->rsync(@paths); } =head2 $server->get($source1,$source2,$source3,...,$dest) Use rsync to copy the indicated source directories into the destination path indicated by $dest. The source directories are either paths on the server, or staging volume(s) mounted on the server (string interpolation to indicate subdirectories on the staging volume also works). The destination can be any of the path formats described for rsync(), including unmanaged hosts that accept ssh login. Examples: $server1->get('/var/media' =>"$ENV{HOME}/my_pictures"); $server1->get('/var/media','/usr/bin' => "$ENV{HOME}/test"); $server1->get("$backup_volume/home_media" => "$ENV{HOME}/my_pictures"); $server1->get("$backup_volume/home_media" => "fred@gw.harvard.edu:media/"); =cut # source arguments are implied on this server+ sub get { my $self = shift; my @paths = @_; @paths >= 2 or croak "usage: VM::EC2::Staging::Server->get(\$source1,\$source2...,\$dest)"; my $dest = pop @paths; foreach (@paths) { m/:/ && croak "invalid pathname; must not contain a hostname"; $_ = "$self:$_" unless /^vol-[0-9a-f]{8}/; } $self->manager->rsync(@paths,$dest); } sub _rsync_put { my $self = shift; my $rsync_args = shift; my @source = @_; my $dest = pop @source; # resolve symbolic name of $dest $dest =~ s/^.+://; # get rid of hostname, if it is there my $host = $self->instance->dnsName; my $ssh_args = $self->_ssh_escaped_args; $rsync_args ||= $self->manager->_rsync_args; $self->info("Beginning rsync @source $host:$dest ...\n"); my $dots = $self->manager->_dots_cmd; my $status = system("rsync $rsync_args -e'ssh $ssh_args' --rsync-path='sudo rsync' @source $host:$dest $dots") == 0; $self->info("...rsync done\n"); return $status; } sub _rsync_get { my $self = shift; my $rsync_args = shift; my @source = @_; my $dest = pop @source; # resolve symbolic names of src my $host = $self->instance->dnsName; foreach (@source) { (my $path = $_) =~ s/^.+://; # get rid of host part, if it is there $_ = "$host:$path"; } my $ssh_args = $self->_ssh_escaped_args; $rsync_args ||= $self->manager->_rsync_args; $self->info("Beginning rsync @source $host:$dest ...\n"); my $dots = $self->manager->_dots_cmd; my $status = system("rsync $rsync_args -e'ssh $ssh_args' --rsync-path='sudo rsync' @source $dest $dots")==0; $self->info("...rsync done\n"); return $status; } =head1 Internal Methods This section documents internal methods. They are not intended for use by end-user scripts but may be useful to know about during subclassing. There are also additional undocumented methods that begin with a "_" character which you can explore in the source code. =head2 $description = $server->volume_description($vol) This method is called to get the value of the Name tag assigned to new staging volume objects. The current value is "Staging volume for $name created by VM::EC2::Staging::Server." You will see these names associated with EBS volumes in the AWS console. =cut sub volume_description { my $self = shift; my $vol = shift; my $name = ref $vol ? $vol->name : $vol; return "Staging volume for $name created by ".__PACKAGE__; } =head2 ($ebs_device,$local_device) = $server->unused_block_device([$major_start]) This method returns an unused block device path. It is invoked when provisioning and mounting new volumes. The behavior is to take the following search path: /dev/sdf1 /dev/sdf2 ... /dev/sdf15 /dev/sdfg1 ... /dev/sdp15 You can modify the search path slightly by providing a single character major start. For example, to leave all the sdf's free and to start the search at /dev/sdg: ($ebs_device,$local_device) = $server->unused_block_device('g'); The result is a two element list consisting of the unused device name from the perspective of EC2 and the server respectively. The issue here is that on some recent Linux kernels, the EC2 device /dev/sdf1 is known to the server as /dev/xvdf1. This module understands that complication and uses the EC2 block device name when managing EBS volumes, and the kernel block device name when communicating with the server. =cut # find an unused block device sub unused_block_device { my $self = shift; my $major_start = shift || 'f'; my @devices = $self->scmd('ls -1 /dev/sd?* /dev/xvd?* 2>/dev/null'); return unless @devices; my %used = map {$_ => 1} @devices; my $base = $used{'/dev/sda1'} ? "/dev/sd" : $used{'/dev/xvda1'} ? "/dev/xvd" : ''; die "Device list contains neither /dev/sda1 nor /dev/xvda1; don't know how blocks are named on this system" unless $base; my $ebs = '/dev/sd'; for my $major ($major_start..'p') { for my $minor (1..15) { my $local_device = "${base}${major}${minor}"; next if $used{$local_device}++; my $ebs_device = "/dev/sd${major}${minor}"; return ($ebs_device,$local_device); } } return; } =head2 $flag = $server->has_key($keyname) Returns true if the server has a copy of the private key corresponding to $keyname. This is used by the rsync() method to enable server to server data transfers. =cut sub has_key { my $self = shift; my $keyname = shift; $self->{_has_key}{$keyname} = shift if @_; return $self->{_has_key}{$keyname} if exists $self->{_has_key}{$keyname}; return $self->{_has_key}{$keyname} = $self->scmd("if [ -e $keyname ]; then echo 1; fi"); } =head2 $flag = $server->accepts_key($keyname) Returns true if the server has a copy of the public key part of $keyname in its .ssh/authorized_keys file. This is used by the rsync() method to enable server to server data transfers. =cut sub accepts_key { my $self = shift; my $keyname = shift; $self->{_accepts_key}{$keyname} = shift if @_; return $self->{_accepts_key}{$keyname}; } =head2 $up = $server->is_up([$new_value]) Get/set the internal is_up() flag, which indicates whether the server is up and running. This is used to cache the results of the ping() method. =cut sub is_up { my $self = shift; my $d = $self->{_is_up}; $self->{_is_up} = shift if @_; $d; } =head2 $path = $server->default_mtpt($volume) Given a staging volume, return its default mount point on the server ('/mnt/Staging/'.$volume->name). Can also pass a string corresponding to the volume's name. =cut sub default_mtpt { my $self = shift; my $vol = shift; my $name = ref $vol ? $vol->name : $vol; return "/mnt/Staging/$name"; } =head2 $server->info(@message) Log a message to standard output, respecting the staging manager's verbosity() setting. =cut sub info { my $self = shift; $self->manager->info(@_); } =head1 Subclassing For reasons having to do with the order in which objects are created, VM::EC2::Staging::Server is a wrapper around VM::EC2::Instance rather than a subclass of it. To access the VM::EC2::Instance object, you call the server object's instance() method. In practice this means that to invoke the underlying instance's method for, say, start() you will need to do this: $server->instance->start(); rather than this: $server->SUPER::start(); You may subclass VM::EC2::Staging::Server in the usual way. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut 1; VM-EC2-1.23/lib/VM/EC2/Staging/Manager.pm000444001751001751 25647512100273360 17470 0ustar00lsteinlstein000000000000package VM::EC2::Staging::Manager; =head1 NAME VM::EC2::Staging::Manager - Automate VMs and volumes for moving data in and out of cloud. =head1 SYNOPSIS use VM::EC2::Staging::Manager; my $ec2 = VM::EC2->new(-region=>'us-east-1'); my $staging = $ec2->staging_manager(-on_exit => 'stop', # default, stop servers when process exists -verbose => 1, # default, verbose progress messages -scan => 1, # default, scan region for existing staging servers and volumes -image_name => 'ubuntu-precise-12.04', # default server image -user_name => 'ubuntu', # default server login name ); # Assuming an EBS image named ami-12345 is located in the US, copy it into # the South American region, returning the AMI ID in South America my $new_image = $staging->copy_image('ami-12345','sa-east-1'); # provision a new server, using defaults. Name will be assigned automatically my $server = $staging->provision_server(-availability_zone => 'us-east-1a'); # retrieve a new server named "my_server", if one exists. If not, it creates one # using the specified options my $server = $staging->get_server(-name => 'my_server', -availability_zone => 'us-east-1a', -instance_type => 't1.micro'); # open up an ssh session in an xterm $server->shell; # run a command over ssh on the server. See VM::EC2::Staging::Server $server->ssh('whoami'); # run a command over ssh on the server, returning the result as an array of lines or a # scalar string, similar to backticks (``) my @password_lines = $server->scmd('cat /etc/passwd'); # run a command on the server and read from it using a filehandle my $fh = $server->scmd_read('ls -R /usr/lib'); while (<$fh>) { # do something } # run a command on the server and write to it using a filehandle my $fh = $server->scmd_write('sudo -s "cat >>/etc/fstab"'); print $fh "/dev/sdf3 /mnt/demo ext3 0 2\n"; close $fh; # Provision a new volume named "Pictures". Will automatically be mounted to a staging server in # the specified zone. Server will be created if needed. my $volume = $staging->provision_volume(-name => 'Pictures', -fstype => 'ext4', -availability_zone => 'us-east-1a', -size => 2) or die $staging->error_str; # gets an existing volume named "Pictures" if it exists. Otherwise provisions a new volume; my $volume = $staging->get_volume(-name => 'Pictures', -fstype => 'ext4', -availability_zone => 'us-east-1a', -size => 2) or die $staging->error_str; # copy contents of local directory /opt/test to remote volume $volume using rsync # See VM::EC2::Staging::Volume $volume->put('/opt/test/'); # same thing, but first creating a subdirectory on the remote volume $volume->put('/opt/test/' => './mirrors/'); # copy contents of remote volume $volume to local directory /tmp/test using rsync $volume->get('/tmp/test'); # same thing, but from a subdirectory of the remote volume $volume->get('./mirrors/' => '/tmp/test'); # server to server transfer (works both within and between availability regions) my $south_america = VM::EC2->new(-region=>'sa-east-1')->staging_manager; # create a staging manager in Sao Paolo my $volume2 = $south_america->provision_volume(-name => 'Videos', -availability_zone => 'sa-east-1a', -size => 2); $staging->rsync("$volume/mirrors" => "$volume2/us-east"); $staging->stop_all_servers(); $staging->start_all_servers(); $staging->terminate_all_servers(); $staging->force_terminate_all_servers(); =head1 DESCRIPTION VM::EC2::Staging::Manager manages a set of EC2 volumes and servers in a single AWS region. It was primarily designed to simplify the process of provisioning and populating volumes, but it also provides a handy set of ssh commands that allow you to run remote commands programmatically. The manager also allows you to copy EBS-backed AMIs and their attached volumes from one region to another, something that is otherwise difficult to do. The main classes are: VM::EC2::Staging::Manager -- A set of volume and server resources in a single AWS region. VM::EC2::Staging::Server -- A staging server running somewhere in the region. It is a VM::EC2::Instance extended to provide remote command and copy facilities. VM::EC2::Staging::Volume -- A staging disk volume running somewhere in the region. It is a VM::EC2::Volume extended to provide remote copy facilities. Staging servers can provision volumes, format them, mount them, copy data between local and remote (virtual) machines, and execute secure shell commands. Staging volumes can mount themselves on servers, run a variety of filesystem-oriented commands, and invoke commands on the servers to copy data around locally and remotely. See L and L for the full details. =head1 Constructors The following methods allow you to create new VM::EC2::Staging::Manager instances. Be aware that only one manager is allowed per EC2 region; attempting to create additional managers in the same region will return the same one each time. =cut use strict; use VM::EC2; use Carp 'croak','longmess'; use File::Spec; use File::Path 'make_path','remove_tree'; use File::Basename 'dirname','basename'; use Scalar::Util 'weaken'; use String::Approx 'adistr'; use File::Temp 'tempfile'; use constant GB => 1_073_741_824; use constant SERVER_STARTUP_TIMEOUT => 120; use constant LOCK_TIMEOUT => 10; use constant VERBOSE_DEBUG => 3; use constant VERBOSE_INFO => 2; use constant VERBOSE_WARN => 1; my (%Zones,%Instances,%Volumes,%Managers); my $Verbose; my ($LastHost,$LastMt); =head2 $manager = $ec2->staging_manager(@args) This is a simplified way to create a staging manager. First create the EC2 object in the desired region, and then call its staging_manager() method: $manager = VM::EC2->new(-region=>'us-west-2')->staging_manager() The staging_manager() method is only known to VM::EC2 objects if you first "use" VM::EC2::Staging::Manager. =over 4 =item Required Arguments None. =item Optional Arguments The optional arguments change the way that the manager creates new servers and volumes. -on_exit What to do with running servers when the manager goes out of scope or the script exits. One of 'run', 'stop' (default), or 'terminate'. "run" keeps all created instances running, so beware! -architecture Architecture for newly-created server instances (default "i386"). Can be overridden in calls to get_server() and provision_server(). -instance_type Type of newly-created servers (default "m1.small"). Can be overridden in calls to get_server() and provision_server(). -root_type Root type for newly-created servers (default depends on the -on_exit behavior; "ebs" for exit behavior of "stop" and "instance-store" for exit behavior of "run" or "terminate". -image_name Name or ami ID of the AMI to use for creating the instances of new servers. Defaults to 'ubuntu-precise-12.04'. If the image name begins with "ami-", then it is treated as an AMI ID. Otherwise it is treated as a name pattern and will be used to search the AMI name field using the wildcard search "*$name*". Names work better than AMI ids here, because the latter change from one region to another. If multiple matching image candidates are found, then an alpha sort on the name is used to find the image with the highest alpha sort value, which happens to work with Ubuntu images to find the latest release. -availability_zone Availability zone for newly-created servers. Default is undef, in which case a random zone is selected. -username Username to use for ssh connections. Defaults to "ubuntu". Note that this user must be able to use sudo on the instance without providing a password, or functionality of this module will be limited. -verbose Integer level of verbosity. Level 1 prints warning messages. Level 2 (the default) adds informational messages as well. Level 3 adds verbose debugging messages. Level 0 suppresses all messages. -quiet (deprecated) If true, turns off all verbose messages. -scan Boolean, default true. If true, scans region for volumes and servers created by earlier manager instances. -reuse_key Boolean, default true. If true, creates a single ssh keypair for each region and reuses it. Note that the private key is kept on the local computer in the directory ~/.vm-ec2-staging, and so additional keypairs may be created if you use this module on multiple local machines. If this option is false, then a new keypair will be created for every server you partition. -reuse_volumes Boolean, default true. If this flag is true, then calls to provision_volume() will return existing volumes if they share the same name as the requested volume. If no suitable existing volume exists, then the most recent snapshot of this volume is used to create it in the specified availability zone. Only if no volume or snapshot exist will a new volume be created from scratch. -dotdir Path to the directory that contains keyfiles and other stable configuration information for this module. Defaults to ~/.vm_ec2_staging. You may wish to change this to, say, a private dropbox directory or an NFS-mount in order to share keyfiles among machines. Be aware of the security implications of sharing private key files. -server_class By default, staging server objects created by the manager are of class type VM::EC2::Staging::Server. If you create a custom server subclass, you need to let the manager know about it by passing the class name to this argument. -volume_class By default, staging volume objects created by the manager are of class type VM::EC2::Staging::Volume. If you create a custom volume subclass, you need to let the manager know about it by passing the class name to this argument. =back =head2 $manager = VM::EC2::Staging::Manager(-ec2 => $ec2,@args) This is a more traditional constructur for the staging manager. =over 4 =item Required Arguments -ec2 A VM::EC2 object. =item Optional Arguments All of the arguments listed in the description of VM::EC2->staging_manager(). =back =cut sub VM::EC2::staging_manager { my $self = shift; return VM::EC2::Staging::Manager->new(@_,-ec2=>$self) } sub new { my $self = shift; my %args = @_; $args{-ec2} ||= VM::EC2->new(); if (my $manager = $self->find_manager($args{-ec2}->endpoint)) { return $manager; } $args{-on_exit} ||= $self->default_exit_behavior; $args{-reuse_key} ||= $self->default_reuse_keys; $args{-username} ||= $self->default_user_name; $args{-architecture} ||= $self->default_architecture; $args{-root_type} ||= $self->default_root_type; $args{-instance_type} ||= $self->default_instance_type; $args{-reuse_volumes} ||= $self->default_reuse_volumes; $args{-image_name} ||= $self->default_image_name; $args{-availability_zone} ||= undef; $args{-verbose} = $self->default_verbosity unless exists $args{-verbose}; $args{-scan} = 1 unless exists $args{-scan}; $args{-pid} = $$; $args{-dotdir} ||= $self->default_dot_directory_path; $args{-volume_class} ||= $self->default_volume_class; $args{-server_class} ||= $self->default_server_class; $args{-verbose} = 0 if $args{-quiet}; # bring in classes foreach ('-server_class','-volume_class') { eval "use $args{$_};1" or croak "Can't use $args{$_}" unless $args{$_}->can('new'); } # create accessors my $class = ref $self || $self; foreach (keys %args) { (my $func_name = $_) =~ s/^-//; next if $self->can($func_name); eval <{$_}; \$self->{$_} = shift if \@_; return \$d; } END die $@ if $@; } $Verbose = $args{-verbose}; # package global, for a few edge cases my $obj = bless \%args,ref $class || $class; weaken($Managers{$obj->ec2->endpoint} = $obj); if ($args{-scan}) { $obj->info("Scanning for existing staging servers and volumes in ",$obj->ec2->endpoint,".\n"); $obj->scan_region; } return $obj; } # class method # the point of this somewhat odd way of storing managers is to ensure that there is only one # manager per endpoint, and to avoid circular references in the Server and Volume objects. sub find_manager { my $class = shift; my $endpoint = shift; return unless $endpoint; return $Managers{$endpoint}; } =head1 Interzone Copying of AMIs and Snapshots This library provides convenience methods for copying whole AMIs as well as individual snapshots from one zone to another. It does this by gathering information about the AMI/snapshot in the source zone, creating staging servers in the source and target zones, and then copying the volume data from the source to the target. If an AMI/snapshot does not use a recognized filesystem (e.g. it is part of an LVM or RAID disk set), then block level copying of the entire device is used. Otherwise, rsync() is used to minimize data transfer fees. Note that interzone copying of instance-backed AMIs is B supported. Only EBS-backed images can be copied in this way. See also the command-line script migrate-ebs-image.pl that comes with this package. =head2 $new_image_id = $manager->copy_image($source_image,$destination_zone,@register_options) This method copies the AMI indicated by $source_image from the zone that $manager belongs to, into the indicated $destination_zone, and returns the AMI ID of the new image in the destination zone. $source_image may be an AMI ID, or a VM::EC2::Image object. $destination_zone may be a simple region name, such as "us-west-2", or a VM::EC2::Region object (as returned by VM::EC2->describe_regions), or a VM::EC2::Staging::Manager object that is associated with the desired region. The latter form gives you control over the nature of the staging instances created in the destination zone. For example, if you wish to use 'm1.large' high-I/O instances in both the source and destination reasons, you would proceed like this: my $source = VM::EC2->new(-region=>'us-east-1' )->staging_manager(-instance_type=>'m1.large', -on_exit =>'terminate'); my $destination = VM::EC2->new(-region=>'us-west-2' )->staging_manager(-instance_type=>'m1.large', -on_exit =>'terminate'); my $new_image = $source->copy_image('ami-123456' => $destination); If present, the named argument list @register_options will be passed to register_image() and used to override options in the destination image. This can be used to set ephemeral device mappings, which cannot currently be detected and transferred automatically by copy_image(): $new_image =$source->copy_image('ami-123456' => 'us-west-2', -description => 'My AMI western style', -block_devices => '/dev/sde=ephemeral0'); =head2 $dest_kernel = $manager->match_kernel($src_kernel,$dest_zone) Find a kernel in $dest_zone that matches the $src_kernel in the current zone. $dest_zone can be a VM::EC2::Staging manager object, a region name, or a VM::EC2::Region object. =cut ############################################# # copying AMIs from one zone to another ############################################# sub copy_image { my $self = shift; my ($imageId,$destination,@options) = @_; my $ec2 = $self->ec2; my $image = ref $imageId && $imageId->isa('VM::EC2::Image') ? $imageId : $ec2->describe_images($imageId); $image or croak "Unknown image '$imageId'"; $image->imageType eq 'machine' or croak "$image is not an AMI"; # $image->platform eq 'windows' # and croak "It is not currently possible to migrate Windows images between regions via this method"; $image->rootDeviceType eq 'ebs' or croak "It is not currently possible to migrate instance-store backed images between regions via this method"; my $dest_manager = $self->_parse_destination($destination); my $root_type = $image->rootDeviceType; if ($root_type eq 'ebs') { return $self->_copy_ebs_image($image,$dest_manager,\@options); } else { return $self->_copy_instance_image($image,$dest_manager,\@options); } } =head2 $new_snapshot_id = $manager->copy_snapshot($source_snapshot,$destination_zone) This method copies the EBS snapshot indicated by $source_snapshot from the zone that $manager belongs to, into the indicated $destination_zone, and returns the ID of the new snapshot in the destination zone. $source_snapshot may be an string ID, or a VM::EC2::Snapshot object. $destination_zone may be a simple region name, such as "us-west-2", or a VM::EC2::Region object (as returned by VM::EC2->describe_regions), or a VM::EC2::Staging::Manager object that is associated with the desired region. Note that this call uses the Amazon CopySnapshot API call that was introduced in 2012-12-01 and no longer involves the creation of staging servers in the source and destination regions. =cut sub copy_snapshot { my $self = shift; my ($snapId,$dest_manager) = @_; my $snap = $self->ec2->describe_snapshots($snapId) or croak "Couldn't find snapshot for $snapId"; my $description = "duplicate of $snap, created by ".__PACKAGE__." during snapshot copying"; my $dest_region = ref($dest_manager) && $dest_manager->can('ec2') ? $dest_manager->ec2->region : "$dest_manager"; $self->info("Copying snapshot $snap from ",$self->ec2->region," to $dest_region...\n"); my $snapshot = $snap->copy(-region => $dest_region, -description => $description); while (!eval{$snapshot->current_status}) { sleep 1; } $self->info("...new snapshot = $snapshot; status = ",$snapshot->current_status,"\n"); # copy snapshot tags my $tags = $snap->tags; $snapshot->add_tags($tags); return $snapshot; } sub _copy_instance_image { my $self = shift; croak "This module is currently unable to copy instance-backed AMIs between regions.\n"; } sub _copy_ebs_image { my $self = shift; my ($image,$dest_manager,$options) = @_; # apply overrides my %overrides = @$options if $options; # hashref with keys 'name', 'description','architecture','kernel','ramdisk','block_devices','root_device' # 'is_public','authorized_users' $self->info("Gathering information about image $image.\n"); my $info = $self->_gather_image_info($image); my $name = $info->{name}; my $description = $info->{description}; my $architecture = $info->{architecture}; my $root_device = $info->{root_device}; my $platform = $info->{platform}; my ($kernel,$ramdisk); # make sure we have a suitable image in the destination region # if the virtualization type is HVM my $is_hvm = $image->virtualization_type eq 'hvm'; if ($is_hvm) { $self->_find_hvm_image($dest_manager->ec2, $root_device, $architecture, $platform) or croak "Destination region ",$dest_manager->ec2->region," does not currently support HVM images of this type"; } if ($info->{kernel} && !$overrides{-kernel}) { $self->info("Searching for a suitable kernel in the destination region.\n"); $kernel = $self->_match_kernel($info->{kernel},$dest_manager,'kernel') or croak "Could not find an equivalent kernel for $info->{kernel} in region ",$dest_manager->ec2->endpoint; $self->info("Matched kernel $kernel\n"); } if ($info->{ramdisk} && !$overrides{-ramdisk}) { $self->info("Searching for a suitable ramdisk in the destination region.\n"); $ramdisk = ( $self->_match_kernel($info->{ramdisk},$dest_manager,'ramdisk') || $dest_manager->_guess_ramdisk($kernel) ) or croak "Could not find an equivalent ramdisk for $info->{ramdisk} in region ",$dest_manager->ec2->endpoint; $self->info("Matched ramdisk $ramdisk\n"); } my $block_devices = $info->{block_devices}; # format same as $image->blockDeviceMapping $self->info("Copying EBS volumes attached to this image (this may take a long time).\n"); my @bd = @$block_devices; my %dest_snapshots = map { $_->snapshotId ? ($_->snapshotId => $self->copy_snapshot($_->snapshotId,$dest_manager)) : () } @bd; $self->info("Waiting for all snapshots to complete. This may take a long time.\n"); my $state = $dest_manager->ec2->wait_for_snapshots(values %dest_snapshots); my @errored = grep {$state->{$_} eq 'error'} values %dest_snapshots; croak ("Snapshot(s) @errored could not be completed due to an error") if @errored; # create the new block device mapping my @mappings; for my $source_ebs (@$block_devices) { my $dest = "$source_ebs"; # interpolates into correct format $dest =~ s/=([\w-]+)/'='.($dest_snapshots{$1}||$1)/e; # replace source snap with dest snap push @mappings,$dest; } # ensure choose a unique name if ($dest_manager->ec2->describe_images({name => $name})) { print STDERR "An image named '$name' already exists in destination region. "; $name = $self->_token($name); print STDERR "Renamed to '$name'\n"; } # merge block device mappings if present if (my $m = $overrides{-block_device_mapping}||$overrides{-block_devices}) { push @mappings,(ref $m ? @$m : $m); delete $overrides{-block_device_mapping}; delete $overrides{-block_devices}; } # helpful for recovering failed process my $block_device_info_args = join ' ',map {"-b $_"} @mappings; my $img; if ($is_hvm) { $self->info("Registering snapshot in destination with the equivalent of:\n"); $self->info("ec2-register -n '$name' -d '$description' -a $architecture --virtualization-type hvm --root-device-name $root_device $block_device_info_args\n"); $self->info("Note: this is a notional command line that can only be used by AWS development partners.\n"); $img = $self->_create_hvm_image(-ec2 => $dest_manager->ec2, -name => $name, -root_device_name => $root_device, -block_device_mapping => \@mappings, -description => $description, -architecture => $architecture, -platform => $image->platform, %overrides); } else { $self->info("Registering snapshot in destination with the equivalent of:\n"); $self->info("ec2-register -n '$name' -d '$description' -a $architecture --kernel '$kernel' --ramdisk '$ramdisk' --root-device-name $root_device $block_device_info_args\n"); $img = $dest_manager->ec2->register_image(-name => $name, -root_device_name => $root_device, -block_device_mapping => \@mappings, -description => $description, -architecture => $architecture, $kernel ? (-kernel_id => $kernel): (), $ramdisk ? (-ramdisk_id => $ramdisk): (), %overrides, ); $img or croak "Could not register image: ",$dest_manager->ec2->error_str; } # copy launch permissions $img->make_public(1) if $info->{is_public}; $img->add_authorized_users(@{$info->{authorized_users}}) if @{$info->{authorized_users}}; # copy tags my $tags = $image->tags; $img->add_tags($tags); # Improve the snapshot tags my $source_region = $self->ec2->region; my $dest_region = $dest_manager->ec2->region; for (@mappings) { my ($snap) = /(snap-[0=9a-f]+)/ or next; $snap = $dest_manager->ec2->describe_snapshots($snap) or next; $snap->add_tags(Name => "Copy image $image($source_region) to $img($dest_region)"); } return $img; } # copying an HVM image requires us to: # 1. Copy each of the snapshots to the destination region # 2. Find a public HVM image in the destination region that matches the architecture, hypervisor type, # and root device type of the source image. (note: platform must not be 'windows' # 3. Run a cc2 instance: "cc2.8xlarge", but replace default block device mapping with the new snapshots. # 4. Stop the image. # 5. Detach the root volume # 6. Initialize and attach a new root volume from the copied source root snapshot. # 7. Run create_image() on the instance. # 8. Terminate the instance and clean up. sub _create_hvm_image { my $self = shift; my %args = @_; my $ec2 = $args{-ec2}; # find a suitable image that we can run $self->info("Searching for a suitable HVM image in destination region\n"); my $ami = $self->_find_hvm_image($ec2,$args{-root_device_name},$args{-architecture},$args{-platform}); $ami or croak "Could not find suitable HVM image in region ",$ec2->region; $self->info("...Found $ami (",$ami->name,")\n"); # remove root device from the block device list my $root = $args{-root_device_name}; my @nonroot_devices = grep {!/^$root/} @{$args{-block_device_mapping}}; my ($root_snapshot) = "@{$args{-block_device_mapping}}" =~ /$root=(snap-[0-9a-f]+)/; my $instance_type = $args{-platform} eq 'windows' ? 'm1.small' : 'cc2.8xlarge'; $self->info("Launching an HVM staging server in the target region. Heuristically choosing instance type of '$instance_type' for this type of HVM..\n"); my $instance = $ec2->run_instances(-instance_type => $instance_type, -image_id => $ami, -block_devices => \@nonroot_devices) or croak "Could not run HVM instance: ",$ec2->error_str; $self->info("Waiting for instance to become ready.\n"); $ec2->wait_for_instances($instance); $self->info("Stopping instance temporarily to swap root volumes.\n"); $instance->stop(1); $self->info("Detaching original root volume...\n"); my $a = $instance->detach_volume($root) or croak "Could not detach $root: ", $ec2->error_str; $ec2->wait_for_attachments($a); $a->current_status eq 'detached' or croak "Could not detach $root, status = ",$a->current_status; $ec2->delete_volume($a->volumeId) or croak "Could not delete original root volume: ",$ec2->error_str; $self->info("Creating and attaching new root volume..\n"); my $vol = $ec2->create_volume(-availability_zone => $instance->placement, -snapshot_id => $root_snapshot) or croak "Could not create volume from root snapshot $root_snapshot: ",$ec2->error_str; $ec2->wait_for_volumes($vol); $vol->current_status eq 'available' or croak "Volume creation failed, status = ",$vol->current_status; $a = $instance->attach_volume($vol,$root) or croak "Could not attach new root volume: ",$ec2->error_str; $ec2->wait_for_attachments($a); $a->current_status eq 'attached' or croak "Attach failed, status = ",$a->current_status; $a->deleteOnTermination(1); $self->info("Creating image in destination region...\n"); my $img = $instance->create_image($args{-name},$args{-description}); # get rid of the original copied snapshots - we no longer need them foreach (@{$args{-block_device_mapping}}) { my ($snapshot) = /(snap-[0-9a-f]+)/ or next; $ec2->delete_snapshot($snapshot) or $self->warn("Could not delete unneeded snapshot $snapshot; please delete manually: ",$ec2->error_str) } # terminate the staging server. $self->info("Terminating the staging server\n"); $instance->terminate; # this will delete the volume as well because of deleteOnTermination return $img; } sub _find_hvm_image { my $self = shift; my ($ec2,$root_device_name,$architecture,$platform) = @_; my $cache_key = join (';',@_); return $self->{_hvm_image}{$cache_key} if exists $self->{_hvm_image}{$cache_key}; my @i = $ec2->describe_images(-executable_by=> 'all', -owner => 'amazon', -filter => { 'virtualization-type' => 'hvm', 'root-device-type' => 'ebs', 'root-device-name' => $root_device_name, 'architecture' => $architecture, }); @i = grep {$_->platform eq $platform} @i; return $self->{_hvm_image}{$cache_key} = $i[0]; } =head1 Instance Methods for Managing Staging Servers These methods allow you to create and interrogate staging servers. They each return one or more VM::EC2::Staging::Server objects. See L for more information about what you can do with these servers once they are running. =head2 $server = $manager->provision_server(%options) Create a new VM::EC2::Staging::Server object according to the passed options, which override the default options provided by the Manager object. -name Name for this server, which can be used to retrieve it later with a call to get_server(). -architecture Architecture for the newly-created server instances (e.g. "i386"). If not specified, then defaults to the default_architecture() value. If explicitly specified as undef, then the architecture of the matching image will be used. -instance_type Type of the newly-created server (e.g. "m1.small"). -root_type Root type for the server ("ebs" or "instance-store"). -image_name Name or ami ID of the AMI to use for creating the instance for the server. If the image name begins with "ami-", then it is treated as an AMI ID. Otherwise it is treated as a name pattern and will be used to search the AMI name field using the wildcard search "*$name*". Names work better than AMI ids here, because the latter change from one region to another. If multiple matching image candidates are found, then an alpha sort on the name is used to find the image with the highest alpha sort value, which happens to work with Ubuntu images to find the latest release. -availability_zone Availability zone for the server, or undef to choose an availability zone randomly. -username Username to use for ssh connections. Defaults to "ubuntu". Note that this user must be able to use sudo on the instance without providing a password, or functionality of this server will be limited. In addition, you may use any of the options recognized by VM::EC2->run_instances() (e.g. -block_devices). =cut sub provision_server { my $self = shift; my @args = @_; # let subroutine arguments override manager's args my %args = ($self->_run_instance_args,@args); # fix possible gotcha -- instance store is not allowed for micro instances. $args{-root_type} = 'ebs' if $args{-instance_type} eq 't1.micro'; $args{-name} ||= $self->new_server_name; my ($keyname,$keyfile) = $self->_security_key; my $security_group = $self->_security_group; my $image = $self->_search_for_image(%args) or croak "No suitable image found"; $args{-architecture} = $image->architecture; my ($instance) = $self->ec2->run_instances( -image_id => $image, -security_group_id => $security_group, -key_name => $keyname, %args, ); $instance or croak $self->ec2->error_str; my $success; while (!$success) { # race condition... $success = eval{ $instance->add_tags(StagingRole => 'StagingInstance', Name => "Staging server $args{-name} created by ".__PACKAGE__, StagingUsername => $self->username, StagingName => $args{-name}); } } my $class = $args{-server_class} || $self->server_class; my $server = $class->new( -keyfile => $keyfile, -username => $self->username, -instance => $instance, -manager => $self, -name => $args{-name}, @args, ); eval { local $SIG{ALRM} = sub {die 'timeout'}; alarm(SERVER_STARTUP_TIMEOUT); $self->wait_for_servers($server); }; alarm(0); croak "server did not start after ",SERVER_STARTUP_TIMEOUT," seconds" if $@ =~ /timeout/; $self->register_server($server); return $server; } sub _run_instance_args { my $self = shift; my @args; for my $arg (qw(instance_type availability_zone architecture image_name root_type)) { push @args,("-${arg}" => $self->$arg); } return @args; } =head2 $server = $manager->get_server(-name=>$name,%other_options) =head2 $server = $manager->get_server($name) Return an existing VM::EC2::Staging::Server object having the indicated symbolic name, or create a new server if one with this name does not already exist. The server's instance characteristics will be configured according to the options passed to the manager at create time (e.g. -availability_zone, -instance_type). These options can be overridden by %other_args. See provision_volume() for details. =cut sub get_server { my $self = shift; unshift @_,'-name' if @_ == 1; my %args = @_; $args{-name} ||= $self->new_server_name; # find servers of same name local $^W = 0; # prevent an uninitialized value warning my %servers = map {$_->name => $_} $self->servers; my $server = $servers{$args{-name}} || $self->provision_server(%args); # this information needs to be renewed each time $server->username($args{-username}) if $args{-username}; bless $server,$args{-server_class} if $args{-server_class}; $server->start unless $server->ping; return $server; } =head2 $server = $manager->get_server_in_zone(-zone=>$availability_zone,%other_options) =head2 $server = $manager->get_server_in_zone($availability_zone) Return an existing VM::EC2::Staging::Server running in the indicated symbolic name, or create a new server if one with this name does not already exist. The server's instance characteristics will be configured according to the options passed to the manager at create time (e.g. -availability_zone, -instance_type). These options can be overridden by %other_args. See provision_server() for details. =cut sub get_server_in_zone { my $self = shift; unshift @_,'-availability_zone' if @_ == 1; my %args = @_; my $zone = $args{-availability_zone}; if ($zone && (my $servers = $Zones{$zone}{Servers})) { my $server = (values %{$servers})[0]; $server->start unless $server->is_up; return $server; } else { return $self->provision_server(%args); } } =head2 $server = $manager->find_server_by_instance($instance_id) Given an EC2 instanceId, return the corresponding VM::EC2::Staging::Server, if any. =cut sub find_server_by_instance { my $self = shift; my $server = shift; return $Instances{$server}; } =head2 @servers $manager->servers Return all registered VM::EC2::Staging::Servers in the zone managed by the manager. =cut sub servers { my $self = shift; my $endpoint = $self->ec2->endpoint; return $self->_servers($endpoint); } =head2 $manager->start_all_servers Start all VM::EC2::Staging::Servers that are currently in the "stop" state. =cut sub start_all_servers { my $self = shift; my @servers = $self->servers; my @need_starting = grep {$_->current_status eq 'stopped'} @servers; return unless @need_starting; eval { local $SIG{ALRM} = sub {die 'timeout'}; alarm(SERVER_STARTUP_TIMEOUT); $self->_start_instances(@need_starting); }; alarm(0); croak "some servers did not start after ",SERVER_STARTUP_TIMEOUT," seconds" if $@ =~ /timeout/; } =head2 $manager->stop_all_servers Stop all VM::EC2::Staging::Servers that are currently in the "running" state. =cut sub stop_all_servers { my $self = shift; my $ec2 = $self->ec2; my @servers = grep {$_->ec2 eq $ec2} $self->servers; @servers or return; $self->info("Stopping servers @servers.\n"); $self->ec2->stop_instances(@servers); $self->ec2->wait_for_instances(@servers); } =head2 $manager->terminate_all_servers Terminate all VM::EC2::Staging::Servers and unregister them. =cut sub terminate_all_servers { my $self = shift; my $ec2 = $self->ec2 or return; my @servers = $self->servers or return; $self->_terminate_servers(@servers); } =head2 $manager->force_terminate_all_servers Force termination of all VM::EC2::Staging::Servers, even if the internal registration system indicates that some may be in use by other Manager instances. =cut sub force_terminate_all_servers { my $self = shift; my $ec2 = $self->ec2 or return; my @servers = $self->servers or return; $ec2->terminate_instances(@servers) or warn $self->ec2->error_str; $ec2->wait_for_instances(@servers); } sub _terminate_servers { my $self = shift; my @servers = @_; my $ec2 = $self->ec2 or return; my @terminate; foreach (@servers) { my $in_use = $self->unregister_server($_); if ($in_use) { $self->warn("$_ is still in use. Will not terminate.\n"); next; } push @terminate,$_; } if (@terminate) { $self->info("Terminating servers @terminate.\n"); $ec2->terminate_instances(@terminate) or warn $self->ec2->error_str; $ec2->wait_for_instances(@terminate); } unless ($self->reuse_key) { $ec2->delete_key_pair($_) foreach $ec2->describe_key_pairs(-filter=>{'key-name' => 'staging-key-*'}); } } =head2 $manager->wait_for_servers(@servers) Wait until all the servers on the list @servers are up and able to accept ssh commands. You may wish to wrap this in an eval{} and timeout in order to avoid waiting indefinitely. =cut sub wait_for_servers { my $self = shift; my @instances = @_; my $status = $self->ec2->wait_for_instances(@instances); my %pending = map {$_=>$_} grep {$_->current_status eq 'running'} @instances; $self->info("Waiting for ssh daemon on @instances.\n") if %pending; while (%pending) { for my $s (values %pending) { unless ($s->ping) { sleep 5; next; } delete $pending{$s}; } } return $status; } sub _start_instances { my $self = shift; my @need_starting = @_; $self->info("starting instances: @need_starting.\n"); $self->ec2->start_instances(@need_starting); $self->wait_for_servers(@need_starting); } =head1 Instance Methods for Managing Staging Volumes These methods allow you to create and interrogate staging volumes. They each return one or more VM::EC2::Staging::Volume objects. See L for more information about what you can do with these staging volume objects. =head2 $volume = $manager->provision_volume(%options) Create and register a new VM::EC2::Staging::Volume and mount it on a staging server in the appropriate availability zone. A new staging server will be created for this purpose if one does not already exist. If you provide a symbolic name for the volume and the manager has previously snapshotted a volume by the same name, then the snapshot will be used to create the volume (this behavior can be suppressed by passing -reuse=>0). This allows for the following pattern for efficiently updating a snapshotted volume: my $vol = $manager->provision_volume(-name=>'MyPictures', -size=>10); $vol->put('/usr/local/my_pictures/'); # will do an rsync from local directory $vol->create_snapshot; # write out to a snapshot $vol->delete; You may also explicitly specify a volumeId or snapshotId. The former allows you to place an existing volume under management of VM::EC2::Staging::Manager and returns a corresponding staging volume object. The latter creates the staging volume from the indicated snapshot, irregardless of whether the snapshot was created by the staging manager at an earlier time. Newly-created staging volumes are automatically formatted as ext4 filesystems and mounted on the staging server under /mnt/Staging/$name, where $name is the staging volume's symbolic name. The filesystem type and the mountpoint can be modified with the -fstype and -mount arguments, respectively. In addition, you may specify an -fstype of "raw", in which case the volume will be attached to a staging server (creating the server first if necessary) but not formatted or mounted. This is useful when creating multi-volume RAID or LVM setups. Options: -name Name of the staging volume. A fatal error issues if a staging volume by this name already exists (use get_volume() to avoid this). If no name is provided, then a random unique one is chosen for you. -availability_zone Availability zone in which to create this volume. If none is specified, then a zone is chosen that reuses an existing staging server, if any. -size Size of the desired volume, in GB. -fstype Filesystem type for the volume, ext4 by default. Supported types are ext2, ext3, ext4, xfs, reiserfs, jfs, hfs, ntfs, vfat, msdos, and raw. -mount Mount point for this volume on the staging server (e.g. /opt/bin). Use with care, as there are no checks to prevent you from mounting two staging volumes on top of each other or mounting over essential operating system paths. -label Volume label. Only applies to filesystems that support labels (all except hfs, vfat, msdos and raw). -volume_id Create the staging volume from an existing EBS volume with the specified ID. Most other options are ignored in this case. -snapshot_id Create the staging volume from an existing EBS snapshot. If a size is specified that is larger than the snapshot, then the volume and its filesystem will be automatically extended (this only works for ext volumes at the moment). Shrinking of volumes is not currently supported. -reuse If true, then the most recent snapshot created from a staging volume of the same name is used to create the volume. This is the default. Pass 0 to disable this behavior. The B<-reuse> argument is intended to support the following use case in which you wish to rsync a directory on a host system somewhere to an EBS snapshot, without maintaining a live server and volume on EC2: my $volume = $manager->provision_volume(-name=>'backup_1', -reuse => 1, -fstype => 'ext3', -size => 10); $volume->put('fred@gw.harvard.edu:my_music'); $volume->create_snapshot('Music Backup '.localtime); $volume->delete; The next time this script is run, the "backup_1" volume will be recreated from the most recent snapshot, minimizing copying. A new snapshot is created, and the staging volume is deleted. =cut sub provision_volume { my $self = shift; my %args = @_; $args{-name} ||= $self->new_volume_name; $args{-size} ||= 1 unless $args{-snapshot_id} || $args{-volume_id}; $args{-volume_id} ||= undef; $args{-snapshot_id} ||= undef; $args{-reuse} = $self->reuse_volumes unless defined $args{-reuse}; $args{-mount} ||= '/mnt/Staging/'.$args{-name}; # BUG: "/mnt/Staging" is hardcoded in multiple places $args{-fstype} ||= 'ext4'; $args{-availability_zone} ||= $self->_select_used_zone; $args{-label} ||= $args{-name}; $self->find_volume_by_name($args{-name}) && croak "There is already a volume named $args{-name} in this region"; if ($args{-snapshot_id}) { $self->info("Provisioning volume from snapshot $args{-snapshot_id}.\n"); } elsif ($args{-volume_id}) { $self->info("Provisioning volume from volume $args{-volume_id}.\n"); my $v = $self->ec2->describe_volumes($args{-volume_id}); $args{-availability_zone} = $v->availabilityZone if $v; $args{-size} = $v->size if $v; } else { $self->info("Provisioning a new $args{-size} GB $args{-fstype} volume.\n"); } $args{-availability_zone} ? $self->info("Obtaining a staging server in zone $args{-availability_zone}.\n") : $self->info("Obtaining a staging server.\n"); my $server = $self->get_server_in_zone($args{-availability_zone}); $server->start unless $server->ping; my $volume = $server->provision_volume(%args); $self->register_volume($volume); return $volume; } =head2 $volume = $manager->get_volume(-name=>$name,%other_options) =head2 $volume = $manager->get_volume($name) Return an existing VM::EC2::Staging::Volume object with the indicated symbolic name, or else create a new volume if one with this name does not already exist. The volume's characteristics will be configured according to the options in %other_args. See provision_volume() for details. If called with no arguments, this method returns Volume object with default characteristics and a randomly-assigned name. =cut sub get_volume { my $self = shift; unshift @_,'-name' if @_ == 1; my %args = @_; $args{-name} ||= $self->new_volume_name; # find volume of same name my %vols = map {$_->name => $_} $self->volumes; my $vol = $vols{$args{-name}} || $self->provision_volume(%args); return $vol; } =head2 $result = $manager->rsync($src1,$src2,$src3...,$dest) This method provides remote synchronization (rsync) file-level copying between one or more source locations and a destination location via an ssh tunnel. Copying among arbitrary combinations of local and remote filesystems is supported, with the caveat that the remote filesystems must be contained on volumes and servers managed by this module (see below for a workaround). You may provide two or more directory paths. The last path will be treated as the copy destination, and the source paths will be treated as copy sources. All copying is performed using the -avz options, which activates recursive directory copying in which ownership, modification times and permissions are preserved, and compresses the data to reduce network usage. Verbosity is set so that the names of copied files are printed to STDERR. If you do not wish this, then use call the manager's quiet() method with a true value. Source paths can be formatted in one of several ways: /absolute/path Copy the contents of the directory /absolute/path located on the local machine to the destination. This will create a subdirectory named "path" on the destination disk. Add a slash to the end of the path (i.e. "/absolute/path/") in order to avoid creating this subdirectory on the destination disk. ./relative/path Relative paths work the way you expect, and depend on the current working directory. The terminating slash rule applies. $staging_volume Pass a VM::EC2::Staging::Volume to copy the contents of the volume to the destination disk starting at the root of the volume. Note that you do *not* need to have any knowledge of the mount point for this volume in order to copy its contents. $staging_volume:/absolute/path $staging_volume:absolute/path $staging_volume/absolute/path All these syntaxes accomplish the same thing, which is to copy a subdirectory of a staging volume to the destination disk. The root of the volume is its top level, regardless of where it is mounted on the staging server. Because of string interpolation magic, you can enclose staging volume object names in quotes in order to construct the path, as in "$picture_volume:/family/vacations/". As in local paths, a terminating slash indicates that the contents of the last directory in the path are to be copied without creating the enclosing directory on the desetination. Note that you do *not* need to have any knowledge of the mount point for this volume in order to copy its contents. $staging_server:/absolute/path Pass a staging server object and absolute path to copy the contents of this path to the destination disk. Because of string interpolation you can include server objects in quotes: "$my_server:/opt" $staging_server:relative/path This form will copy data from paths relative to the remote user's home directory on the staging server. Typically not very useful, but supported. The same syntax is supported for destination paths, except that it makes no difference whether a path has a trailing slash or not. As with the rsync command, if you proceed a path with a single colon (:/my/path), it is a short hand to use the previous server/volume/host in the source list. When specifying multiple source directories, all source directories must reside on the same local or remote machine. This is legal: $manager->rsync("$picture_volume:/family/vacations", "$picture_volume:/family/picnics" => "$backup_volume:/recent_backups"); This is not: $manager->rsync("$picture_volume:/family/vacations", "$audio_volume:/beethoven" => "$backup_volume:/recent_backups"); When specifying multiple sources, you may give the volume or server once for the first source and then start additional source paths with a ":" to indicate the same volume or server is to be used: $manager->rsync("$picture_volume:/family/vacations", ":/family/picnics" => "$backup_volume:/recent_backups"); When copying to/from the local machine, the rsync process will run as the user that the script was launched by. However, on remote servers managed by the staging manager, the rsync process will run as superuser. The rsync() method will also accept regular remote DNS names and IP addresses, optionally preceded by a username: $manager->rsync("$picture_volume:/family/vacations" => 'fred@gw.harvard.edu:/tmp') When called in this way, the method does what it can to avoid prompting for a password or passphrase on the non-managed host (gw.harvard.edu in the above example). This includes turning off strict host checking and forwarding the user agent information from the local machine. =head2 $result = $manager->rsync(\@options,$src1,$src2,$src3...,$dest) This is a variant of the rsync command in which extra options can be passed to rsync by providing an array reference as the first argument. For example: $manager->rsync(['--exclude' => '*~'], '/usr/local/backups', "$my_server:/usr/local"); =cut # most general form # sub rsync { my $self = shift; croak "usage: VM::EC2::Staging::Manager->rsync(\$source_path1,\$source_path2\...,\$dest_path)" unless @_ >= 2; my @p = @_; my @user_args = ($p[0] && ref($p[0]) eq 'ARRAY') ? @{shift @p} : (); undef $LastHost; undef $LastMt; my @paths = map {$self->_resolve_path($_)} @p; my $dest = pop @paths; my @source = @paths; my %hosts; local $^W=0; # avoid uninit value errors foreach (@source) { $hosts{$_->[0]} = $_->[0]; } croak "More than one source host specified" if keys %hosts > 1; my ($source_host) = values %hosts; my $dest_host = $dest->[0]; my @source_paths = map {$_->[1]} @source; my $dest_path = $dest->[1]; my $rsync_args = $self->_rsync_args; my $dots; if ($self->verbosity == VERBOSE_INFO) { $rsync_args .= 'v'; # print a line for each file $dots = '2>&1|/tmp/dots.pl t'; } $rsync_args .= ' '.join ' ', map {_quote_shell($_)} @user_args if @user_args; my $src_is_server = $source_host && UNIVERSAL::isa($source_host,'VM::EC2::Staging::Server'); my $dest_is_server = $dest_host && UNIVERSAL::isa($dest_host,'VM::EC2::Staging::Server'); # this is true when one of the paths contains a ":", indicating an rsync # path that contains a hostname, but not a managed server my $remote_path = "@source_paths $dest_path" =~ /:/; # remote rsync on either src or dest server if ($remote_path && ($src_is_server || $dest_is_server)) { my $server = $source_host || $dest_host; $self->_upload_dots_script($server) if $dots; return $server->ssh(['-t','-A'],"sudo -E rsync -e 'ssh -o \"CheckHostIP no\" -o \"StrictHostKeyChecking no\"' $rsync_args @source_paths $dest_path $dots"); } # localhost => localhost if (!($source_host || $dest_host)) { my $dots_cmd = $self->_dots_cmd; return system("rsync @source $dest $dots_cmd") == 0; } # localhost => DataTransferServer if ($dest_is_server && !$src_is_server) { return $dest_host->_rsync_put($rsync_args,@source_paths,$dest_path); } # DataTransferServer => localhost if ($src_is_server && !$dest_is_server) { return $source_host->_rsync_get($rsync_args,@source_paths,$dest_path); } if ($source_host eq $dest_host) { $self->info("Beginning rsync @source_paths $dest_path...\n"); my $result = $source_host->ssh('sudo','rsync',$rsync_args,@source_paths,$dest_path); $self->info("...rsync done.\n"); return $result; } # DataTransferServer1 => DataTransferServer2 # this one is slightly more difficult because datatransferserver1 has to # ssh authenticate against datatransferserver2. my $keyname = $self->_authorize($source_host => $dest_host); my $dest_ip = $dest_host->instance->dnsName; my $ssh_args = $source_host->_ssh_escaped_args; my $keyfile = $source_host->keyfile; $ssh_args =~ s/$keyfile/$keyname/; # because keyfile is embedded among args $self->info("Beginning rsync @source_paths $dest_ip:$dest_path...\n"); $self->_upload_dots_script($source_host) if $dots; my $result = $source_host->ssh('sudo','rsync',$rsync_args, '-e',"'ssh $ssh_args'", "--rsync-path='sudo rsync'", @source_paths,"$dest_ip:$dest_path",$dots); $self->info("...rsync done.\n"); return $result; } sub _quote_shell { my $thing = shift; $thing =~ s/\s/\ /; $thing =~ s/(['"])/\\($1)/; $thing; } =head2 $manager->dd($source_vol=>$dest_vol) This method performs block-level copying of the contents of $source_vol to $dest_vol by using dd over an SSH tunnel, where both source and destination volumes are VM::EC2::Staging::Volume objects. The volumes must be attached to a server but not mounted. Everything in the volume, including its partition table, is copied, allowing you to make an exact image of a disk. The volumes do B actually need to reside on this server, but can be attached to any staging server in the zone. =cut # for this to work, we have to create the concept of a "raw" staging volume # that is attached, but not mounted sub dd { my $self = shift; @_==2 or croak "usage: VM::EC2::Staging::Manager->dd(\$source_vol=>\$dest_vol)"; my ($vol1,$vol2) = @_; my ($server1,$device1) = ($vol1->server,$vol1->mtdev); my ($server2,$device2) = ($vol2->server,$vol2->mtdev); my $hush = $self->verbosity < VERBOSE_INFO ? '2>/dev/null' : ''; my $use_pv = $self->verbosity >= VERBOSE_WARN; my $gigs = $vol1->size; if ($use_pv) { $self->info("Configuring PV to show dd progress...\n"); $server1->ssh("if [ ! -e /usr/bin/pv ]; then sudo apt-get -qq update >/dev/null 2>&1; sudo apt-get -y -qq install pv >/dev/null 2>&1; fi"); } if ($server1 eq $server2) { if ($use_pv) { print STDERR "\n"; $server1->ssh(['-t'], "sudo dd if=$device1 2>/dev/null | pv -f -s ${gigs}G -petr | sudo dd of=$device2 2>/dev/null"); } else { $server1->ssh("sudo dd if=$device1 of=$device2 $hush"); } } else { my $keyname = $self->_authorize($server1,$server2); my $dest_ip = $server2->instance->dnsName; my $ssh_args = $server1->_ssh_escaped_args; my $keyfile = $server1->keyfile; $ssh_args =~ s/$keyfile/$keyname/; # because keyfile is embedded among args my $pv = $use_pv ? "2>/dev/null | pv -s ${gigs}G -petr" : ''; $server1->ssh(['-t'], "sudo dd if=$device1 $hush $pv | gzip -1 - | ssh $ssh_args $dest_ip 'gunzip -1 - | sudo dd of=$device2'"); } } # take real or symbolic name and turn it into a two element # list consisting of server object and mount point # possible forms: # /local/path # vol-12345/relative/path # vol-12345:/relative/path # vol-12345:relative/path # $server:/absolute/path # $server:relative/path # # treat path as symbolic if it does not start with a slash # or dot characters sub _resolve_path { my $self = shift; my $vpath = shift; my ($servername,$pathname); if ($vpath =~ /^(vol-[0-9a-f]+):?(.*)/ && (my $vol = VM::EC2::Staging::Manager->find_volume_by_volid($1))) { my $path = $2 || '/'; $path = "/$path" if $path && $path !~ m!^/!; $vol->_spin_up; $servername = $LastHost = $vol->server; my $mtpt = $LastMt = $vol->mtpt; $pathname = $mtpt; $pathname .= $path if $path; } elsif ($vpath =~ /^(i-[0-9a-f]{8}):(.+)$/ && (my $server = VM::EC2::Staging::Manager->find_server_by_instance($1))) { $servername = $LastHost = $server; $pathname = $2; } elsif ($vpath =~ /^:(.+)$/) { $servername = $LastHost if $LastHost; $pathname = $LastHost && $LastMt ? "$LastMt/$2" : $2; } else { return [undef,$vpath]; # localhost } return [$servername,$pathname]; } sub _rsync_args { my $self = shift; my $verbosity = $self->verbosity; return $verbosity < VERBOSE_WARN ? '-azq' :$verbosity < VERBOSE_INFO ? '-azh' :$verbosity < VERBOSE_DEBUG ? '-azh' : '-azhv' } sub _authorize { my $self = shift; my ($source_host,$dest_host) = @_; my $keyname = "/tmp/${source_host}_to_${dest_host}"; unless ($source_host->has_key($keyname)) { $source_host->info("creating ssh key for server to server data transfer.\n"); $source_host->ssh("ssh-keygen -t dsa -q -f $keyname/dev/null"); $source_host->has_key($keyname=>1); } unless ($dest_host->accepts_key($keyname)) { my $key_stuff = $source_host->scmd("cat ${keyname}.pub"); chomp($key_stuff); $dest_host->ssh("mkdir -p .ssh; chmod 0700 .ssh; (echo '$key_stuff' && cat .ssh/authorized_keys) | sort | uniq > .ssh/authorized_keys.tmp; mv .ssh/authorized_keys.tmp .ssh/authorized_keys; chmod 0600 .ssh/authorized_keys"); $dest_host->accepts_key($keyname=>1); } return $keyname; } =head2 $volume = $manager->find_volume_by_volid($volume_id) Given an EC2 volumeId, return the corresponding VM::EC2::Staging::Volume, if any. =cut sub find_volume_by_volid { my $self = shift; my $volid = shift; return $Volumes{$volid}; } =head2 $volume = $manager->find_volume_by_name($name) Given a staging name (assigned at volume creation time), return the corresponding VM::EC2::Staging::Volume, if any. =cut sub find_volume_by_name { my $self = shift; my $name = shift; my %volumes = map {$_->name => $_} $self->volumes; return $volumes{$name}; } =head2 @volumes = $manager->volumes Return all VM::EC2::Staging::Volumes managed in this zone. =cut sub volumes { my $self = shift; return grep {$_->ec2->endpoint eq $self->ec2->endpoint} values %Volumes; } =head1 Instance Methods for Accessing Configuration Options This section documents accessor methods that allow you to examine or change configuration options that were set at create time. Called with an argument, the accessor changes the option and returns the option's previous value. Called without an argument, the accessor returns the option's current value. =head2 $on_exit = $manager->on_exit([$new_behavior]) Get or set the "on_exit" option, which specifies what to do with existing staging servers when the staging manager is destroyed. Valid values are "terminate", "stop" and "run". =head2 $reuse_key = $manager->reuse_key([$boolean]) Get or set the "reuse_key" option, which if true uses the same internally-generated ssh keypair for all running instances. If false, then a new keypair will be created for each staging server. The keypair will be destroyed automatically when the staging server terminates (but only if the staging manager initiates the termination itself). =head2 $username = $manager->username([$new_username]) Get or set the username used to log into staging servers. =head2 $architecture = $manager->architecture([$new_architecture]) Get or set the architecture (i386, x86_64) to use for launching new staging servers. =head2 $root_type = $manager->root_type([$new_type]) Get or set the instance root type for new staging servers ("instance-store", "ebs"). =head2 $instance_type = $manager->instance_type([$new_type]) Get or set the instance type to use for new staging servers (e.g. "t1.micro"). I recommend that you use "m1.small" (the default) or larger instance types because of the extremely slow I/O of the micro instance. In addition, micro instances running Ubuntu have a known bug that prevents them from unmounting and remounting EBS volumes repeatedly on the same block device. This can lead to hangs when the staging manager tries to create volumes. =head2 $reuse_volumes = $manager->reuse_volumes([$new_boolean]) This gets or sets the "reuse_volumes" option, which if true causes the provision_volumes() call to create staging volumes from existing EBS volumes and snapshots that share the same staging manager symbolic name. See the discussion under VM::EC2->staging_manager(), and VM::EC2::Staging::Manager->provision_volume(). =head2 $name = $manager->image_name([$new_name]) This gets or sets the "image_name" option, which is the AMI ID or AMI name to use when creating new staging servers. Names beginning with "ami-" are treated as AMI IDs, and everything else is treated as a pattern match on the AMI name. =head2 $zone = $manager->availability_zone([$new_zone]) Get or set the default availability zone to use when creating new servers and volumes. An undef value allows the staging manager to choose the zone in a way that minimizes resources. =head2 $class_name = $manager->volume_class([$new_class]) Get or set the name of the perl package that implements staging volumes, VM::EC2::Staging::Volume by default. Staging volumes created by the manager will have this class type. =head2 $class_name = $manager->server_class([$new_class]) Get or set the name of the perl package that implements staging servers, VM::EC2::Staging::Server by default. Staging servers created by the manager will have this class type. =head2 $boolean = $manager->scan([$boolean]) Get or set the "scan" flag, which if true will cause the zone to be scanned quickly for existing managed servers and volumes when the manager is first created. =head2 $path = $manager->dot_directory([$new_directory]) Get or set the dot directory which holds private key files. =cut sub dot_directory { my $self = shift; my $dir = $self->dotdir; unless (-e $dir && -d $dir) { mkdir $dir or croak "mkdir $dir: $!"; chmod 0700,$dir or croak "chmod 0700 $dir: $!"; } return $dir; } =head1 Internal Methods This section documents internal methods that are not normally called by end-user scripts but may be useful in subclasses. In addition, there are a number of undocumented internal methods that begin with the "_" character. Explore the source code to learn about these. =head2 $ok = $manager->environment_ok This performs a check on the environment in which the module is running. For this module to work properly, the ssh, rsync and dd programs must be found in the PATH. If all three programs are found, then this method returns true. This method can be called as an instance method or class method. =cut sub environment_ok { my $self = shift; foreach (qw(dd ssh rsync)) { chomp (my $path = `which $_`); return unless $path; } return 1; } =head2 $name = $manager->default_verbosity Returns the default verbosity level (2: warning+informational messages). This is overridden using -verbose at create time. =cut sub default_verbosity { VERBOSE_INFO } =head2 $name = $manager->default_exit_behavior Return the default exit behavior ("stop") when the manager terminates. Intended to be overridden in subclasses. =cut sub default_exit_behavior { 'stop' } =head2 $name = $manager->default_image_name Return the default image name ('ubuntu-precise-12.04') for use in creating new instances. Intended to be overridden in subclasses. =cut sub default_image_name { 'ubuntu-precise-12.04' }; # launches faster than precise =head2 $name = $manager->default_user_name Return the default user name ('ubuntu') for use in creating new instances. Intended to be overridden in subclasses. =cut sub default_user_name { 'ubuntu' } =head2 $name = $manager->default_architecture Return the default instance architecture ('i386') for use in creating new instances. Intended to be overridden in subclasses. =cut sub default_architecture { 'i386' } =head2 $name = $manager->default_root_type Return the default instance root type ('instance-store') for use in creating new instances. Intended to be overridden in subclasses. Note that this value is ignored if the exit behavior is "stop", in which case an ebs-backed instance will be used. Also, the m1.micro instance type does not come in an instance-store form, so ebs will be used in this case as well. =cut sub default_root_type { 'instance-store'} =head2 $name = $manager->default_instance_type Return the default instance type ('m1.small') for use in creating new instances. Intended to be overridden in subclasses. We default to m1.small rather than a micro instance because the I/O in m1.small is far faster than in t1.micro. =cut sub default_instance_type { 'm1.small' } =head2 $name = $manager->default_reuse_keys Return the default value of the -reuse_keys argument ('true'). This value allows the manager to create an ssh keypair once, and use the same one for all servers it creates over time. If false, then a new keypair is created for each server and then discarded when the server terminates. =cut sub default_reuse_keys { 1 } =head2 $name = $manager->default_reuse_volumes Return the default value of the -reuse_volumes argument ('true'). This value instructs the manager to use the symbolic name of the volume to return an existing volume whenever a request is made to provision a new one of the same name. =cut sub default_reuse_volumes { 1 } =head2 $path = $manager->default_dot_directory_path Return the default value of the -dotdir argument ("$ENV{HOME}/.vm-ec2-staging"). This value instructs the manager to use the symbolic name of the volume to return an existing volume whenever a request is made to provision a new one of the same name. =cut sub default_dot_directory_path { my $class = shift; my $dir = File::Spec->catfile($ENV{HOME},'.vm-ec2-staging'); return $dir; } =head2 $class_name = $manager->default_volume_class Return the class name for staging volumes created by the manager, VM::EC2::Staging::Volume by default. If you wish a subclass of VM::EC2::Staging::Manager to create a different type of volume, override this method. =cut sub default_volume_class { return 'VM::EC2::Staging::Volume'; } =head2 $class_name = $manager->default_server_class Return the class name for staging servers created by the manager, VM::EC2::Staging::Server by default. If you wish a subclass of VM::EC2::Staging::Manager to create a different type of volume, override this method. =cut sub default_server_class { return 'VM::EC2::Staging::Server'; } =head2 $server = $manager->register_server($server) Register a VM::EC2::Staging::Server object. Usually called internally. =cut sub register_server { my $self = shift; my $server = shift; sleep 1; # AWS lag bugs my $zone = $server->placement; $Zones{$zone}{Servers}{$server} = $server; $Instances{$server->instance} = $server; return $self->_increment_usage_count($server); } =head2 $manager->unregister_server($server) Forget about the existence of VM::EC2::Staging::Server. Usually called internally. =cut sub unregister_server { my $self = shift; my $server = shift; my $zone = eval{$server->placement} or return; # avoids problems at global destruction delete $Zones{$zone}{Servers}{$server}; delete $Instances{$server->instance}; return $self->_decrement_usage_count($server); } =head2 $manager->register_volume($volume) Register a VM::EC2::Staging::Volume object. Usually called internally. =cut sub register_volume { my $self = shift; my $vol = shift; $self->_increment_usage_count($vol); $Zones{$vol->availabilityZone}{Volumes}{$vol} = $vol; $Volumes{$vol->volumeId} = $vol; } =head2 $manager->unregister_volume($volume) Forget about a VM::EC2::Staging::Volume object. Usually called internally. =cut sub unregister_volume { my $self = shift; my $vol = shift; my $zone = $vol->availabilityZone; $self->_decrement_usage_count($vol); delete $Zones{$zone}{$vol}; delete $Volumes{$vol->volumeId}; } =head2 $pid = $manager->pid([$new_pid]) Get or set the process ID of the script that is running the manager. This is used internally to detect the case in which the script has forked, in which case we do not want to invoke the manager class's destructor in the child process (because it may stop or terminate servers still in use by the parent process). =head2 $path = $manager->dotdir([$new_dotdir]) Low-level version of dot_directory(), differing only in the fact that dot_directory will automatically create the path, including subdirectories. =cut =head2 $manager->scan_region Synchronize internal list of managed servers and volumes with the EC2 region. Called automatically during new() and needed only if servers & volumes are changed from outside the module while it is running. =cut # scan for staging instances in current region and cache them # into memory # status should be... # -on_exit => {'terminate','stop','run'} sub scan_region { my $self = shift; my $ec2 = shift || $self->ec2; $self->_scan_instances($ec2); $self->_scan_volumes($ec2); } sub _scan_instances { my $self = shift; my $ec2 = shift; my @instances = $ec2->describe_instances({'tag:StagingRole' => 'StagingInstance', 'instance-state-name' => ['running','stopped']}); for my $instance (@instances) { my $keyname = $instance->keyName or next; my $keyfile = $self->_check_keyfile($keyname) or next; my $username = $instance->tags->{'StagingUsername'} or next; my $name = $instance->tags->{StagingName} || $self->new_server_name; my $server = $self->server_class()->new( -name => $name, -keyfile => $keyfile, -username => $username, -instance => $instance, -manager => $self, ); $self->register_server($server); } } sub _scan_volumes { my $self = shift; my $ec2 = shift; # now the volumes my @volumes = $ec2->describe_volumes(-filter=>{'tag:StagingRole' => 'StagingVolume', 'status' => ['available','in-use']}); for my $volume (@volumes) { my $status = $volume->status; my $zone = $volume->availabilityZone; my %args; $args{-endpoint} = $self->ec2->endpoint; $args{-volume} = $volume; $args{-name} = $volume->tags->{StagingName}; $args{-fstype} = $volume->tags->{StagingFsType}; $args{-mtpt} = $volume->tags->{StagingMtPt}; my $mounted; if (my $attachment = $volume->attachment) { my $server = $self->find_server_by_instance($attachment->instance); $args{-server} = $server; ($args{-mtdev},$mounted) = $server->ping && $server->_find_mount($attachment->device); } my $vol = $self->volume_class()->new(%args); $vol->mounted(1) if $mounted; $self->register_volume($vol); } } =head2 $group = $manager->security_group Returns or creates a security group with the permissions needed used to manage staging servers. Usually called internally. =cut sub security_group { my $self = shift; return $self->{security_group} ||= $self->_security_group(); } =head2 $keypair = $manager->keypair Returns or creates the ssh keypair used internally by the manager to to access staging servers. Usually called internally. =cut sub keypair { my $self = shift; return $self->{keypair} ||= $self->_new_keypair(); } sub _security_key { my $self = shift; my $ec2 = $self->ec2; if ($self->reuse_key) { my @candidates = $ec2->describe_key_pairs(-filter=>{'key-name' => 'staging-key-*'}); for my $c (@candidates) { my $name = $c->keyName; my $keyfile = $self->_key_path($name); return ($c,$keyfile) if -e $keyfile; } } my $name = $self->_token('staging-key'); $self->info("Creating keypair $name.\n"); my $kp = $ec2->create_key_pair($name) or die $ec2->error_str; my $keyfile = $self->_key_path($name); my $private_key = $kp->privateKey; open my $k,'>',$keyfile or die "Couldn't create $keyfile: $!"; chmod 0600,$keyfile or die "Couldn't chmod $keyfile: $!"; print $k $private_key; close $k; return ($kp,$keyfile); } sub _security_group { my $self = shift; my $ec2 = $self->ec2; my @groups = $ec2->describe_security_groups(-filter=>{'tag:StagingRole' => 'StagingGroup'}); return $groups[0] if @groups; my $name = $self->_token('ssh'); $self->info("Creating staging security group $name.\n"); my $sg = $ec2->create_security_group(-name => $name, -description => "SSH security group created by ".__PACKAGE__ ) or die $ec2->error_str; $sg->authorize_incoming(-protocol => 'tcp', -port => 'ssh'); $sg->update or die $ec2->error_str; $sg->add_tag(StagingRole => 'StagingGroup'); return $sg; } =head2 $name = $manager->new_volume_name Returns a new random name for volumes provisioned without a -name argument. Currently names are in of the format "volume-12345678", where the numeric part are 8 random hex digits. Although no attempt is made to prevent naming collisions, the large number of possible names makes this unlikely. =cut sub new_volume_name { return shift->_token('volume'); } =head2 $name = $manager->new_server_name Returns a new random name for server provisioned without a -name argument. Currently names are in of the format "server-12345678", where the numeric part are 8 random hex digits. Although no attempt is made to prevent naming collisions, the large number of possible names makes this unlikely. =cut sub new_server_name { return shift->_token('server'); } sub _token { my $self = shift; my $base = shift or croak "usage: _token(\$basename)"; return sprintf("$base-%08x",1+int(rand(0xFFFFFFFF))); } =head2 $description = $manager->volume_description($volume) This method is called to assign a description to newly-created volumes. The current format is "Staging volume for Foo created by VM::EC2::Staging::Manager", where Foo is the volume's symbolic name. =cut sub volume_description { my $self = shift; my $vol = shift; my $name = ref $vol ? $vol->name : $vol; return "Staging volume for $name created by ".__PACKAGE__; } =head2 $manager->debug("Debugging message\n") =head2 $manager->info("Informational message\n") =head2 $manager->warn("Warning message\n") Prints an informational message to standard error if current verbosity() level allows. =cut sub info { my $self = shift; return if $self->verbosity < VERBOSE_INFO; my @lines = split "\n",longmess(); my $stack_count = grep /VM::EC2::Staging::Manager/,@lines; print STDERR '[info] ',' ' x (($stack_count-1)*3),@_; } sub warn { my $self = shift; return if $self->verbosity < VERBOSE_WARN; my @lines = split "\n",longmess(); my $stack_count = grep /VM::EC2::Staging::Manager/,@lines; print STDERR '[warn] ',' ' x (($stack_count-1)*3),@_; } sub debug { my $self = shift; return if $self->verbosity < VERBOSE_DEBUG; my @lines = split "\n",longmess(); my $stack_count = grep /VM::EC2::Staging::Manager/,@lines; print STDERR '[debug] ',' ' x (($stack_count-1)*3),@_; } =head2 $verbosity = $manager->verbosity([$new_value]) The verbosity() method get/sets a flag that sets the level of informational messages. =cut sub verbosity { my $self = shift; my $d = ref $self ? $self->verbose : $Verbose; if (@_) { $Verbose = shift; $self->verbose($Verbose) if ref $self; } return $d; } sub _search_for_image { my $self = shift; my %args = @_; my $name = $args{-image_name}; $self->info("Searching for a staging image...\n"); my $root_type = $self->on_exit eq 'stop' ? 'ebs' : $args{-root_type}; my @arch = $args{-architecture} ? ('architecture' => $args{-architecture}) : (); my @candidates = $name =~ /^ami-[0-9a-f]+/ ? $self->ec2->describe_images($name) : $self->ec2->describe_images({'name' => "*$args{-image_name}*", 'root-device-type' => $root_type, @arch}); return unless @candidates; # this assumes that the name has some sort of timestamp in it, which is true # of ubuntu images, but probably not others my ($most_recent) = sort {$b->name cmp $a->name} @candidates; $self->info("...found $most_recent: ",$most_recent->name,".\n"); return $most_recent; } sub _gather_image_info { my $self = shift; my $image = shift; return { name => $image->name, description => $image->description, architecture => $image->architecture, kernel => $image->kernelId || undef, ramdisk => $image->ramdiskId || undef, root_device => $image->rootDeviceName, block_devices=> [$image->blockDeviceMapping], is_public => $image->isPublic, platform => $image->platform, virtualizationType => $image->virtualizationType, hypervisor => $image->hypervisor, authorized_users => [$image->authorized_users], }; } sub _parse_destination { my $self = shift; my $destination = shift; my $ec2 = $self->ec2; my $dest_manager; if (ref $destination && $destination->isa('VM::EC2::Staging::Manager')) { $dest_manager = $destination; } else { my $dest_region = ref $destination && $destination->isa('VM::EC2::Region') ? $destination : $ec2->describe_regions($destination); $dest_region or croak "Invalid EC2 Region '$dest_region'; usage VM::EC2::Staging::Manager->copy_image(\$image,\$dest_region)"; my $dest_endpoint = $dest_region->regionEndpoint; my $dest_ec2 = VM::EC2->new(-endpoint => $dest_endpoint, -access_key => $ec2->access_key, -secret_key => $ec2->secret) or croak "Could not create new VM::EC2 in $dest_region"; $dest_manager = $self->new(-ec2 => $dest_ec2, -scan => $self->scan, -on_exit => 'destroy', -instance_type => $self->instance_type); } return $dest_manager; } sub match_kernel { my $self = shift; my ($src_kernel,$dest) = @_; my $dest_manager = $self->_parse_destination($dest) or croak "could not create destination manager for $dest"; return $self->_match_kernel($src_kernel,$dest_manager,'kernel'); } sub _match_kernel { my $self = shift; my ($imageId,$dest_manager) = @_; my $home_ec2 = $self->ec2; my $dest_ec2 = $dest_manager->ec2; # different endpoints! my $image = $home_ec2->describe_images($imageId) or return; my $type = $image->imageType; my @candidates; if (my $name = $image->name) { # will sometimes have a name @candidates = $dest_ec2->describe_images({'name' => $name, 'image-type' => $type, }); } unless (@candidates) { my $location = $image->imageLocation; # will always have a location my @path = split '/',$location; $location = $path[-1]; @candidates = $dest_ec2->describe_images(-filter=>{'image-type'=>'kernel', 'manifest-location'=>"*/$location"}, -executable_by=>['all','self']); } unless (@candidates) { # go to approximate match my $location = $image->imageLocation; my @path = split '/',$location; my @kernels = $dest_ec2->describe_images(-filter=>{'image-type'=>'kernel', 'manifest-location'=>"*/*"}, -executable_by=>['all','self']); my %k = map {$_=>$_} @kernels; my %locations = map {my $l = $_->imageLocation; my @path = split '/',$l; $_ => \@path} @kernels; my %level0 = map {$_ => abs(adistr($path[0],$locations{$_}[0]))} keys %locations; my %level1 = map {$_ => abs(adistr($path[1],$locations{$_}[1]))} keys %locations; @candidates = sort {$level0{$a}<=>$level0{$b} || $level1{$a}<=>$level1{$b}} keys %locations; @candidates = map {$k{$_}} @candidates; } return $candidates[0]; } # find the most likely ramdisk for a kernel based on preponderant configuration of public images sub _guess_ramdisk { my $self = shift; my $kernel = shift; my $ec2 = $self->ec2; my @images = $ec2->describe_images({'image-type' => 'machine', 'kernel-id' => $kernel}); my %ramdisks; foreach (@images) { $ramdisks{$_->ramdiskId}++; } my ($highest) = sort {$ramdisks{$b}<=>$ramdisks{$a}} keys %ramdisks; return $highest; } sub _check_keyfile { my $self = shift; my $keyname = shift; my $dotpath = $self->dot_directory; opendir my $d,$dotpath or die "Can't opendir $dotpath: $!"; while (my $file = readdir($d)) { if ($file =~ /^$keyname.pem/) { return $1,$self->_key_path($keyname,$1); } } closedir $d; return; } sub _select_server_by_zone { my $self = shift; my $zone = shift; my @servers = values %{$Zones{$zone}{Servers}}; return $servers[0]; } sub _select_used_zone { my $self = shift; if (my @servers = $self->servers) { my @up = grep {$_->ping} @servers; my $server = $up[0] || $servers[0]; return $server->placement; } elsif (my $zone = $self->availability_zone) { return $zone; } else { return; } } sub _key_path { my $self = shift; my $keyname = shift; return File::Spec->catfile($self->dot_directory,"${keyname}.pem") } # can be called as a class method sub _find_server_in_zone { my $self = shift; my $zone = shift; my @servers = sort {$a->ping cmp $b->ping} values %{$Zones{$zone}{Servers}}; return unless @servers; return $servers[-1]; } sub _servers { my $self = shift; my $endpoint = shift; # optional my @servers = values %Instances; return @servers unless $endpoint; return grep {$_->ec2->endpoint eq $endpoint} @servers; } sub _lock { my $self = shift; my ($resource,$lock_type) = @_; $lock_type eq 'SHARED' || $lock_type eq 'EXCLUSIVE' or croak "Usage: _lock(\$resource,'SHARED'|'EXCLUSIVE')"; $resource->refresh; my $tags = $resource->tags; if (my $value = $tags->{StagingLock}) { my ($type,$pid) = split /\s+/,$value; if ($pid eq $$) { # we've already got lock $resource->add_tags(StagingLock=>"$lock_type $$") unless $type eq $lock_type; return 1; } if ($lock_type eq 'SHARED' && $type eq 'SHARED') { return 1; } # wait for lock eval { local $SIG{ALRM} = sub {die 'timeout'}; alarm(LOCK_TIMEOUT); # we get lock eventually one way or another while (1) { $resource->refresh; last unless $resource->tags->{StagingLock}; sleep 1; } }; alarm(0); } $resource->add_tags(StagingLock=>"$lock_type $$"); return 1; } sub _unlock { my $self = shift; my $resource = shift; $resource->refresh; my $sl = $resource->tags->{StagingLock} or return; my ($type,$pid) = split /\s+/,$sl; return unless $pid eq $$; $resource->delete_tags('StagingLock'); } sub _safe_update_tag { my $self = shift; my ($resource,$tag,$value) = @_; $self->_lock($resource,'EXCLUSIVE'); $resource->add_tag($tag => $value); $self->_unlock($resource); } sub _safe_read_tag { my $self = shift; my ($resource,$tag) = @_; $self->_lock($resource,'SHARED'); my $value = $resource->tags->{$tag}; $self->_unlock($resource); return $value; } sub _increment_usage_count { my $self = shift; my $resource = shift; $self->_lock($resource,'EXCLUSIVE'); my $in_use = $resource->tags->{'StagingInUse'} || 0; $resource->add_tags(StagingInUse=>$in_use+1); $self->_unlock($resource); $in_use+1; } sub _decrement_usage_count { my $self = shift; my $resource = shift; $self->_lock($resource,'EXCLUSIVE'); my $in_use = $resource->tags->{'StagingInUse'} || 0; $in_use--; if ($in_use > 0) { $resource->add_tags(StagingInUse=>$in_use); } else { $resource->delete_tags('StagingInUse'); $in_use = 0; } $self->_unlock($resource); return $in_use; } sub _dots_cmd { my $self = shift; return '' unless $self->verbosity == VERBOSE_INFO; my ($fh,$dots_script) = tempfile('dots_XXXXXXX',SUFFIX=>'.pl',UNLINK=>1,TMPDIR=>1); print $fh $self->_dots_script; close $fh; chmod 0755,$dots_script; return "2>&1|$dots_script t"; } sub _upload_dots_script { my $self = shift; my $server = shift; my $fh = $server->scmd_write('cat >/tmp/dots.pl'); print $fh $self->_dots_script; close $fh; $server->ssh('chmod +x /tmp/dots.pl'); } sub _dots_script { my $self = shift; my @lines = split "\n",longmess(); my $stack_count = grep /VM::EC2::Staging::Manager/,@lines; my $spaces = ' ' x (($stack_count-1)*3); return < || last READ for 1.. 100} if \$mode eq 't'; print STDERR '.'; } print STDERR ".\n"; END } sub DESTROY { my $self = shift; if ($$ == $self->pid) { my $action = $self->on_exit; $self->terminate_all_servers if $action eq 'terminate'; $self->stop_all_servers if $action eq 'stop'; } delete $Managers{$self->ec2->endpoint}; } 1; =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut VM-EC2-1.23/lib/VM/EC2/Staging/Volume.pm000444001751001751 5161412100273360 17331 0ustar00lsteinlstein000000000000package VM::EC2::Staging::Volume; =head1 NAME VM::EC2::Staging::Volume - High level functions for provisioning and populating EC2 volumes =head1 SYNOPSIS use VM::EC2::Staging::manager; # get a new staging manager my $ec2 = VM::EC2->new; my $staging = $ec2->staging_manager(); ); my $vol1 = $staging->get_volume(-name => 'Backup', -fstype => 'ext4', -size => 11, -zone => 'us-east-1a'); # make a couple of directories in new volume $vol1->mkdir('pictures'); $vol1->mkdir('videos'); # use rsync to copy local files onto a subdirectory of this volume $vol1->put('/usr/local/my_pictures/' =>'pictures'); $vol1->put('/usr/local/my_videos/' =>'videos'); # use rsync to to copy a set of files on the volume to a local directory mkdir('/tmp/jpegs'); $vol1->get('pictures/*.jpg','/tmp/jpegs'); # note that these commands are executed on the remote server as root! @listing = $vol1->ls('-r','pictures'); $vol1->chown('fred','pictures'); $vol1->chgrp('nobody','pictures'); $vol1->chmod('0700','pictures'); $vol1->rm('-rf','pictures/*'); $vol1->rmdir('pictures'); # get some information about the volume my $mtpt = $vol->mtpt; my $mtdev = $vol->mtdev; my $mounted = $vol->mounted; my $server = $vol->server; # detach the volume $vol->detach; # delete the volume entirely $vol->delete; =head1 DESCRIPTION This is a high-level interface to EBS volumes which is used in conjunction with VM::EC2::Staging::Manager and VM::EC2::Staging::Server. It is intended to ease the process of allocating and managing EBS volumes, and provides for completely automated filesystem creation, directory management, and data transfer to and from the volume. You can use staging volumes without having to manually create and manage the instances needed to manipulate the volumes. As needed, the staging manager will create the server(s) needed to execute the desired actions on the volumes. Staging volumes are wrappers around VM::EC2::Volume, and have all the methods associated with those objects. In addition to the standard EC2 volume characteristics, each staging volume in an EC2 region has a symbolic name, which can be used to retrieve previously-created volumes without remembering their volume ID. This symbolic name is stored in the tag StagingName. Volumes also have a filesystem type (stored in the tag StagingFsType). When a volume is mounted on a staging server, it will also have a mount point on the file system, and a mounting device (e.g. /dev/sdf1). =cut use strict; use VM::EC2; use Carp 'croak'; use File::Spec; use overload '""' => sub {my $self = shift; return $self->short_name; # "inherited" from VM::EC2::Volume }, fallback => 1; my $Volume = 1; # for anonymously-named volumes our $AUTOLOAD; sub AUTOLOAD { my $self = shift; my ($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/; return if $func_name eq 'DESTROY'; my $vol = eval {$self->ebs} or croak overload::StrVal($self)," no longer connected to an Amazon EBS object, so can't execute $func_name()"; return $vol->$func_name(@_); } sub can { my $self = shift; my $method = shift; my $can = $self->SUPER::can($method); return $can if $can; my $ebs = $self->ebs or return; return $ebs->can($method); } =head1 Staging Volume Creation Staging volumes are created via a staging manager's get_volume() or provision_volume() methods. See L. One typical invocation is: my $ec2 = VM::EC2->new; my $manager = $ec2->staging_manager(); ); my $vol = $manager->get_volume(-name => 'Backup', -fstype => 'ext4', -size => 5, -zone => 'us-east-1a'); This will either retrieve an existing volume named "Backup", or, if none exists, create a new one using the provided specification. Behind the scenes, a staging server will be allocated to mount the volume. The manager tries to conserve resources, and so will reuse a suitable running staging server if one is available. The other typical invocation is: my $vol = $manager->provision_volume(-name => 'Backup', -fstype => 'ext4', -size => 5, -zone => 'us-east-1a'); This forces creation of a new volume with the indicated characteristics. If a volume of the same name already exists, this method will die with a fatal error (to avoid this, either wrap in an eval, or leave off the -name argument and let the manager pick a unique name for you). =cut =head1 Volume Information The methods in this section return status information about the staging volume. =head2 $name = $vol->name([$newname]) Get/set the symbolic name associated with this volume. =head2 $mounted = $vol->mounted Returns true if the volume is currently mounted on a server. =cut sub mounted { my $self = shift; my $m = $self->{mounted}; $self->{mounted} = shift if @_; return $m; } =head2 $type = $vol->fstype Return the filesystem type requested at volume creation time. =head2 $server = $vol->server Get the server associated with this volume, if any. =head2 $device = $vol->mtdev Get the device that the volume is attached to, e.g. /dev/sdf1. If the volume is not attached to a server, returns undef. =head2 $device = $vol->mtpt Get the mount point for this volume on the attached server. If the volume is not mounted, returns undef. =head2 $ebs_vol = $vol->ebs Get the underlying EBS volume associated with the staging volume object. =head2 $manager = $vol->manager Return the VM::EC2::Staging::Manager which manages this volume. =cut =head2 $string = $vol->fstab_line(); This method returns the line in /etc/fstab that would be necessary to mount this volume on the server to which it is currently attached at boot time. For example: /dev/sdf1 /mnt/staging/Backups ext4 defaults,nobootwait 0 2 You can add this to the current server's fstab using the following code fragment: my $server = $vol->server; my $fh = $server->scmd_write('sudo -s "cat >>/etc/fstab"'); print $fh $vol->fstab,"\n"; close $fh; =cut sub fstab_line { my $self = shift; return join "\t",$self->mtdev,$self->mtpt,$self->fstype,'defaults,nobootwait',0,2; } # $stagingvolume->new({-server => $server, -volume => $volume, # -mtdev => $device, -mtpt => $mtpt, # -name => $name, -fstype => $fstype}) # sub new { my $self = shift; my $args; if (ref $_[0]) { $args = shift; } else { my %args = @_; $args = \%args; } return bless $args,ref $self || $self; } # accessors: # sub volume # sub mtpt # sub name # sub manager foreach (qw(-server -volume -name -endpoint -mtpt -mtdev -fstype)) { (my $function = $_) =~ s/^-//; eval <{$_}; \$self->{$_} = shift if \@_; return \$d; } END } sub ebs {shift->volume(@_)} sub manager { my $self = shift; my $ep = $self->endpoint; return VM::EC2::Staging::Manager->find_manager($ep); } =head2 $type = $vol->get_fstype Return the volume's actual filesystem type. This can be different from the requested type if it was later altered by running mkfs on the volume, or the contents of the disk were overwritten by a block-level dd command. As a side effect, this method sets fstype() to the current correct value. =cut # look up our filesystem type sub get_fstype { my $self = shift; return $self->fstype if $self->fstype; return 'raw' if $self->mtpt eq 'none'; $self->_spin_up; my $dev = $self->mtdev; my $blkid = $self->server->scmd("sudo blkid -p $dev"); my ($type) = $blkid =~ /TYPE="([^"]+)"/; $self->fstype($type); return $type || 'raw'; } sub _spin_up { my $self = shift; my $nomount = shift; unless ($self->server) { $self->manager->info("provisioning server to mount $self\n"); my $server = $self->manager->get_server_in_zone($self->availabilityZone); $self->server($server); } unless ($self->server->status eq 'running') { $self->manager->info("Starting server to mount $self\n"); $self->server->start; } $self->server->mount_volume($self) unless $nomount || $self->mounted(); } #sub as_string { # my $self = shift; # return $self->server.':'.$self->mtpt; #} =head1 Lifecycle Methods The methods in this section control the state of the volume. =head2 $snapshot = $vol->create_snapshot('description') Create a VM::EC2::Snapshot of the volume with an optional description. This differs from the VM::EC2::Volume method of the same name in that it is aware of the mount state of the volume and will first try to unmount it so that the snapshot is clean. After the snapshot is started, the volume is remounted. =cut sub create_snapshot { my $self = shift; my $description = shift; if (my $server = $self->server) { my ($snap) = $server->create_snapshot($self => $description); return $snap; } else { $self->ebs->create_snapshot($description); } } =head2 $snapshot = $vol->snapshot('description') Identical to create_snapshot(), but the method name is shorter. =cut sub snapshot {shift->create_snapshot(@_)} =head2 $vol->mount($server [,$mtpt]) =head2 $vol->mount() Mount the volume on the indicated VM::EC2::Staging::Server, optionally at a named mount point on the file system. If the volume is already attached to a different server, it will be detached first. If any of these step fails, the method will die with a fatal error. When called with no arguments, the volume is automounted on a staging server, creating or starting the server if necessary. =cut # mount the volume on a server sub mount { my $self = shift; unless (@_) { return $self->_spin_up; } my ($server,$mtpt) = @_; if (my $existing_server = $self->server) { if ($existing_server eq $server) { $self->unmount; } else { $self->detach; } } $server->mount_volume($self,$mtpt); } =head2 $vol->unmount() Unmount the volume from wherever it is, but leave it attached to the staging server. If the volume is not already mounted, nothing happens. Note that it is possible for a volume to be mounted on a I server, in which case the server will be started and the volume only unmounted when it is up and running. =cut # unmount volume from wherever it is sub unmount { my $self = shift; my $server = $self->server or return; # guarantees that server is running, but avoids mounting the disk # prior to unmounting it again. $self->_spin_up('nomount'); $server->unmount_volume($self); $self->mtpt(undef); } sub umount { shift->unmount(@_) } # because I forget =head2 $vol->detach() Unmount and detach the volume from its current server, if any. Note that it is possible for a volume to be mounted on a I server, in which case the server will be started and the volume only unmounted when it is up and running. =cut sub detach { my $self = shift; my $server = $self->server or return; $self->current_status eq 'in-use' or return; $self->unmount; # make sure we are not mounted; this might involve starting a server $server->info("detaching $self\n"); my $status = $self->volume->detach; $self->mtpt(undef); $self->mtdev(undef); $self->server(undef); return $status; } =head2 $vol->delete() Delete the volume entirely. If it is mounted and/or attached to a server, it will be unmounted/detached first. If any steps fail, the method will die with a fatal error. =cut # remove volume entirely sub delete { my $self = shift; my $status = $self->current_status; if ($status eq 'in-use') { my $server = $self->server || $self->manager->find_server_by_instance($self->attachment->instanceId); $server->delete_volume($self) if $server; } elsif ($status eq 'available') { $self->ec2->delete_volume($self); } else { croak "Cannot delete volume, status is $status"; } $self->mounted(0); $self->mtpt(undef); $self->mtdev(undef); $self->fstype(undef); } =head1 Data Operations The methods in this section operate on the contents of the volume. By and large, they operate with root privileges on the server machine via judicious use of sudo. Elevated permissions on the local machine (on which the script is running) are not needed. =cut =head2 $vol->get($source_on_vol_1,$source_on_vol_2,...,$dest) Invoke rsync() on the server to copy files & directories from the indicated source locations on the staging volume to the destination. Source paths can be relative paths, such as "media/photos/vacation", in which case they are relative to the top level of the mounted volume, or absolute paths, such as "/usr/local/media/photos/vacation", in which case they are treated as absolute paths on the server on which the volume is mounted. The destination can be a path on the local machine, a host:/path on a remote machine, a staging server and path in the form $server:/path, or a staging volume and path in the form "$volume/path". See L for more formats you can use. As a special case, if you invoke get() with a single argument: $vol->get('/tmp/foo') Then the entire volume will be rsynced into the destination directory /tmp/foo. =cut # $vol->get($source1,$source2,$source3....,$dest) # If $source not in format hostname:/path then # volume will be appended to it. sub get { my $self = shift; croak 'usage: ',ref($self),'->get($source1,$source2,$source3....,$dest_path)' unless @_; unshift @_,'./' if @_ < 2; my $dest = pop; my $server = $self->server or croak "no staging server available"; $self->mounted or croak "Volume is not currently mounted"; my @source = $self->_rel2abs(@_); $server->rsync(@source,$dest); } =head2 $vol->copy($source_on_vol_1,$source_on_vol_2,...,$dest) This is an alias for get(). It is intended to make it easier to read the intent of this command: $source_volume->copy($destination_volume); Which basically makes a copy of $source_volume onto $destination_volume. =cut sub copy { shift->get(@_) } =head2 $vol->put($source1,$source2,$source3,...,$dest_on_volume) Invoke rsync() on the server to copy files & directories from the indicated source locations a destination located on the staging volume. The rules for paths are the same as for the get() method and as described in L . As a special case, if you invoke put() with a single argument: $vol->put('/tmp/foo') Then the local directory /tmp/foo will be copied onto the top level of the staging volume. To do something similar with multiple source directories, use '/' or '.' as the destination: $vol->put('/tmp/pictures','/tmp/audio' => '/'); =cut # $vol->put($source1,$source2,$source3....,$dest) # If $dest not in format hostname:/path then # volume will be appended to it. sub put { my $self = shift; croak 'usage: ',ref($self),'->put($source1,$source2,$source3....,$dest_path)' unless @_; push @_,'.' if @_ < 2; my $dest = pop; my @source = @_; $self->_spin_up; my $server = $self->server or croak "no staging server available"; ($dest) = $self->_rel2abs($dest); $server->rsync(@source,$dest); } =head2 $vol->dd($destination_volume) The dd() method performs a block level copy of the volume's disk onto the destination. The destination must be another staging volume. =cut sub dd { my $self = shift; unshift @_,$self if @_ < 2; $self->_spin_up; $self->server->dd(@_); } =head2 $output = $vol->cmd($cmd,@args) This method runs command $cmd on the server that is mounting the volume using ssh. Before the command is run, the working directory is changed to the top level of the volume's mount point. Any arguments, switches, etc you wish to pass to the command can be provided as @args. The output of the command is returned as a string in a scalar context, or an array of lines in a list context. Example: @log = $volume->cmd('tar cvf /tmp/archive.tar .'); =head2 $result = $vol->ssh($cmd,@args) This is similar to cmd(), except that the output of the command is sent to STDOUT and the method returns true if the command executed succcessfully on the remote machine. The cmd() and ssh() methods are equivalent to backticks are system() respectively. Example: $volume->ssh('gzip /tmp/archive.tar') or die "couldn't compress archive"; =head2 $output = $vol->df(@args) =head2 $output = $vol->ls(@args) =head2 $success = $vol->mkdir(@args) =head2 $success = $vol->chown(@args) =head2 $success = $vol->chgrp(@args) =head2 $success = $vol->chmod(@args) =head2 $success = $vol->cp(@args) =head2 $success = $vol->mv(@args) =head2 $success = $vol->rm(@args) =head2 $success = $vol->rmdir(@args) Each of these methods performs the same function as the like-named command-line function, after first changing the working directory to the top level of the volume. They behave as shown in the pseudocode below: chdir $vol->mtpt; sudo $method @args The df() and ls() methods return the output of their corresponding commands. In a scalar context each method returns a string corresponding to the output of running the command on the server to which the volume is attached. In a list context, the methods return one element per line of output. For example: my $free = $volume->df('.'); # free on current directory my ($percent) = $free =~ /(\d+)%/; warn "almost out of space" if $percent > 90; The other methods return a boolean value indicating successful execution of the command on the remote machine. Command line switches can be passed along with other arguments: $volume->mkdir('-p','media/photos/vacation'); $volume->chown('-R','fred','media'); With the exception of df, each of these commands runs as the superuser, so be careful how you call them. You may run your own commands using the cmd() and ssh() methods. The former returns the output of the command. The latter returns a success code: @log = $volume->cmd('tar cvf /tmp/archive.tar .'); $volume->ssh('gzip /tmp/archive.tar') or die "couldn't compress archive"; Before calling any of these methods, the volume must be mounted and its server running. A fatal error will occur otherwise. =cut sub df { shift->_cmd('df',@_) } sub ls { shift->_cmd('sudo ls',@_) } sub mkdir { shift->_ssh('sudo mkdir',@_) } sub chown { shift->_ssh('sudo chown',@_) } sub chgrp { shift->_ssh('sudo chgrp',@_) } sub chmod { shift->_ssh('sudo chmod',@_) } sub rm { shift->_ssh('sudo rm',@_) } sub rmdir { shift->_ssh('sudo rmdir',@_) } sub cp { shift->_ssh('sudo cp',@_) } sub mv { shift->_ssh('sudo mv',@_) } sub _cmd { my $self = shift; my $cmd = shift; my @args = map {quotemeta} @_; $self->mounted or croak "Volume is not currently mounted"; my $mtpt = $self->mtpt; $self->server->scmd("cd '$mtpt'; $cmd @args"); } sub _ssh { my $self = shift; my $cmd = shift; my @args = map {quotemeta} @_; $self->mounted or croak "Volume is not currently mounted"; my $mtpt = $self->mtpt; $self->server->ssh("cd '$mtpt'; $cmd @args"); } sub cmd { shift->_cmd(@_) } sub ssh { shift->_ssh(@_) } sub _rel2abs { my $self = shift; my @paths = @_; my $server = $self->server or croak "no server"; my @result; foreach (@paths) { if (/^([^:]+):(.+)$/) { push @result,$_; } elsif (m!^/!) { # absolute path push @result,"$server:".$_; } else { my $p = "$server:".File::Spec->rel2abs($_,$self->mtpt); $p .= '/' if m!/$!; push @result,$p; } } return @result; } sub _select_zone { my $self = shift; my $ec2 = shift; if (my @servers = VM::EC2::Staging::Server->_servers($ec2->endpoint)) { return $servers[0]->instance->placement; } else { my @zones = $ec2->describe_availability_zones; return $zones[rand @zones]; } } sub _get_vol_zone { my $self = shift; my ($ec2,$volid) = @_; my $volume = $ec2->describe_volumes($volid) or croak "unknown volumeid $volid"; return $volume->availabilityZone; } sub DESTROY { my $self = shift; my $manager = $self->manager or return; my $ebs = $self->ebs or return; $manager->unregister_volume($self); } =head1 SEE ALSO L L L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut 1; VM-EC2-1.23/lib/VM/EC2/Spot000755001751001751 012100273360 14671 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/Spot/InstanceRequest.pm000444001751001751 1141612100273360 20524 0ustar00lsteinlstein000000000000package VM::EC2::Spot::InstanceRequest; =head1 NAME VM::EC2::Spot::InstanceRequest - Object describing an Amazon EC2 spot instance request =head1 SYNOPSIS See L. =head1 DESCRIPTION This object represents an Amazon EC2 spot instance request, which is returned by VM::EC2->request_spot_instances() and VM::EC2->describe_spot_instance_requests(). =head1 METHODS These object methods are supported: spotInstanceRequestId -- ID of this spot instance request spotPrice -- The maximum hourly price for any spot instance launched under this request, in USD. type -- The spot instance request type, one of 'one-time' or 'persistent'. state -- The state of this request, one of 'open', 'closed', 'cancelled' or 'failed'. fault -- Fault code for the request, if any, an instance of VM::EC2::Error. status -- The status code and status message describing the Spot Instance request. validFrom -- Start date and time of the request. validUntil -- Date and time that the request expires. launchGroup -- Launch group of the instances run under this request. Instances in the same launch group are launched and terminated together. availabilityZoneGroup -- Availability zone group of the instances run under this request. Instances in the same availability zone group will always be launched into the same availability zone. launchSpecification -- Additional information for launching instances, represented as a VM::EC2::Spot::LaunchSpecificaton object. instanceId -- The instance ID, if an instance has been launched as a result of this request. createTime -- The time and date when the spot instance request was created. productDescription -- The product description associated with this spot instance request. =head1 Convenience Methods This class supports the standard tagging interface. In addition it provides the following convenience method: =head2 $instance = $request->instance If an instance was launched as a result of this request, the instance() method will return the corresponding VM::EC2::Instance object. =head2 $state = $request->current_status Refreshes the request information and returns its status as a VM::EC2::Spot::Status. This will string interpolate as the status code, such as "fulfilled". You may also call its object methods to get the time of the last update and full message. =head2 $state = $request->current_state Refreshes the request information and returns its state, such as "open". =head2 $request->refresh Refreshes the request information. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use VM::EC2::Spot::LaunchSpecification; use VM::EC2::Spot::Status; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(spotInstanceRequestId spotPrice type state fault status validFrom validUntil launchGroup availabilityZoneGroup launchedAvailabilityZone launchSpecification instanceId createTime productDescription); } sub primary_id { shift->spotInstanceRequestId; } sub status { my $self = shift; my $status = $self->SUPER::status; return VM::EC2::Spot::Status->new($status,$self->ec2,$self->xmlns,$self->requestId); } sub launchSpecification { my $self = shift; my $spec = $self->SUPER::launchSpecification; return VM::EC2::Spot::LaunchSpecification->new($spec,$self->ec2,$self->xmlns,$self->requestId); } sub instance { my $self = shift; my $instanceId = $self->instanceId or return; return $self->ec2->describe_instances($instanceId); } sub fault { my $self = shift; my $f = $self->SUPER::fault or return; return VM::EC2::Error->new($f,$self->ec2); } sub refresh { my $self = shift; local $self->ec2->{raise_error} = 1; my $r = $self->ec2->describe_spot_instance_requests($self->spotInstanceRequestId); %$self = %$r; } sub current_status { my $self = shift; $self->refresh; return $self->status; } sub current_state { my $self = shift; $self->refresh; return $self->state; } 1; VM-EC2-1.23/lib/VM/EC2/Spot/Status.pm000444001751001751 256712100273360 16661 0ustar00lsteinlstein000000000000package VM::EC2::Spot::Status; =head1 NAME VM::EC2::Spot::Status - Object describing an Amazon EC2 spot instance status message =head1 SYNOPSIS See L, and L. =head1 DESCRIPTION This object represents an Amazon EC2 spot instance status message, which is returned by a VM::EC2::Spot::InstanceRequest object's status() method. It provides information about the spot instance request status. =head1 METHODS These object methods are supported: code -- the status code of the request. updateTime -- the time the status was stated. message -- the description for the status code for the Spot request. =head1 SEE ALSO L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use VM::EC2::Group; use base 'VM::EC2::Generic'; sub valid_fields { return qw(code updateTime message); } sub short_name { shift->code } 1; VM-EC2-1.23/lib/VM/EC2/Spot/DatafeedSubscription.pm000444001751001751 347512100273360 21477 0ustar00lsteinlstein000000000000package VM::EC2::Spot::DatafeedSubscription; =head1 NAME VM::EC2::Spot::DatafeedSubscription - Object describing an Amazon EC2 spot instance datafeed subscription =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $sub = $ec2->create_spot_datafeed_subscription('myBucket','SPOT:'); my $owner = $sub->ownerId; my $bucket = $sub->bucket; my $prefix = $sub->prefix; my $state = $sub->state; my $error = $sub->fault; =head1 DESCRIPTION This object represents an Amazon EC2 spot instance datafeed subscription, and is returned by VM::EC2->create_spot_datafeed_subscription() and VM::EC2->describe_spot_datafeed_subscription(). =head1 METHODS These object methods are supported: ownerId -- ID of the owner of this subscription bucket -- bucket receiving the subscription files prefix -- prefix for log files written into the bucket state -- state of the subscription; one of 'Active' or 'Inactive' fault -- VM::EC2::Error object describing errors in the subscription. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(ownerId bucket prefix state fault); } sub fault { my $self = shift; my $f = $self->SUPER::fault or return; return VM::EC2::Error->new($f,$self->ec2); } 1; VM-EC2-1.23/lib/VM/EC2/Spot/PriceHistory.pm000444001751001751 400112100273360 20003 0ustar00lsteinlstein000000000000package VM::EC2::Spot::PriceHistory; use strict; use base 'VM::EC2::Generic'; =head1 NAME VM::EC2::Spot::PriceHistory - Object describing an Amazon EC2 spot instance price history record =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); my @history = $ec2->describe_spot_price_history(-start_time => '2011-09-01T00:00:00', -end_time => '2011-09-05T00:00:00', -availability_zone => 'us-east-1a', -instance_type => 'm1.small', -filter => {'product-description'=>'*Linux*'}, } or die $ec2->error_str; for my $h (@history) { print join("\t",$h->timestamp, $h->spot_price, $h->instanceType, $h->productDescription, $h->availability_zone),"\n"; } =head1 DESCRIPTION This object represents an Amazon EC2 spot instance price history record, and is returned by VM::EC2->describe_spot_price_history(). =head1 METHODS These object methods are supported: instanceType -- Instance type, e.g. 'm1.small' productDescription -- Product description, e.g. "windows" spotPrice -- Price, in dollars per run-hour. timestamp -- Timestamp of data point, in format yyyy-mm-ddThh:mm:ss.000Z availabilityZone -- Availability zone of spot instance. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut sub valid_fields { my $self = shift; return qw(instanceType productDescription spotPrice timestamp availabilityZone); } 1; VM-EC2-1.23/lib/VM/EC2/Spot/LaunchSpecification.pm000444001751001751 602112100273360 21276 0ustar00lsteinlstein000000000000package VM::EC2::Spot::LaunchSpecification; =head1 NAME VM::EC2::Spot::LaunchSpecification - Object describing an Amazon EC2 spot instance launch specification =head1 SYNOPSIS See L, and L. =head1 DESCRIPTION This object represents an Amazon EC2 spot instance launch specification, which is returned by a VM::EC2::Spot::InstanceRequest object's launchSpecification() method. It provides information about the spot instance request. =head1 METHODS These object methods are supported: imageId -- the ID of the image to be used for the request keyName -- the ssh keyname for instances created by the request groupSet -- a list of VM::EC2::Group objects representing the launch groups for spot instances created under this request. addressingType -- Deprecated and undocumented, but present in the EC2 API instanceType -- type of instances created by the request placement -- availability zone for instances created by the request kernelId -- kernel ID to be used for instances launched by the request ramdiskId -- ramdisk ID to be used for instances launched by the request blockDeviceMapping -- List of VM::EC2::BlockDevice::Mapping objects describing the block devices to be attached to instances launched by the request. monitoring -- A true value if detailed monitoring was requested for these instances. subnetId -- Subnet ID in which to place instances launched under this request (VPC only). =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use VM::EC2::Group; use base 'VM::EC2::Generic'; sub valid_fields { return qw(imageId keyName groupSet addressingType instanceType placement kernelId ramdiskId blockDeviceMapping monitoring subnetId); } sub blockDeviceMapping { my $self = shift; my $mapping = $self->SUPER::blockDeviceMapping or return; my @mapping = map { VM::EC2::BlockDevice::Mapping->new($_,$self->ec2)} @{$mapping->{item}}; foreach (@mapping) { $_->instance($self) } return @mapping; } sub monitoring { my $self = shift; my $monitoring = $self->SUPER::monitoring or return; return $monitoring->{enabled} eq 'true'; } sub groupSet { my $self = shift; my $groupSet = $self->SUPER::groupSet; return map {VM::EC2::Group->new($_,$self->aws,$self->xmlns,$self->requestId)} @{$groupSet->{item}}; } 1; VM-EC2-1.23/lib/VM/EC2/Image000755001751001751 012100273360 14766 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/Image/LaunchPermission.pm000444001751001751 303112100273360 20741 0ustar00lsteinlstein000000000000package VM::EC2::Image::LaunchPermission; =head1 NAME VM::EC2::Region - Object describing AMI launch permissions =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $image = $ec2->describe_images('ami-12345'); @users = $image->launchPermissions; for (@users) { $group = $_->group; $user = $_->userId; } =head1 DESCRIPTION This object represents an Amazon machine image launch permission, and is return by VM::EC2::Image launchPermissions(). =head1 METHODS These object methods are supported: group -- Name of a group with launch permissions. Only valid value is "all" userId -- Name of a user with launch permissions. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the userId. If the userId is blank, then interpolates as the group. =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub primary_id {my $self = shift; $self->userId || $self->group }; sub valid_fields { my $self = shift; return qw(group userId); } 1; VM-EC2-1.23/lib/VM/EC2/VPC000755001751001751 012100273360 14374 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/VPC/Subnet.pm000444001751001751 1352112100273360 16351 0ustar00lsteinlstein000000000000package VM::EC2::VPC::Subnet; =head1 NAME VM::EC2::VPC::Subnet -- A VPC subnet =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $vpc = $ec2->create_vpc('10.0.0.0/16'); my $subnet = $vpc->create_subnet('10.0.0.0/24') or die $vpc->error_str; @subnets = $ec2->describe_subnets; for my $sn (@subnets) { print $sn->subnetId,"\n", $sn->state,"\n", $sn->vpcId,"\n", $sn->cidrBlock,"\n", $sn->availableIpAddressCount,"\n", $sn->availabilityZone,"\n"; } =head1 DESCRIPTION This object supports the EC2 Virtual Private Cloud subnet interface. Please see L for methods shared by all VM::EC2 objects. =head1 METHODS These object methods are supported: subnetId -- the ID of the subnet state -- The current state of the subnet, either "pending" or "available" vpcId -- The ID of the VPC the subnet is in. cidrBlock -- The CIDR block assigned to the subnet. availableIpAddressCount -- The number of unused IP addresses in the subnet. availableZone -- This subnet's availability zone. This class supports the VM::EC2 tagging interface. See L for information. In addition, this object supports the following convenience methods: vpc() -- Return the associated VM::EC2::VPC object. zone() -- Return the associated VM::EC2::AvailabilityZone object. refresh() -- Refreshes the object from its current state in EC2. current_state() -- Refreshes the object and returns its current state. create_route_table() -- Create a new route table, associates it with this subnet, and returns the corresponding VM::EC2::VPC::RouteTable object. associate_route_table($table) -- Associates a route table with this subnet, returning true if sucessful. disassociate_route_table($table) -- Removes the association of a route table with this subnet. Produces a fatal error if $table is not associated with the subnet. Returns true on success. associate_network_acl($network_acl_id) -- Associates a network ACL with this subnet, returning the new association ID on success. disassociate_network_acl() -- Removes the association of a network ACL with this subnet. The subnet will then be associated with the default network ACL. Returns the the association ID. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the subnet ID. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use Carp 'croak'; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(subnetId state vpcId cidrBlock availableIpAddressCount availabilityZone); } sub primary_id { shift->subnetId } sub vpc { my $self = shift; return $self->aws->describe_vpcs($self->vpcId); } sub zone { my $self = shift; return $self->aws->describe_availability_zones($self->availabilityZone); } sub refresh { my $self = shift; my $i = shift; local $self->aws->{raise_error} = 1; ($i) = $self->aws->describe_subnets($self->subnetId) unless $i; %$self = %$i; } sub current_state { my $self = shift; $self->refresh; $self->state; } sub associate_route_table { my $self = shift; my $rt = shift or croak "usage: associate_route_table(\$route_table_id)"; return $self->aws->associate_route_table(-subnet_id => $self->subnetId, -route_table_id => $rt); } sub disassociate_route_table { my $self = shift; my $rt = shift or croak "usage: disassociate_route_table(\$route_table_id)"; $rt = $self->aws->describe_route_tables($rt) unless ref $rt; my ($association) = grep {$_->subnetId eq $self->subnetId} $rt->associations; $association or croak "$rt is not associated with this subnet"; return $self->aws->disassociate_route_table($association); } sub create_route_table { my $self = shift; my $vpc = $self->vpcId; my $rt = $self->aws->create_route_table($vpc) or return; return $self->associate_route_table($rt); } sub disassociate_network_acl { my $self = shift; my $acl = $self->aws->describe_network_acls(-filter=>{ 'association.subnet-id' => $self->subnetId}); if ($acl->default) { print "disassociate_network_acl(): Cannot disassociate subnet from default ACL"; return; } my $default_acl = $self->aws->describe_network_acls(-filter=>{ 'default' => 'true', 'vpc-id' => $self->vpcId}) or croak "disassociate_network_acl(): Cannot determine default ACL"; return $self->associate_network_acl($default_acl->networkAclId); } sub associate_network_acl { my $self = shift; my $network_acl_id = shift or croak "usage: associate_network_acl(\$network_acl_id)"; my $acl = $self->aws->describe_network_acls(-filter=>{ 'association.subnet-id' => $self->subnetId}) or croak "associate_network_acl(): Cannot determine current ACL"; my ($association) = grep { $_->subnetId eq $self->subnetId } $acl->associations; my $association_id = $association->networkAclAssociationId; return $self->aws->replace_network_acl_association(-association_id=>$association_id,-network_acl_id=>$network_acl_id); } 1; VM-EC2-1.23/lib/VM/EC2/VPC/RouteTable.pm000444001751001751 704312100273360 17141 0ustar00lsteinlstein000000000000package VM::EC2::VPC::RouteTable; =head1 NAME VM::EC2::VPC::RouteTable -- A VPC route table =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my @tables = $ec2->describe_route_tables; for my $rt (@tables) { print $rt->routeTableId,"\n", $rt->vpcId,"\n"; my @routes = $rt->routes; my @associations = $rt->associations; } =head1 DESCRIPTION This object supports the EC2 Virtual Private Cloud route table interface, and is used to control the routing of packets within and between subnets. =head1 METHODS These object methods are supported: routeTableId -- the ID of the route table vpcId -- The ID of the VPC the route table is in. routes -- An array of VM::EC2::VPC::Route objects, each describing a routing rule in the table. associations -- An array of VM::EC2::RouteTable::Association objects, each describing the association between the route table and a subnet. This class supports the VM::EC2 tagging interface. See L for information. In addition, this object supports the following convenience methods: vpc -- The VPC object for this route table. main -- Returns true if this is the VPC's current "main" route table associate($subnet) -- Associate the route table with a subnet ID or object. disassociate($subnet) -- Disassociate the route table with a subnet ID or object. refresh -- Refreshes the object from its current state in EC2. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the route table ID. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use Carp 'croak'; use base 'VM::EC2::Generic'; use VM::EC2::VPC::Route; use VM::EC2::VPC::RouteTable::Association; sub valid_fields { my $self = shift; return qw(routeTableId vpcId routeSet associationSet); } sub primary_id { shift->routeTableId } sub vpc { my $self = shift; return $self->aws->describe_vpcs($self->vpcId); } sub routes { my $self = shift; my $set = $self->routeSet or return; return map {VM::EC2::VPC::Route->new($_,$self->aws)} @{$set->{item}}; } sub main { my $self = shift; my @a = grep {$_->main} $self->associations; return scalar @a; } sub associations { my $self = shift; my $set = $self->associationSet or return; return map {VM::EC2::VPC::RouteTable::Association->new($_,$self->aws)} @{$set->{item}}; } sub associate { my $self = shift; my $subnet = shift; $self->aws->associate_route_table($subnet=>$self); } sub disassociate { my $self = shift; my $subnet = shift; my @associations = $self->associations; my ($ass) = grep {$_->subnetId eq $subnet} @associations; return unless $ass; $self->aws->disassociate_route_table($ass->routeTableAssociationId); } sub refresh { my $self = shift; my $i = shift; local $self->aws->{raise_error} = 1; ($i) = $self->aws->describe_subnets($self->subnetId) unless $i; %$self = %$i; } 1; VM-EC2-1.23/lib/VM/EC2/VPC/VpnConnection.pm000444001751001751 702712100273360 17660 0ustar00lsteinlstein000000000000package VM::EC2::VPC::VpnConnection; =head1 NAME VM::EC2::VPC::VpnConnection - VPC VPN connection =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $vpn = $ec2->describe_vpn_connections(-vpn_connection_id=>'vpn-12345678'); my $state = $vpn->state; my $vpn_gateway = $vpn->vpn_gateway; my $customer_gateway = $vpn->customer_gateway; =head1 DESCRIPTION This object represents an Amazon EC2 VPC VPN connection, and is returned by VM::EC2->describe_vpn_connections() =head1 METHODS These object methods are supported: vpnConnectionId -- The ID of the VPN connection. state -- The current state of the VPN connection. Valid values: pending | available | deleting | deleted customerGatewayConfiguration -- Configuration information for the VPN connection's customer gateway (in the native XML format). This element is always present in the CreateVpnConnection response; however, it's present in the DescribeVpnConnections response only if the VPN connection is in the pending or available state. type -- The type of VPN connection (ipsec.1) customerGatewayId -- ID of the customer gateway at your end of the VPN connection. vpnGatewayId -- ID of the virtual private gateway at the VPC end of the VPN connection. tagSet -- Tags assigned to the resource. vgwTelemetry -- Information about the virtual private gateway. vpn_telemetry -- Alias for vgwTelemetry The following convenience methods are supported: vpn_gateway -- Returns a L object customer_gateway -- Returns a L object The object also supports the tags() method described in L: =head1 STRING OVERLOADING When used in a string context, this object will interpolate the vpnConnectionId. =head1 SEE ALSO L L L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::VPC::VpnTunnelTelemetry; use Carp 'croak'; sub primary_id { shift->vpnConnectionId } sub valid_fields { my $self = shift; return qw(vpnConnectionId state customerGatewayConfiguration type customerGatewayId vpnGatewayId tagSet vgwTelemetry); } sub vgwTelemetry { my $self = shift; my $telemetry = $self->SUPER::vgwTelemetry; return VM::EC2::VPC::VpnTunnelTelemetry->new($telemetry,$self->aws); } sub vpn_telemetry { shift->vgwTelemetry } sub vpn_gateway { my $self = shift; my $vpn_gw = $self->vpnGatewayId; return $self->aws->describe_vpn_gateways($vpn_gw); } sub customer_gateway { my $self = shift; my $cust_gw = $self->customerGatewayId; return $self->aws->describe_customer_gateways($cust_gw); } 1; VM-EC2-1.23/lib/VM/EC2/VPC/Route.pm000444001751001751 764712100273360 16203 0ustar00lsteinlstein000000000000package VM::EC2::VPC::Route; =head1 NAME VM::EC2::VPC::Route -- An entry in a VPC routing table =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $table = $ec2->describe_route_tables('rtb-123456'); my @routes = $table->routes; foreach my $r (@routes) { print $r->destinationCidrBlock,"\n", $r->gatewayId,"\n", $r->instanceId,"\n", $r->instanceOwnerId,"\n", $r->networkInterfaceId,"\n", $r->state,"\n" my $target = $r->target,"\n"; # an instance, gateway or network interface object } =head1 DESCRIPTION This object supports the EC2 Virtual Private Cloud route interface, and is used to control the routing of packets within and between subnets. Each route has a destination CIDR address block, and a target gateway, instance or network interface that will receive packets whose destination matches the block. Routes are matched in order from the most specific to the most general. =head1 METHODS These object methods are supported: destinationCidrBlock -- The CIDR address block used in the destination match. For example 0.0.0/0 for all packets. gatewayId -- The ID of an internet gateway attached to your VPC. instanceId -- The ID of an instance in your VPC to act as the destination for packets. Typically this will be a NAT instance. instanceOwnerId -- The account number of the owner of the instance. networkInterfaceId -- The ID of an Elastic Network Interface to receive packets matching the destination state -- One of "active" or "blackhole". The blackhole state applies when the route's target isn't usable for one reason or another. In addition, the following convenience methods are provided: target -- Return the target of the route. This method will return a VM::EC2::Instance, VM::EC2::VPC::InternetGateway, or VM::EC2::NetworkInterface object depending on the nature of the target. instance -- If an instance is the target, return the corresponding VM::EC2::Instance object gateway -- If a gateway is the target, return the corresponding VM::EC2::VPC::InternetGateway object. network_interface -- If a network interface is the target, return the corresponding VM::EC2::NetworkInterface object. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the destinationCidrBlock =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use Carp 'croak'; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(destinationCidrBlock gatewayId instanceId instanceOwnerId networkInterfaceId state); } sub short_name { shift->destinationCidrBlock } sub instance { my $self = shift; my $instance = $self->instanceId or return; return $self->aws->describe_instances($instance); } sub gateway { my $self = shift; my $gw = $self->gatewayId or return; return $self->aws->describe_internet_gateways($gw); } sub network_interface { my $self = shift; my $ni = $self->networkInterfaceId or return; return $self->aws->describe_network_interfaces($ni); } sub target { my $self = shift; return $self->instance || $self->gateway || $self->network_interface; } 1; VM-EC2-1.23/lib/VM/EC2/VPC/VpnTunnelTelemetry.pm000444001751001751 376512100273360 20726 0ustar00lsteinlstein000000000000package VM::EC2::VPC::VpnTunnelTelemetry; =head1 NAME VM::EC2::VPC::TunnelTelemetry - Virtual Private Cloud VPN tunnel telemetry =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $vpn = $ec2->describe_vpn_connections(-vpn_connection_id=>'vpn-12345678'); my $telemetry = $vpn->vpn_telemetry; print $telemetry->status,"\n"; =head1 DESCRIPTION This object represents an Amazon EC2 VPC route, and is returned by VM::EC2->describe_vpn_connections() =head1 METHODS These object methods are supported: outsideIpAddress -- The Internet-routable IP address of the virtual private gateway's outside interface. status -- The status of the VPN tunnel. Valid values: UP | DOWN lastStatusChange -- The date and time of the last change in status. statusMessage -- If an error occurs, a description of the error. acceptedRouteCount -- The number of accepted routes. The object also supports the tags() method described in L: =head1 STRING OVERLOADING When used in a string context, this object will interpolate the status. =head1 SEE ALSO L L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::VPC::VpnTunnelTelemetry; use Carp 'croak'; sub primary_id { shift->status } sub valid_fields { my $self = shift; return qw(outsideIpAddress status lastStatusChange statusMessage acceptedRouteCount); } 1; VM-EC2-1.23/lib/VM/EC2/VPC/NetworkAcl.pm000444001751001751 2711412100273360 17165 0ustar00lsteinlstein000000000000package VM::EC2::VPC::NetworkAcl; =head1 NAME VM::EC2::VPC::NetworkAcl - Virtual Private Cloud network ACL =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my @acls = $ec2->describe_network_acls(-network_acl_id=>'acl-12345678'); foreach my $acl (@acls) { my $vpc_id = $acl->vpcId; my $default = $acl->default; my @entries = $acl->entries; my @assoc = $acl->associations; ... } my $acl = $ec2->create_network_acl_entry(...); =head1 DESCRIPTION This object represents an Amazon EC2 VPC network ACL, and is returned by VM::EC2->describe_network_acls() and ->create_network_acl() =head1 METHODS These object methods are supported: networkAclId -- The network ACL's ID. vpcId -- The ID of the VPC the network ACL is in. default -- Whether this is the default network ACL in the VPC. entrySet -- A list of entries (rules) in the network ACL. associationSet -- A list of associations between the network ACL and one or more subnets. tagSet -- Tags assigned to the resource. associations -- Alias for associationSet. entries -- Alias for entrySet. The object also supports the tags() method described in L: =head1 CONVENIENCE METHODS =head2 $success = $acl->create_entry(%args) =head2 $success = $acl->create_entry($acl_entry) Creates an entry (i.e., rule) in a network ACL with the rule number you specified. Each network ACL has a set of numbered ingress rules and a separate set of numbered egress rules. When determining whether a packet should be allowed in or out of a subnet associated with the ACL, Amazon VPC processes the entries in the ACL according to the rule numbers, in ascending order. Arguments: -rule_number -- Rule number to assign to the entry (e.g., 100). ACL entries are processed in ascending order by rule number. Positive integer from 1 to 32766. (Required) -protocol -- The IP protocol the rule applies to. You can use -1 to mean all protocols. See http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml for a list of protocol numbers. (Required) -rule_action -- Indicates whether to allow or deny traffic that matches the rule. allow | deny (Required) -egress -- Indicates whether this rule applies to egress traffic from the subnet (true) or ingress traffic to the subnet (false). Default is false. -cidr_block -- The CIDR range to allow or deny, in CIDR notation (e.g., 172.16.0.0/24). (Required) -icmp_code -- For the ICMP protocol, the ICMP code. You can use -1 to specify all ICMP codes for the given ICMP type. Required if specifying 1 (ICMP) for protocol. -icmp_type -- For the ICMP protocol, the ICMP type. You can use -1 to specify all ICMP types. Required if specifying 1 (ICMP) for the protocol -port_from -- The first port in the range. Required if specifying 6 (TCP) or 17 (UDP) for the protocol. -port_to -- The last port in the range. Required if specifying 6 (TCP) or 17 (UDP) for the protocol. Alternately, can pass an existing ACL entry object L as the only argument for ease in copying entries from one ACL to another. Returns true on successful creation. =head2 $success = $acl->delete_entry(%args) =head2 $success = $acl->delete_entry($acl_entry) Deletes an ingress or egress entry (i.e., rule) from a network ACL. Arguments: -network_acl_id -- ID of the ACL where the entry will be created -rule_number -- Rule number of the entry (e.g., 100). Optional arguments: -egress -- Whether the rule to delete is an egress rule (true) or ingress rule (false). Default is false. Alternately, can pass an existing ACL entry object L as the only argument to ease deletion of entries. Returns true on successful deletion. =head2 $success = replace_entry(%args) =head2 $success = replace_entry($acl_entry) Replaces an entry (i.e., rule) in a network ACL. Arguments: -network_acl_id -- ID of the ACL where the entry will be created (Required) -rule_number -- Rule number of the entry to replace. (Required) -protocol -- The IP protocol the rule applies to. You can use -1 to mean all protocols. See http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml for a list of protocol numbers. (Required) -rule_action -- Indicates whether to allow or deny traffic that matches the rule. allow | deny (Required) -egress -- Indicates whether this rule applies to egress traffic from the subnet (true) or ingress traffic to the subnet (false). Default is false. -cidr_block -- The CIDR range to allow or deny, in CIDR notation (e.g., 172.16.0.0/24). (Required) -icmp_code -- For the ICMP protocol, the ICMP code. You can use -1 to specify all ICMP codes for the given ICMP type. Required if specifying 1 (ICMP) for protocol. -icmp_type -- For the ICMP protocol, the ICMP type. You can use -1 to specify all ICMP types. Required if specifying 1 (ICMP) for the protocol -port_from -- The first port in the range. Required if specifying 6 (TCP) or 17 (UDP) for the protocol. -port_to -- The last port in the range. Only required if specifying 6 (TCP) or 17 (UDP) for the protocol and is a different port than -port_from. Alternately, can pass an existing ACL entry object L as the only argument for ease in replacing entries from one ACL to another. The rule number in the passed entry object must already exist in the ACL. Returns true on successful replacement. =head2 $association_id = $acl->associate($subnet_id) Associates the ACL with a subnet in the same VPC. Replaces whatever ACL the subnet was associated with previously. =head2 $association_id = $acl->disassociate($subnet_id) Disassociates the ACL with a subnet in the same VPC. The subnet will then be associated with the default ACL. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the networkAclId. =head1 SEE ALSO L L L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::VPC::NetworkAcl::Entry; use VM::EC2::VPC::NetworkAcl::Association; use Carp 'croak'; sub primary_id { shift->networkAclId } sub valid_fields { my $self = shift; return qw(networkAclId vpcId default entrySet associationSet tagSet); } sub default { my $self = shift; my $entries = $self->SUPER::default; return $entries eq 'true'; } sub entrySet { my $self = shift; my $entries = $self->SUPER::entrySet; return map { VM::EC2::VPC::NetworkAcl::Entry->new($_,$self->aws) } @{$entries->{item}}; } sub entries { shift->entrySet } sub associationSet { my $self = shift; my $assoc = $self->SUPER::associationSet; return map { VM::EC2::VPC::NetworkAcl::Association->new($_,$self->aws) } @{$assoc->{item}}; } sub associations { shift->associationSet } sub create_entry { my $self = shift; my %args; if (@_ == 1 && $_[0] !~ /^-/ && ref $_[0] eq 'VM::EC2::VPC::NetworkAcl::Entry') { my $entry = shift; $args{-rule_number} = $entry->ruleNumber; $args{-protocol} = $entry->protocol; $args{-rule_action} = $entry->ruleAction; $args{-egress} = $entry->egress; $args{-cidr_block} = $entry->cidrBlock; $args{-icmpType} = $entry->icmpType; $args{-icmpCode} = $entry->icmpCode; $args{-port_from} = $entry->portRangeFrom; $args{-port_to} = $entry->portRangeTo; } else { %args = @_; } $args{-network_acl_id} = $self->networkAclId; return $self->aws->create_network_acl_entry(%args); } sub delete_entry { my $self = shift; my %args; if (@_ == 1 && $_[0] !~ /^-/ && ref $_[0] eq 'VM::EC2::VPC::NetworkAcl::Entry') { my $entry = shift; $args{-rule_number} = $entry->ruleNumber; $args{-egress} = $entry->egress; } else { %args = @_; } $args{-network_acl_id} = $self->networkAclId; return $self->aws->delete_network_acl_entry(%args); } sub replace_entry { my $self = shift; my %args; if (@_ == 1 && $_[0] !~ /^-/ && ref $_[0] eq 'VM::EC2::VPC::NetworkAcl::Entry') { my $entry = shift; $args{-rule_number} = $entry->ruleNumber; $args{-protocol} = $entry->protocol; $args{-rule_action} = $entry->ruleAction; $args{-egress} = $entry->egress; $args{-cidr_block} = $entry->cidrBlock; $args{-icmpType} = $entry->icmpType; $args{-icmpCode} = $entry->icmpCode; $args{-port_from} = $entry->portRangeFrom; $args{-port_to} = $entry->portRangeTo; } else { %args = @_; } $args{-network_acl_id} = $self->networkAclId; return $self->aws->replace_network_acl_entry(%args); } sub associate { my $self = shift; my $subnet_id = shift or croak "usage: associate(\$subnet_id)"; # get the acl the subnet is currently associated with in order the find the association id my $acl = $self->aws->describe_network_acls(-filter=>{ 'association.subnet-id' => $subnet_id}) or croak "associate(): Cannot determine ACL for subnet $subnet_id"; my ($association) = grep { $_->subnetId eq $subnet_id } $acl->associations; my $association_id = $association->networkAclAssociationId; my $network_acl_id = $self->networkAclId; return $self->aws->replace_network_acl_association(-association_id=>$association_id,-network_acl_id=>$network_acl_id); } sub disassociate { my $self = shift; my $subnet_id = shift or croak "usage: associate(\$subnet_id)"; $self->default and croak "Cannot disassociate subnet from default ACL"; # determine association id for this acl my ($association) = grep { $_->subnetId eq $subnet_id } $self->associations; my $association_id = $association->networkAclAssociationId; # determine default acl for this subnet my $default_acl = $self->aws->describe_network_acls(-filter=>{ 'default' => 'true', 'vpc-id' => $self->vpcId}) or croak "disassociate(): Cannot determine default ACL"; my $network_acl_id = $default_acl->networkAclId; return $self->aws->replace_network_acl_association(-association_id=>$association_id,-network_acl_id=>$network_acl_id); } 1; VM-EC2-1.23/lib/VM/EC2/VPC/CustomerGateway.pm000444001751001751 422712100273360 20217 0ustar00lsteinlstein000000000000package VM::EC2::VPC::CustomerGateway; =head1 NAME VM::EC2::VPC::CustomerGateway - Object describing an Amazon EC2 Virtual Private Cloud customer gateway =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $gtwy = $ec2->describe_customer_gateways(-customer_gatway_id=>'cgw-12345678'); print $gtwy->ipAddress,"\n", $gtwy->state,"\n"; =head1 DESCRIPTION This object represents an Amazon EC2 VPC route, and is returned by VM::EC2->describe_customer_gateways() and ->create_customer_gateway() =head1 METHODS These object methods are supported: customerGatewayId -- The ID of the customer gateway. state -- The current state of the customer gateway. Valid values: pending | available | deleting | deleted type -- The type of VPN connection the customer gateway supports (ipsec.1). ipAddress -- The Internet-routable IP address of the customer gateway's outside interface. bgpAsn -- The customer gateway's Border Gateway Protocol (BGP) Autonomous System Number (ASN). tagSet -- Tags assigned to the resource. The object also supports the tags() method described in L: =head1 STRING OVERLOADING When used in a string context, this object will interpolate the customerGatewayId. =head1 SEE ALSO L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use Carp 'croak'; sub primary_id { shift->customerGatewayId} sub valid_fields { my $self = shift; return qw(customerGatewayId state type ipAddress bgpAsn tagSet); } 1; VM-EC2-1.23/lib/VM/EC2/VPC/VpnGateway.pm000444001751001751 522412100273360 17157 0ustar00lsteinlstein000000000000package VM::EC2::VPC::VpnGateway; =head1 NAME VM::EC2::VPC::VpnGateway - Virtual Private Cloud VPN gateway =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $gtwy = $ec2->describe_vpn_gateways(-vpn_gatway_id=>'vgw-12345678'); my $state = $gtwy->state; =head1 DESCRIPTION This object represents an Amazon EC2 VPC route, and is returned by VM::EC2->describe_internet_gateways() and ->create_internet_gateway() =head1 METHODS These object methods are supported: vpnGatewayId -- The ID of the VPN gateway. state -- The current state of the virtual private gateway. Valid values: pending | available | deleting | deleted type -- The type of VPN connection the virtual private gateway supports (ipsec.1) availabilityZone -- The Availability Zone where the virtual private gateway was created as a L object. attachments -- A list of VPCs attached to the VPN gateway. tagSet -- Tags assigned to the resource. zone -- Alias for availabilityZone. The following convenience methods are supported: attachments -- Returns a series of L objects The object also supports the tags() method described in L: =head1 STRING OVERLOADING When used in a string context, this object will interpolate the vpnGatewayId. =head1 SEE ALSO L L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::VPC::VpnGateway::Attachment; use Carp 'croak'; sub primary_id { shift->vpnGatewayId } sub valid_fields { my $self = shift; return qw(vpnGatewayId state type availabilityZone attachments tagSet); } sub attachments { my $self = shift; my $attach = $self->SUPER::attachments; return map { VM::EC2::VPC::VpnGateway::Attachment->new($_,$self->aws) } @{$attach->{item}}; } sub availabilityZone { my $self = shift; my $zone = $self->SUPER::availabilityZone; return $self->aws->describe_availability_zones($zone); } sub zone { shift->availabilityZone } 1; VM-EC2-1.23/lib/VM/EC2/VPC/InternetGateway.pm000444001751001751 577312100273360 20215 0ustar00lsteinlstein000000000000package VM::EC2::VPC::InternetGateway; =head1 NAME VM::EC2::VPC::InternetGateway -- A VPC internet gateway =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my @gateways = $ec2->describe_internet_gateways; for my $gw (@gateways) { print $gw->internetGatewayId,"\n"; my @attachments = $gw->attachments; } =head1 DESCRIPTION This object provides information about EC2 Virtual Private Cloud internet gateways, which, together with routing tables, allow instances within a VPC to communicate with the outside world. =head1 METHODS These object methods are supported: internetGatewayId -- the ID of the gateway attachments -- An array of VM::EC2::VPC::InternetGateway::Attachment objects, each describing a VPC attached to this gateway. This class supports the VM::EC2 tagging interface. See L for information. In addition, this object supports the following convenience methods: attach($vpc) -- Attach this gateway to the indicated VPC (ID or VM::EC2::VPC object). detach($vpc) -- Detach this gateway from the indicated VPC (ID or VM::EC2::VPC object). refresh -- Refreshes the contents of the object, primarily to check for changes in attachment state. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the internet gateway ID. =head1 SEE ALSO L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use Carp 'croak'; use base 'VM::EC2::Generic'; use VM::EC2::VPC::InternetGateway::Attachment; sub valid_fields { my $self = shift; return qw(internetGatewayId attachmentSet); } sub primary_id { shift->internetGatewayId } sub attachments { my $self = shift; my $set = $self->attachmentSet or return; return map {VM::EC2::VPC::InternetGateway::Attachment->new($_,$self->aws)} @{$set->{item}}; } sub attach { my $self = shift; my $vpc = shift or croak "Usage: attach(\$vpc)"; my $result = $self->aws->attach_internet_gateway($self=>$vpc); $self->refresh if $result; return $result; } sub detach { my $self = shift; my $vpc = shift or croak "Usage: detach(\$vpc)"; my $result = $self->aws->detach_internet_gateway($self => $vpc); $self->refresh if $result; return $result; } sub refresh { my $self = shift; my $i = shift; local $self->aws->{raise_error} = 1; ($i) = $self->aws->describe_internet_gateways($self->internetGatewayId) unless $i; %$self = %$i; } 1; VM-EC2-1.23/lib/VM/EC2/VPC/DhcpOptions.pm000444001751001751 601312100273360 17321 0ustar00lsteinlstein000000000000package VM::EC2::VPC::DhcpOptions; =head1 NAME VM::EC2::VPC::DhcpOptions -- DHCP options set for an AWS Virtual Private Cloud =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $vpc = $ec2->create_vpc('10.0.0.0/16'); my $options = $ec2->create_dhcp_options(-domain_name=>'test.com', -domain_name_servers=>['204.16.255.55','216.239.34.10']); $vpc->set_dhcp_options($options); =head1 DESCRIPTION Please see L for methods shared by all VM::EC2 objects. =head1 METHODS These object methods are supported: dhcpOptionsId -- ID of the dhcp options dhcpConfigurationSet -- Hash of options In addition, this object supports the following convenience methods: options() -- return list of DHCP options contained in this set option('option-name') -- return list of values for the named option. Note that all options correspond to a list; calling in a scalar context will return size of the list associate_vpc($vpc_id) -- Associate these options with the given VPC. associated_vpcs() -- Return list of VPCs associated with the DHCP option set. as_string() -- returns a string concatenation of all options =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the dhcp ID. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use Carp 'croak'; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(dhcpOptionsId dhcpConfigurationSet); } sub primary_id { shift->dhcpOptionsId } sub option { my $self = shift; my $key = shift; my $hash = $self->dhcpConfigurationSet or return; my @items = @{$hash->{item}} or return; my @result; foreach (@items) { next unless $_->{key} eq $key; push @result,map {$_->{value}} @{$_->{valueSet}{item}} } return @result; } sub options { my $self = shift; my $hash = $self->dhcpConfigurationSet or return; my @items = @{$hash->{item}} or return; return map {$_->{key}} @items; } sub associate_vpc { my $self = shift; my $vpc = shift or croak "Usage: associate_vpc(\$vpc_id)"; $self->aws->associate_dhcp_options($vpc => $self); } sub associated_vpcs { my $self = shift; return $self->aws->describe_vpcs({'dhcp-options-id'=>$self}); } sub as_string { my $self = shift; my @options = $self->options; my @results = map {"$_ = ".join(',',$self->option($_))} @options; return join '; ',@results; } 1; VM-EC2-1.23/lib/VM/EC2/VPC/NetworkAcl000755001751001751 012100273360 16445 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/VPC/NetworkAcl/Association.pm000444001751001751 446512100273360 21425 0ustar00lsteinlstein000000000000package VM::EC2::VPC::NetworkAcl::Association; =head1 NAME VM::EC2::VPC::NetworkAcl::Association - The association between a network acl and a subnet =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $acl = $ec2->describe_network_acls(-network_acl_id=>'acl-12345678'); my @assoc = $acl->associations; foreach my $a (@assoc) { print $a->networkAclAssociationId,"\n", $a->networkAclId,"\n", $a->subnetId,"\n"; } =head1 DESCRIPTION This object represents an Amazon EC2 VPC network ACL association =head1 METHODS These object methods are supported: networkAclAssociationId -- An identifier representing the association between a network ACL and a subnet. networkAclId -- The ID of the network ACL in the association. subnetId -- The ID of the subnet in the association. The following convenience methods are supported: network_acl -- A VM::EC2::VPC::NetworkAcl object subnet -- A VM::EC2::VPC::Subnet object The object also supports the tags() method described in L: =head1 STRING OVERLOADING When used in a string context, this object will interpolate the subnetId. =head1 SEE ALSO L L L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use Carp 'croak'; sub primary_id { shift->subnetId } sub valid_fields { my $self = shift; return qw(networkAclAssociationId networkAclId subnetId); } sub network_acl { my $self = shift; my $acl = $self->networkAclId or return; return $self->aws->describe_network_acls($acl); } sub subnet { my $self = shift; my $sn = $self->subnetId or return; return $self->aws->describe_subnets($sn); } 1; VM-EC2-1.23/lib/VM/EC2/VPC/NetworkAcl/Entry.pm000444001751001751 723212100273360 20245 0ustar00lsteinlstein000000000000package VM::EC2::VPC::NetworkAcl::Entry; =head1 NAME VM::EC2::VPC::NetworkAcl::Entry - VPC Network ACL entry =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $acl = $ec2->describe_network_acls(-network_acl_id=>'acl-12345678'); my @entries = $acl->entries; # print outgoing icmp rules for my $e (@entries) { if ($e->egress && $e->protocol == 1) { # icmp = 1 print $e->ruleNumber,"\n", $e->ruleAction,"\n", $e->cidrBlock,"\n", $e->icmpType,"\n", $e->icmpCode,"\n"; } } # print incoming tcp rules for my $e (@entries) { if (! $e->egress && $e->protocol == 6) { # tcp = 6 print $e->ruleNumber,"\n", $e->ruleAction,"\n", $e->cidrBlock,"\n", $e->port_from,'-',$e->port_to,"\n"; } } =head1 DESCRIPTION This object represents an Amazon EC2 VPC network ACL entry =head1 METHODS These object methods are supported: ruleNumber -- Specific rule number for the entry. ACL entries are processed in ascending order by rule number. protocol -- Protocol. A value of -1 means all protocols. See: http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xml for a list of protocol numbers. ruleAction -- Whether to allow or deny the traffic that matches the rule. Valid values: allow | deny egress -- Boolean flag to indicate an egress rule (rule is applied to traffic leaving the subnet). Value of true indicates egress. cidrBlock -- The network range to allow or deny, in CIDR notation. icmpType -- For the ICMP protocol, this is the ICMP type icmpCode -- For the ICMP protocol, this is the ICMP code. portRangeFrom -- For the TCP or UDP protocols, the starting range of ports the rule applies to. portRangeTo -- For the TCP or UDP protocols, the ending range of ports the rule applies to. port_from -- Alias for portRangeFrom port_to -- Alias for portRangeTo The object also supports the tags() method described in L: =head1 STRING OVERLOADING When used in a string context, this object will interpolate the rule number =head1 SEE ALSO L L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use Carp 'croak'; sub primary_id { shift->ruleNumber } sub valid_fields { my $self = shift; return qw(ruleNumber protocol ruleAction egress cidrBlock icmpTypeCode portRange); } sub egress { my $self = shift; return $self->SUPER::egress eq 'true'; } sub icmpType { my $self = shift; my $typecode = $self->icmpTypeCode; return $typecode->{type}; } sub icmpCode { my $self = shift; my $typecode = $self->icmpTypeCode; return $typecode->{code}; } sub portRangeFrom { my $self = shift; my $portRange = $self->portRange; return $portRange->{from}; } sub port_from { shift->portRangeFrom } sub portRangeTo { my $self = shift; my $portRange = $self->portRange; return $portRange->{to}; } sub port_to { shift->portRangeTo } 1; VM-EC2-1.23/lib/VM/EC2/VPC/RouteTable000755001751001751 012100273360 16442 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/VPC/RouteTable/Association.pm000444001751001751 504012100273360 21410 0ustar00lsteinlstein000000000000package VM::EC2::VPC::RouteTable::Association; =head1 NAME VM::EC2::VPC::RouteTable::Association -- The association between a route table and a subnet =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $table = $ec2->describe_route_tables('rtb-123456'); my @associations = $table->associations; foreach my $a (@associations) { print $a->routeTableAssociationId,"\n", $a->routeTableId,"\n", $a->subnetid,"\n", $a->main,"\n"; } =head1 DESCRIPTION This object describes the association between a EC2 Virtual Private Cloud routing table and a particular subnet. The special "main" route table, which is assigned to newly-created subnets by default, is designated by an association that returns a true value for the main() method. =head1 METHODS These object methods are supported: routeTableAssociationId -- An identifier representing this association. routeTableId -- The ID of the associated route table. subnetId -- The ID of the associated subnet. main -- Returns true if the associated route table is the VPC's main table. In addition, the following convenience methods are provided: route_table -- Return the VM::EC2::VPC::RouteTable object. subnet -- Return the VM::EC2::VPC::Subnet object. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the routeTableAssociationId. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use Carp 'croak'; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(routeTableAssociationId routeTableId subnetId main); } sub short_name { shift->routeTableAssociationId } sub route_table { my $self = shift; my $rt = $self->routeTableId or return; return $self->aws->describe_route_tables($rt); } sub subnet { my $self = shift; my $sn = $self->subnetId or return; return $self->aws->describe_subnets($sn); } sub main { shift->SUPER::main eq 'true' } 1; VM-EC2-1.23/lib/VM/EC2/VPC/VpnGateway000755001751001751 012100273360 16461 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/VPC/VpnGateway/Attachment.pm000444001751001751 351712100273360 21252 0ustar00lsteinlstein000000000000package VM::EC2::VPC::VpnGateway::Attachment; =head1 NAME VM::EC2::VPC::VpnGateway::Attachment -- Attachment of a vpn gateway to a VPC =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $gw = $ec2->describe_vpn_gateways('vpn-12345678'); my @attachments = $gw->attachments; for my $a (@attachments) { print $a->vpcId,"\n", $a->state,"\n"; } =head1 DESCRIPTION This object provides information about the attachment of a EC2 Virtual Private Cloud internet gateway to a VPC. =head1 METHODS These object methods are supported: vpcId -- the ID of the VPC state -- the state of the attachment; one of "attaching", "attached", "detaching" and "detached" In addition, this object supports the following convenience method: vpc -- Return the VM::EC2::VPC object corresponding to the attachment. check for changes in attachment state. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the vpcId. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use Carp 'croak'; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(vpcId state); } sub short_name { shift->vpcId } sub vpc { my $self = shift; my $vpcId = $self->vpcId or return; return $self->aws->describe_vpcs($vpcId); } 1; VM-EC2-1.23/lib/VM/EC2/VPC/InternetGateway000755001751001751 012100273360 17506 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/VPC/InternetGateway/Attachment.pm000444001751001751 355112100273360 22275 0ustar00lsteinlstein000000000000package VM::EC2::VPC::InternetGateway::Attachment; =head1 NAME VM::EC2::VPC::InternetGateway::Attachment -- Attachment of an internet gateway to a VPC =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $gw = $ec2->describe_internet_gateways('igw-12345678'); my @attachments = $gw->attachments; for my $a (@attachments) { print $a->vpcId,"\n", $a->state,"\n"; } =head1 DESCRIPTION This object provides information about the attachment of a EC2 Virtual Private Cloud internet gateway to a VPC. =head1 METHODS These object methods are supported: vpcId -- the ID of the VPC state -- the state of the attachment; one of "attaching", "attached", "detaching" and "detached" In addition, this object supports the following convenience method: vpc -- Return the VM::EC2::VPC object corresponding to the attachment. check for changes in attachment state. =head1 STRING OVERLOADING When used in a string context, this object will be interpolated as the vpcId. =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2012 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use Carp 'croak'; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(vpcId state); } sub short_name { shift->vpcId } sub vpc { my $self = shift; my $vpcId = $self->vpcId or return; return $self->aws->describe_vpcs($vpcId); } 1; VM-EC2-1.23/lib/VM/EC2/Security000755001751001751 012100273360 15553 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/Security/Credentials.pm000444001751001751 1416212100273360 20527 0ustar00lsteinlstein000000000000package VM::EC2::Security::Credentials; =head1 NAME VM::EC2::Security::Credentials -- Temporary security credentials for EC2 =head1 SYNOPSIS use VM::EC2; use VM::EC2::Security::Policy # under your account $ec2 = VM::EC2->new(...); # as usual my $policy = VM::EC2::Security::Policy->new; $policy->allow('DescribeImages','RunInstances'); my $token = $ec2->get_federation_token(-name => 'TemporaryUser', -duration => 60*60*3, # 3 hrs, as seconds -policy => $policy); print $token->sessionToken,"\n"; print $token->accessKeyId,"\n"; print $token->secretAccessKey,"\n"; print $token->federatedUser,"\n"; my $serialized = $token->serialize; # get the serialized token to the temporary user send_data_to_user_somehow($serialized); # under the temporary user's account my $serialized = get_data_somehow(); # create a copy of the token from its serialized form my $token = VM::EC2::Security::Credentials->new_from_serialized($serialized); # create a copy of the token from its JSON representation (e.g. as returned # from instance metadata of an instance that is assigned an IAM role my $token = VM::EC2::Security::Credentials->new_from_json($json); # open a new EC2 connection with this token. User will be # able to run all the methods specified in the policy. my $ec2 = VM::EC2->new(-security_token => $token); print $ec2->describe_images(-owner=>'self'); # convenience routine; will return a VM::EC2 object authorized # to use the current token my $ec2 = $token->new_ec2; print $ec2->describe_images(-owner=>'self'); =head1 DESCRIPTION The VM::EC2::Security::Credentials object is returned by the VM::EC2::Security::Token->credentials() method, which in turn is generated by calls to VM::EC2->get_federation_token() and VM::EC2->get_session_token(). The Credentials object contains time-limited EC2 authentication information, including access key ID, secret access key, and a temporary authentication session token. A Credentials object can be passed to VM::EC2->new() via the -security_token parameter, in which case the -access_key and -secret_key parameters can be omitted. As Credentials typically need to be transmitted from a process being run by an AWS account holder to a process being run by another user, the object provides serialization methods that allow the object to be transmitted as a simple string. =head1 DATA ACCESS METHODS accessKeyId() -- The temporary access key ID secretAccessKey() -- The secret access key sessionToken() -- The temporary security token, as a long opaque string expiration() -- The expiration time of these credentials, as a DateTime string. As in all VM::EC2 classes, mixedCase() and broken_out_with_underscores() names may be used interchangeably. =head1 SERIALIZATION METHODS These two methods allow you to serialize the credentials into a string suitable for sending via SSL, S/MIME or another secure channel, and then reconstructing the object at the other end. For sending the credentials to a non-perl process, you can simply retrieve each individual field (access key, etc) and send them individually. =head2 $serialized = $credentials->serialize() Return a serialized form of the object as a base64-encoded string. Note that the serialized form contains the secret access key and session token in unencrypted, but very slightly obfuscated, form. =head2 $credentials = VM::EC2::Security::Credentials->new_from_serialized($serialized) Given a previously-serialized Credentials object, unserialize it and return a copy. =head1 CONVENIENCE METHODS These are convenience methods. =head2 $ec2 = $credentials->new_ec2(@args) Create a new VM::EC2 object which is authorized using the security token contained in the credentials object. You may pass all the arguments, such as -endpoint, that are accepted by VM::EC2->new(), but -access_key and -secret_access_key will be ignored. =head1 STRING OVERLOADING When used in a string context, this object will interpolate the =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use Storable 'nfreeze','thaw'; use MIME::Base64 'encode_base64','decode_base64'; sub valid_fields { my $self = shift; return qw(AccessKeyId Expiration SecretAccessKey SessionToken); } # because of AWS inconsistencies and limitations on the autoloaded can() method. sub secret_access_key { shift->{data}{SecretAccessKey} } sub access_key_id { shift->{data}{AccessKeyId} } sub session_token { shift->{data}{SessionToken} } sub new_ec2 { my $self = shift; my @args = @_; return VM::EC2->new(-security_token=>$self, @args); } # serialize the credentials in a packed form sub serialize { my $self = shift; my $data = nfreeze($self); return encode_base64($data); } sub new_from_serialized { my $class = shift; my $data = shift; my $obj = thaw(decode_base64($data)); return bless $obj,ref $class || $class; } sub new_from_json { my $class = shift; my ($data,$endpoint) = @_; eval "require JSON; 1" or die "no JSON module installed: $@" unless JSON->can('decode'); my $hash = JSON::from_json($data); my $payload = {AccessKeyId => $hash->{AccessKeyId}, SecretAccessKey => $hash->{SecretAccessKey}, SessionToken => $hash->{Token}, # note inconsistency here, which is why we are copying Expiration => $hash->{Expiration} }; my $self = $class->new($payload,undef); my $ec2 = $self->new_ec2(-endpoint => $endpoint); $self->ec2($ec2) unless $self->ec2; return $self; } sub short_name {shift->access_key_id} 1; VM-EC2-1.23/lib/VM/EC2/Security/Token.pm000444001751001751 1332612100273360 17353 0ustar00lsteinlstein000000000000package VM::EC2::Security::Token; =head1 NAME VM::EC2::Security::Token - Temporary security token object =head1 SYNOPSIS use VM::EC2; use VM::EC2::Security::Policy # under your account $ec2 = VM::EC2->new(...); # as usual my $policy = VM::EC2::Security::Policy->new; $policy->allow('DescribeImages','RunInstances'); my $token = $ec2->get_federation_token(-name => 'TemporaryUser', -duration => 60*60*3, # 3 hrs, as seconds -policy => $policy); print $token->sessionToken,"\n"; print $token->accessKeyId,"\n"; print $token->secretAccessKey,"\n"; print $token->federatedUser,"\n"; my $serialized = $token->credentials->serialize; # get the serialized token to the temporary user send_data_to_user_somehow($serialized); # under the temporary user's account my $serialized = get_data_somehow(); # create a copy of the token from its serialized form my $token = VM::EC2::Security::Credentials->new_from_serialized($serialized); # open a new EC2 connection with this token. User will be # able to run all the methods specified in the policy. my $ec2 = VM::EC2->new(-security_token => $token); print $ec2->describe_images(-owner=>'self'); # convenience routine; will return a VM::EC2 object authorized # to use the current token my $ec2 = $token->new_ec2; print $ec2->describe_images(-owner=>'self'); =head1 DESCRIPTION VM::EC2::Security::Token objects allow you to grant a user access to some or all of your EC2 resources for a limited period of time. The user does not have to have his own AWS account. Token objects are returned by calls to VM::EC2->get_federation_token() and get_session_token(). The former call is used to create a temporary user with privileges restricted to those listed in the accompanying policy (a VM::EC2::Security::Policy object). The latter call is used in conjunction with multi-factor authentication devices, such as smart cards. The tokens returned by get_session_token() are not associated with a user account nor a policy, and grant privileges to all EC2 actions and resources. Both federation and session tokens have an expiry time between a few seconds and 36 hours. A VM::EC2::Security::Credentials object contained within the token contains the temporary secret access key, acess key ID, and a session token string that unlocks the access key. The credentials object can be serialized into a form suitable for sending to a user via a secure channel, such as SSL or S/MIME e-mail, and unserialized at the receiving end into a copy of the original credentials object. Either the token object, or its contained credentials object can be used passed to VM::EC2->new() via the B<-security_token> parameter in order to gain access to EC2 resources. =head1 METHODS credentials() -- The VM::EC2::Security::Credentials object that contains the session token, access key ID, and secret key. federatedUser() -- the VM::EC2::Security::FederatedUser object that contains information about the temporary user account. packedPolicySize() -- A percentage value indicating the size of the policy in packed form relative to the maximum allowed size. Policies in excess of 100% will be rejected by the service. secret_access_key()-- Convenience method that calls the credentials object's secret_access_key() method. access_key_id() -- Convenience method that calls the credentials object's access_key_id() method. session_token() -- Convenience method that calls the credentials object's session_token() method. new_ec2(@args) -- Convenience method that returns a VM::EC2 object authorized with the current token. You may pass any of the arguments accepted by VM::EC2->new(), except that -access_key and -secret_key will be ignored if present. =head1 STRING OVERLOADING When used in a string context, this object will interpolate as the session token, and can be used for the -security_token parameter in VM::EC2->new(). =head1 SEE ALSO L L L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::Security::FederatedUser; use VM::EC2::Security::Credentials; sub valid_fields { my $self = shift; return qw(Credentials FederatedUser PackedPolicySize); } sub new_ec2 { shift->credentials->new_ec2(@_); } sub credentials { my $self = shift; return VM::EC2::Security::Credentials->new($self->SUPER::credentials,undef); } sub federated_user { my $self = shift; my $user = $self->SUPER::federated_user or return; return VM::EC2::Security::FederatedUser->new($user,undef); } sub secret_access_key { shift->credentials->SecretAccessKey } sub access_key_id { shift->credentials->AccessKeyId } sub session_token { shift->credentials->SessionToken } sub secretAccessKey { shift->secret_access_key } sub accessKeyId { shift->access_key_id } sub sessionToken { shift->session_token } sub short_name { shift->session_token; } 1; VM-EC2-1.23/lib/VM/EC2/Security/FederatedUser.pm000444001751001751 375112100273360 20776 0ustar00lsteinlstein000000000000package VM::EC2::Security::FederatedUser; =head1 NAME VM::EC2::Security::FederatedUser -- Federated user object =head1 SYNOPSIS use VM::EC2; use VM::EC2::Security::Policy; # on your side of the connection $ec2 = VM::EC2->new(...); # as usual my $policy = VM::EC2::Security::Policy->new; $policy->allow('DescribeImages','RunInstances'); my $token = $ec2->get_federation_token(-name => 'TemporaryUser', -duration => 60*60*3, # 3 hrs, as seconds -policy => $policy); my $user = $token->federated_user; print $user->arn,"\n"; print $user->federated_user_id,"\n"; =head1 DESCRIPTION This object forms part of the VM::EC2::Security::Token object, which is created when you need to grant temporary access to some or all of your AWS resources to someone who does not have an AWS account. =head1 METHODS arn() -- Return the Amazon Resource Name unique identifier (ARN) associated with the temporary user, e.g. arn:aws:sts::123451234512345:federated-user/fred federatedUserId() -- Return the user ID for this temporary user, e.g. 123451234512345:fred =head1 STRING OVERLOADING When used in a string context, this object will interpolate as the ARN. =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(Arn FederatedUserId); } sub short_name {shift->arn} 1; VM-EC2-1.23/lib/VM/EC2/Security/Policy.pm000444001751001751 1162112100273360 17526 0ustar00lsteinlstein000000000000package VM::EC2::Security::Policy; =head1 NAME VM::EC2::Security::Policy -- Simple IAM policy generator for EC2 =head1 SYNOPSIS my $policy = VM::EC2::Security::Policy->new; $policy->allow('Describe*','CreateVolume','delete_volume'); $policy->deny('DescribeVolumes'); print $policy->as_string; =head1 DESCRIPTION This is a very simple Identity and Access Management (IAM) policy statement generator that works sufficiently well to create policies to control access EC2 resources. It is not fully general across all AWS services. =head1 METHODS This section describes the methods available to VM::EC2::Security::Policy. You will create a new, empty, policy using new(), grant access to EC2 actions using allow(), and deny access to EC2 actions using deny(). When you are done, either call as_string(), or just use the policy object in a string context, to get a properly-formatted policy string. allow() and deny() return the modified object, allowing you to chain methods. For example: my $p = VM::EC2::Security::Policy->new ->allow('Describe*') ->deny('DescribeImages','DescribeInstances'); print $p; =head2 $policy = VM::EC2::Security::Policy->new() This class method creates a new, empty policy object. The default policy object denies all access to EC2 resources. =head2 $policy->allow('action1','action2','action3',...) Grant access to the listed EC2 actions. You may specify actions using Amazon's MixedCase notation (e.g. "DescribeInstances"), or using VM::EC2's more Perlish underscore notation (e.g. "describe_instances"). You can find the list of actions in L, or in the Amazon API documentation at http://docs.amazonwebservices.com/AWSEC2/latest/APIReference/OperationList-query.html. The "*" wildcard allows you to indicate a series of matching operations. For example, to allow all Describe operations: $policy->allow('Describe*') As described earlier, allow() returns the object, making it easy to chain methods. =head2 $policy->deny('action1','action2','action3',...) Similar to allow(), but in this case denies access to certain actions. Deny statements take precedence over allow statements. As described earlier, deny() returns the object, making it easy to chain methods. =head2 $string = $policy->as_string Converts the policy into a JSON string that can be passed to VM::EC2->get_federation_token(), or other AWS libraries. =head1 STRING OVERLOADING When used in a string context, this object will interpolate into the policy JSON string using as_string(). =head1 SEE ALSO L L =head1 AUTHOR Lincoln Stein Elincoln.stein@gmail.comE. Copyright (c) 2011 Ontario Institute for Cancer Research This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use VM::EC2; use Carp 'croak'; use overload '""' => 'as_string', fallback => 1; sub new { my $class = shift; return bless { statements => {}, },ref $class || $class; } sub allow { my $self = shift; my @actions = @_ ? @_ : '*'; return $self->_add_statement(-effect=>'allow', -actions=>\@actions); } sub deny { my $self = shift; my @actions = @_ ? @_ : '*'; return $self->_add_statement(-effect=>'deny', -actions=>\@actions); } sub _add_statement { my $self = shift; my %args = @_; my $effect = $args{-effect} || 'allow'; my $actions = $args{-action} || $args{-actions} || []; $actions = [$actions] unless ref $actions && ref $actions eq 'ARRAY'; $effect =~ /^allow|deny$/i or croak '-effect must be "allow" or "deny"'; foreach (@$actions) { s/^ec2://i; $self->{statements}{lc $effect}{ucfirst VM::EC2->uncanonicalize($_)}++ ; } return $self; } sub as_string { my $self = shift; my $result =<{statements}}) { $result .= join ",\n",$self->_statements; } else { # no statements, so deny all local $self->{statements}; $self->deny('*'); $result .= join ",\n",$self->_statements; } $result .= <_format_statement($_,[keys %{$self->{statements}{$_}}]) } sort keys %{$self->{statements}}; } sub _format_statement { my $self = shift; my ($effect,$actions) = @_; my $action_list = join ',',map {$self->_format_action($_)} sort @$actions; my $result =<new(...); my @policy_types = $ec2->describe_load_balancer_policy_types; foreach my $type (@policy_types) { print $type,': ',$type->Description,"\n"; foreach ($type->attribute_types) { print $_->AttributeName,"\n ", $_->AttributeType,"\n ", $_->Cardinality,"\n ", $_->DefaultValue,"\n ", $_->Description,"\n "; } } =head1 DESCRIPTION This object is used to describe the ELB PolicyAttributeTypeDescription data type. =head1 METHODS The following object methods are supported: AttributeName -- The attribute name AttributeType -- The attribute type Cardinality -- Cardinality of the policy attribute DefaultValue -- Default value for the attribute Description -- Description of the attribute =head1 STRING OVERLOADING In string context, the object will return the Attribute Name. =head1 SEE ALSO L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(AttributeName AttributeType Cardinality DefaultValue Description); } sub primary_id { shift->AttributeName } 1; VM-EC2-1.23/lib/VM/EC2/ELB/HealthCheck.pm000444001751001751 470012100273360 17205 0ustar00lsteinlstein000000000000package VM::EC2::ELB::HealthCheck; =head1 NAME VM::EC2::ELB:HealthCheck - Load Balancer Health Check Parameters =head1 SYNOPSIS use VM::EC2; $lb = $ec2->describe_load_balancers('my-lb'); my $hc = $lb->HealthCheck; my $interval = $hc->Interval; my $target = $hc->Target; my $healthy_threshold = $hc->HealthyThreshold; my $unhealthy_threshold = $hc->UnhealthyThreshold; my $timeout = $hc->Timeout; =head1 DESCRIPTION This object is used to describe the parameters used to perform healthchecks on a load balancer. Generally you will not call this directly, as all its methods are passed through by the VM::EC2::ELB object returned from the HealthCheck() call. =head1 METHODS The following object methods are supported: Interval -- The time interval between health checks Target -- The target protocol protocol and port of the check HealthyThreshold -- The number of successive positive health checks that need to be completed to be marked as healthy UnhealthyThreshold -- The number of successive negative health checks that need to be completed to be marked as unhealthy Timeout -- The time interval of what is considered a timeout =head1 STRING OVERLOADING When used in a string context, this object will interpolate object parameters as a series of Key:Value strings =head1 SEE ALSO L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(HealthyThreshold Interval Target Timeout UnhealthyThreshold); } # allow pretty print of parameters when printing the object sub primary_id { my $self = shift; return "Target: " . $self->Target . "\nInterval: " . $self->Interval . "\nHealthyThreshold: " . $self->HealthyThreshold . "\nUnhealthyThreshold: " . $self->UnhealthyThreshold . "\nTimeout: " . $self->Timeout . "\n"; } 1; VM-EC2-1.23/lib/VM/EC2/ELB/PolicyAttribute.pm000444001751001751 306212100273360 20165 0ustar00lsteinlstein000000000000package VM::EC2::ELB::PolicyAttribute; =head1 NAME VM::EC2::ELB::PolicyAttribute - Elastic Load Balancer Policy Attribute =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my @policies = $ec2->describe_load_balancer_policies(-load_balancer_name=>'my-lb'); foreach my $p (@policies) { my @attr = $p->policy_attributes; foreach (@attr) { print $_,"\n"; } } =head1 DESCRIPTION This object is used to describe the ELB PolicyAttribute data type, which is part of the result of a DescribeLoadBalancerPolicies API call. =head1 METHODS The following object methods are supported: AttributeName -- Policy Attribute Name AttributeValue -- Policy Attribute Value =head1 STRING OVERLOADING In string context, the object will return an attribute name=value pair. =head1 SEE ALSO L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(AttributeName AttributeValue); } sub primary_id { my $self = shift; return $self->AttributeName . '=' . $self->AttributeValue; } 1; VM-EC2-1.23/lib/VM/EC2/ELB/Policies.pm000444001751001751 450712100273360 16616 0ustar00lsteinlstein000000000000package VM::EC2::ELB::Policies; =head1 NAME VM::EC2::ELB:Policies - Elastic Load Balancer Policies =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $lb = $ec2->describe_load_balancers('my-lb'); my $p = $lb->Policies; my @lb_policies = $p->LBCookieStickinessPolicies; my @app_policies = $p->AppCookieStickinessPolicies; my @other_policies = $p->OtherPolicies; =head1 DESCRIPTION This object is used to describe the policies that are attached to an Elastic Load Balancer, segregated by type. To more easily obtain a full list of policies associated with the ELB, used the VM::EC2->describe_load_balancers() method. =head1 METHODS The following object methods are supported: AppCookieStickinessPolicies -- Application-based cookie stickiness policies LBCookieStickinessPolicies -- Load Balancer-based cookie stickiness policies OtherPolicies -- Other Policies =head1 STRING OVERLOADING NONE. =head1 SEE ALSO L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::ELB::Policies::AppCookieStickinessPolicy; use VM::EC2::ELB::Policies::LBCookieStickinessPolicy; sub valid_fields { my $self = shift; return qw(AppCookieStickinessPolicies OtherPolicies LBCookieStickinessPolicies); } sub AppCookieStickinessPolicies { my $self = shift; my $acsp = $self->SUPER::AppCookieStickinessPolicies or return; return map { VM::EC2::ELB::Policies::AppCookieStickinessPolicy->new($_,$self->aws) } @{$acsp->{member}}; } sub LBCookieStickinessPolicies { my $self = shift; my $lbcsp = $self->SUPER::LBCookieStickinessPolicies or return; return map { VM::EC2::ELB::Policies::LBCookieStickinessPolicy->new($_,$self->aws) } @{$lbcsp->{member}}; } sub OtherPolicies { my $self = shift; my $op = $self->SUPER::OtherPolicies or return; return @{$op->{member}}; } 1; VM-EC2-1.23/lib/VM/EC2/ELB/Listener.pm000444001751001751 431512100273360 16631 0ustar00lsteinlstein000000000000package VM::EC2::ELB::Listener; =head1 NAME VM::EC2::ELB:Listener - Elastic Load Balancer Listener =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $lb = $ec2->describe_load_balancers('my-lb'); my @http_listeners = map { grep { $_->LoadBalancerPort eq '80' } $_->Listener } $lb->ListenerDescriptions; =head1 DESCRIPTION This object is used to describe a listener attached to an Elastic Load Balancer. =head1 METHODS The following object methods are supported: Protocol -- The protocol of the load balancer listener LoadBalancerPort -- The port the listener is listening on InstanceProtocol -- The protocol the load balancer uses to communicate with the instance InstancePort -- The port on the instance the load balancer connects to SSLCertificateId -- The ARN string of the server certificate =head1 STRING OVERLOADING When used in a string context, this object will return a string containing all the parameters of the listener in a pretty format. =head1 SEE ALSO L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(InstancePort InstanceProtocol LoadBalancerPort Protocol SSLCertificateId); } sub primary_id { my $self = shift; my $string = $self->Protocol . ':' . $self->LoadBalancerPort . ' --> ' . $self->InstanceProtocol . ':' . $self->InstancePort; my $ssl_id = $self->SSLCertificateId; $string .= ':' . $ssl_id if (defined $ssl_id); return $string; } sub InstanceProtocol { my $self = shift; my $instance_protocol = $self->SUPER::InstanceProtocol; return defined $instance_protocol ? $instance_protocol : $self->Protocol; } 1; VM-EC2-1.23/lib/VM/EC2/ELB/InstanceState.pm000444001751001751 422712100273360 17613 0ustar00lsteinlstein000000000000package VM::EC2::ELB::InstanceState; =head1 NAME VM::EC2::ELB:InstanceState - Object describing the state of an instance attached to a load balancer. It is the result of a DescribeInstanceHealth API call. =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $lb = $ec2->describe_load_balancers('my-lb'); my @instance_ids = map { $_->InstanceId } $lb->Instances(); my @states = $lb->describe_instance_health(-instances => \@instance_ids); my @down_ids = map { $_->InstanceId } grep { $_->State eq 'OutOfService' } @states; =head1 DESCRIPTION This object is used to describe the parameters returned by a DescribeInstanceHealth API call. =head1 METHODS The following object methods are supported: InstanceId -- The Instance ID of the instance attached to the load balancer State -- Specifies the current status of the instance ReasonCode -- Provides information about the cause of OutOfService instances. Specifically, it indicates whether the cause is Elastic Load Balancing or the instance behind the load balancer Description -- Description of why the instance is in the current state The following convenience methods are supported: instance -- Provides an L object =head1 STRING OVERLOADING When used in a string context, this object will interpolate the instance state. =head1 SEE ALSO L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(Description InstanceId ReasonCode State); } sub primary_id { shift->State } sub instance { my $self = shift; return $self->aws->describe_instances($self->InstanceId); } 1; VM-EC2-1.23/lib/VM/EC2/ELB/ListenerDescription.pm000444001751001751 313312100273360 21032 0ustar00lsteinlstein000000000000package VM::EC2::ELB::ListenerDescription; =head1 NAME VM::EC2::ELB:ListenerDescription - Load Balancer Listener Description =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $lb = $ec2->describe_load_balancers('my-lb'); my @lds = $lb->ListenerDescriptions; =head1 DESCRIPTION This object is used to describe the ListenerDescription data type, which is part of the response elements of a DescribeLoadBalancers API call. =head1 METHODS The following object methods are supported: PolicyNames -- Returns the policy names associated with the listener Listener -- returns a L object =head1 STRING OVERLOADING NONE. =head1 SEE ALSO L L L =head1 AUTHOR Lance Kinley E>lb>lkinley@loyaltymethods.comE>gt>. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::ELB::Listener; sub valid_fields { my $self = shift; return qw(PolicyNames Listener); } sub PolicyNames { my $self = shift; my $policies = $self->SUPER::PolicyNames or return; return @{$policies->{member}}; } sub Listener { my $self = shift; my $listener = $self->SUPER::Listener; return VM::EC2::ELB::Listener->new($listener,$self->aws); } 1; VM-EC2-1.23/lib/VM/EC2/ELB/PolicyDescription.pm000444001751001751 426212100273360 20510 0ustar00lsteinlstein000000000000package VM::EC2::ELB::PolicyDescription; =head1 NAME VM::EC2::ELB::PolicyDescription - Load Balancer Policy =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $lb = $ec2->describe_load_balancers(-load_balancer_name=>'my-lb'); my @policy = $lb->describe_policies; foreach (@policy) { print $_->PolicyName," : ",$_->PolicyTypeName,"\n"; } =head1 DESCRIPTION This object is used to describe the result of a DescribeLoadBalancerPolicies ELB API call. =head1 METHODS The following object methods are supported: PolicyName -- The policy name PolicyTypeName -- A L object PolicyAttributeDescriptions -- A series of L objects policy_attributes -- Alias for PolicyAttributeDescriptions =head1 STRING OVERLOADING In string context, the object returns the Policy Name. =head1 SEE ALSO L L L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::ELB::PolicyAttribute; sub valid_fields { my $self = shift; return qw(PolicyAttributeDescriptions PolicyName PolicyTypeName); } sub primary_id { shift->PolicyName } sub PolicyAttributeDescriptions { my $self = shift; my $attr_desc = $self->SUPER::PolicyAttributeDescriptions; return map { VM::EC2::ELB::PolicyAttribute->new($_,$self->aws) } @{$attr_desc->{member}}; } sub PolicyTypeName { my $self = shift; my $ptn = $self->SUPER::PolicyTypeName; return $self->aws->describe_load_balancer_policy_types($ptn); } sub policy_attributes { shift->PolicyAttributeDescriptions } 1; VM-EC2-1.23/lib/VM/EC2/ELB/PolicyTypeDescription.pm000444001751001751 367512100273360 21361 0ustar00lsteinlstein000000000000package VM::EC2::ELB::PolicyTypeDescription; =head1 NAME VM::EC2::ELB::PolicyTypeDescription - Elastic Load Balancer Policy Type =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my @policy_types = $ec2->describe_load_balancer_policy_types; =head1 DESCRIPTION This object is used to represent the PolicyTypeDescription data type, which is in the result of a DescribeLoadBalancerPolicyTypes ELB API call. =head1 METHODS The following object methods are supported: PolicyTypeName -- The policy type name Description -- Description PolicyAttributeTypeDescriptions -- A series of L objects attribute_types -- Alias for PolicyAttributeTypeDescriptions =head1 STRING OVERLOADING In string context, the object returns the Policy Type Name. =head1 SEE ALSO L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; use VM::EC2::ELB::PolicyAttributeType; sub valid_fields { my $self = shift; return qw(Description PolicyAttributeTypeDescriptions PolicyTypeName); } sub primary_id { shift->PolicyTypeName } sub PolicyAttributeTypeDescriptions { my $self = shift; my $patd = $self->SUPER::PolicyAttributeTypeDescriptions; return map { VM::EC2::ELB::PolicyAttributeType->new($_,$self->aws) } @{$patd->{member}}; } sub attribute_types { shift->PolicyAttributeTypeDescriptions } 1; VM-EC2-1.23/lib/VM/EC2/ELB/BackendServerDescription.pm000444001751001751 336212100273360 21767 0ustar00lsteinlstein000000000000package VM::EC2::ELB::BackendServerDescription; =head1 NAME VM::EC2::ELB:BackendServerDescription - Load Balancer Backend Server Description =head1 SYNOPSIS use VM::EC2; my $ec2 = VM::EC2->new(...); my $lb = $ec2->describe_load_balancers('my-lb'); my @descs = $lb->BackendServerDescriptions; foreach my $desc (@descs) { print $desc->InstancePort,":\n"; foreach ($desc->PolicyNames) { print $_,"\n"; } } =head1 DESCRIPTION This object is used to describe the BackendServerDescription data type, which is one of the response elements of the DescribeLoadBalancers API call. =head1 METHODS The following object methods are supported: InstancePort -- Returns the port on which the back-end server is listening. PolicyNames -- Returns an array of policy names enabled for the back-end server. =head1 STRING OVERLOADING NONE. =head1 SEE ALSO L L L =head1 AUTHOR Lance Kinley E>lb>lkinley@loyaltymethods.comE>gt>. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(InstancePort PolicyNames); } sub PolicyNames { my $self = shift; my $policies = $self->SUPER::PolicyNames or return; return @{$policies->{member}}; } sub InstancePort { my $self = shift; my $listener = $self->SUPER::InstancePort; } 1; VM-EC2-1.23/lib/VM/EC2/ELB/Policies000755001751001751 012100273360 16115 5ustar00lsteinlstein000000000000VM-EC2-1.23/lib/VM/EC2/ELB/Policies/LBCookieStickinessPolicy.pm000444001751001751 266212100273360 23465 0ustar00lsteinlstein000000000000package VM::EC2::ELB::Policies::LBCookieStickinessPolicy; =head1 NAME VM::EC2::ELB::Policies::LBCookieStickinessPolicy - Object describing a Load Balancer Cookie Stickiness Policy =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $lb = $ec2->describe_load_balancers('my-lb'); $p = $lb->Policies; @lb_policies = $p->LBCookieStickinessPolicies; =head1 DESCRIPTION This object is used to describe the parameters used to create an =head1 METHODS The following object methods are supported: PolicyName -- The name of the policy CookieExpirationPeriod -- Expiration period for the policy =head1 STRING OVERLOADING In string context, the object will return the policy name. =head1 SEE ALSO L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(CookieExpirationPeriod PolicyName); } sub primary_id { shift->PolicyName } 1; VM-EC2-1.23/lib/VM/EC2/ELB/Policies/AppCookieStickinessPolicy.pm000444001751001751 265412100273360 23711 0ustar00lsteinlstein000000000000package VM::EC2::ELB::Policies::AppCookieStickinessPolicy; =head1 NAME VM::EC2::ELB:Policies::AppCookieStickinessPolicy - Object describing an Application Cookie Stickiness Policy =head1 SYNOPSIS use VM::EC2; $ec2 = VM::EC2->new(...); $lb = $ec2->describe_load_balancers('my-lb'); $p = $lb->Policies(); @app_policies = $p->AppCookieStickinessPolicies(); =head1 DESCRIPTION This object is used to describe the AppCookieStickinessPolicy data type. =head1 METHODS The following object methods are supported: PolicyName -- The name of the policy CookieName -- The name of the application cookie for the policy =head1 STRING OVERLOADING In string context, the object will return the policy name. =head1 SEE ALSO L L L L =head1 AUTHOR Lance Kinley Elkinley@loyaltymethods.comE. Copyright (c) 2012 Loyalty Methods, Inc. This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text. In addition, please see DISCLAIMER.txt for disclaimers of warranty. =cut use strict; use base 'VM::EC2::Generic'; sub valid_fields { my $self = shift; return qw(CookieName PolicyName); } sub primary_id { shift->PolicyName } 1; VM-EC2-1.23/t000755001751001751 012100273360 12546 5ustar00lsteinlstein000000000000VM-EC2-1.23/t/03.securitygroup.t000555001751001751 617512100273360 16251 0ustar00lsteinlstein000000000000#-*-Perl-*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.t' use strict; use ExtUtils::MakeMaker; use File::Temp qw(tempfile); use FindBin '$Bin'; use lib "$Bin/lib","$Bin/../lib","$Bin/../blib/lib","$Bin/../blib/arch"; use constant TEST_COUNT => 20; use Test::More tests => TEST_COUNT; use EC2TestSupport; $SIG{TERM} = $SIG{INT} = sub { exit 0 }; # run the termination use constant GROUP => 'VM::EC2 Test Group'; use constant GROUP_DESCRIPTION => 'Test group created by VM::EC2; do not use!!'; # this script tests the security groups my ($ec2); require_ok('VM::EC2'); SKIP: { skip "account information unavailable",TEST_COUNT-1 unless setup_environment(); $ec2 = VM::EC2->new(-region=>'us-east-1') or BAIL_OUT("Can't load VM::EC2 module"); # in case it was here from a previous invocation $ec2->delete_security_group(-name=>GROUP); $ec2->print_error(1); my $g = $ec2->create_security_group(-name => GROUP, -description => GROUP_DESCRIPTION); ok($g,'create_security_group'); is($g->groupName,GROUP,'created group name is correct'); is($g->groupDescription,GROUP_DESCRIPTION,'created group description is correct'); $g->add_tag(Role=>'VM::EC2 Testing'); my $gg = $ec2->describe_security_groups(-filter=>{'tag:Role'=>'VM::EC2 Testing'}); is ($g,$gg,'group tagging and retrieval'); # newly created groups should contain no permissions my @perm = $g->ipPermissions; is (scalar @perm,0,'firewall rules initially empty'); # let's add some ok($g->authorize_incoming(-protocol=>'tcp',-port=>22,-source=>'any'), 'authorize incoming using source "any"'); ok($g->authorize_incoming(-protocol=>'tcp', -port=>'23..29', -source=>['192.168.0.0/24','192.168.1.0/24']), 'authorize incoming using a list of sources'); ok($g->authorize_incoming(-protocol=>'udp', -port => 'discard', -groups => [$g->groupId,'default','979382823631/default']), 'authorize incoming using a list of groups'); @perm = $g->ipPermissions; is (scalar @perm,0,"permissions don't change until update()"); ok($g->update,"update() successful"); @perm = $g->ipPermissions; is(scalar @perm,3,"expected number of firewall rules defined"); @perm = sort @perm; is($perm[0],'tcp(22..22) FROM CIDR 0.0.0.0/0','firewall rule one correct'); is($perm[1],'tcp(23..29) FROM CIDR 192.168.0.0/24,192.168.1.0/24','firewall rule two correct'); $gg = $ec2->describe_security_groups(-name=>'default'); my $from = join (',',sort ($gg->name,$g->name,'979382823631/default')); is($perm[2],"udp(9..9) GRPNAME $from",'firewall rule three correct'); # try revoking ok($g->revoke_incoming(-protocol=>'tcp', -port => '23..29', -source=>['192.168.0.0/24','192.168.1.0/24']), 'revoke with explicit rule'); ok($g->revoke_incoming($perm[0]),'revoke with IpPermissions object'); ok($g->update,'update with revocation'); @perm = sort $g->ipPermissions; is(scalar @perm,1,'revoke worked'); is($perm[0],"udp(9..9) GRPNAME $from",'correct firewall rules revoked'); } exit 0; END { print STDERR "# deleting test security group...\n"; $ec2->delete_security_group(-name=>GROUP) if $ec2; } VM-EC2-1.23/t/06.security_token.t000555001751001751 542212100273360 16371 0ustar00lsteinlstein000000000000#-*-Perl-*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.t' use strict; use ExtUtils::MakeMaker; use File::Temp qw(tempfile); use FindBin '$Bin'; use lib "$Bin/lib","$Bin/../lib","$Bin/../blib/lib","$Bin/../blib/arch"; use constant TEST_COUNT => 18; use Test::More tests => TEST_COUNT; use EC2TestSupport; # this script tests the security tokens and policy setup_environment(); require_ok('VM::EC2'); require_ok('VM::EC2::Security::Policy'); SKIP: { skip "account information unavailable",TEST_COUNT-2 unless setup_environment(); my $ec2 = VM::EC2->new(-print_error=>1, -region=>'us-east-1') or BAIL_OUT("Can't load VM::EC2 module"); # create a policy my $policy = VM::EC2::Security::Policy->new(); ok($policy,'create policy'); # default policy should be to deny all is("$policy\n",<allow('Describe*'); # except images $policy->deny('DescribeImages'); # adding the same thing twice doesn't make it appear twice $policy->allow('Describe*','RunInstances'); is("$policy\n",<get_federation_token(-name => 'TestUser', -policy => $policy, -duration => 60*60, # 1 hour ); ok($token); cmp_ok($token->packedPolicySize,'>',0,'packed policy size > 0'); my $credentials = $token->credentials; ok($credentials,'credentials'); my $user = $token->federatedUser; ok($user,'federated user'); like($user,qr/TestUser/,'expected username in credentials'); my $serialized = $credentials->serialize; ok($serialized,'serialization'); my $new_credentials = VM::EC2::Security::Credentials->new_from_serialized($serialized); foreach (qw(sessionToken accessKeyId secretAccessKey expiration)) { is($credentials->$_,$new_credentials->$_,"serialized and unserialized credentials $_ field matches"); } my $new_ec2 = VM::EC2->new(-security_token=> $token, -region => 'us-east-1' ); my @zones = $new_ec2->describe_availability_zones(); # this should work cmp_ok(scalar @zones,'>',0,'policy allows describe_availability_zones'); my @images = $new_ec2->describe_images(); # this should be forbidden cmp_ok(scalar @images,'==',0,'policy forbids describe_images'); like($new_ec2->error_str,qr/UnauthorizedOperation/,'error message forbids describe_images'); } exit 0; VM-EC2-1.23/t/04.volume.t000555001751001751 600012100273360 14620 0ustar00lsteinlstein000000000000#-*-Perl-*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.t' use strict; use ExtUtils::MakeMaker; use File::Temp qw(tempfile); use FindBin '$Bin'; use lib "$Bin/lib","$Bin/../lib","$Bin/../blib/lib","$Bin/../blib/arch"; use constant TEST_COUNT => 25; use Test::More tests => TEST_COUNT; use EC2TestSupport; $SIG{TERM} = $SIG{INT} = sub { exit 0 }; # run the termination # this script tests the security groups use constant VOLUME_NAME => 'VM::EC2 Test Volume'; use constant VOLUME_DESC => 'Delete me!'; my ($ec2); require_ok('VM::EC2'); SKIP: { skip "account information unavailable",TEST_COUNT-1 unless setup_environment(); $ec2 = VM::EC2->new(-print_error=>1,-region=>'us-east-1') or BAIL_OUT("Can't load VM::EC2 module"); # in case the test was interrupted earlier cleanup(); my ($zone) = $ec2->describe_availability_zones(); ok($zone,'describe_availability_zones()'); my $v = $ec2->create_volume(-zone=>$zone,-size=>1); ok($v,'create_volume()'); ok($v->add_tag(Name=>VOLUME_NAME,Description=>VOLUME_DESC),'add_tag()'); for (my $cnt=0; $cnt<10 && $v->current_status eq 'creating'; $cnt++) { sleep 2; } is($v->current_status,'available','volume becomes available'); my $s = $v->create_snapshot(VOLUME_DESC); ok($s->add_tag(Name=>VOLUME_NAME),'add_tag()'); ok($s,'create_snapshot()'); for (my $cnt=0; $cnt<10 && $s->current_status eq 'pending'; $cnt++) { sleep 2; } is($s->current_status,'completed','snapshot completed'); is($s->from_volume,$v,'from_volume() worked correctly'); my @v = $s->to_volumes(); is(scalar @v,0,'to_volumes() on new snapshot returns empty list'); ok(!$s->is_public,'newly-created snapshots not public'); ok($s->make_public(1),'make public(true)'); ok($s->is_public,'public status set correctly'); ok($s->make_public(0),'make_public(false)'); ok($s->add_authorized_users($ec2->account_id),'add_authorized_users()'); my @u = $s->authorized_users; is(scalar @u,1,'right number of authorized users'); is($u[0],$ec2->account_id,'right authorized user'); ok($s->remove_authorized_users($ec2->userId),'remove_authorized_users()'); @u = $s->authorized_users; is(scalar @u,0,'remove authorized users worked'); # make a volume from this snapshot my $newvol = $s->create_volume(-zone=>$zone); ok($newvol->add_tag(Name=>VOLUME_NAME,Description=>VOLUME_DESC),'add_tag()'); ok($newvol,'create_volume() from snapshot'); is($newvol->size,$v->size,'size matches'); @v = $s->to_volumes; is(scalar @v,1,'to_volumes() returns one volume'); is($v[0],$newvol,'to_volumes() returns correct volume id'); is($v[0]->snapshotId,$s,'snapshotId() is correct'); } exit 0; sub cleanup { return unless $ec2; my @volumes = $ec2->describe_volumes({'tag:Name'=>VOLUME_NAME}); $ec2->delete_volume($_) foreach @volumes; my @snapshots = $ec2->describe_snapshots({'tag:Name'=>VOLUME_NAME}); $ec2->delete_snapshot($_) foreach @snapshots; } END { if ($ec2) { print STDERR "# deleting test volumes and snapshots...\n"; cleanup(); } } VM-EC2-1.23/t/01.describe.t000555001751001751 1001112100273360 15103 0ustar00lsteinlstein000000000000#-*-Perl-*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.t' use strict; use ExtUtils::MakeMaker; use File::Temp qw(tempfile); use FindBin '$Bin'; use constant TEST_COUNT => 33; use lib "$Bin/lib","$Bin/../lib","$Bin/../blib/lib","$Bin/../blib/arch"; use Test::More tests => TEST_COUNT; use EC2TestSupport; # this script tests all the describe() functions and associated features such as tags. require_ok('VM::EC2'); reset_declined(); SKIP: { skip "account information unavailable",TEST_COUNT-1 unless setup_environment(); my $ec2 = VM::EC2->new(-print_error=>1,-region=>'us-east-1') or BAIL_OUT("Can't load VM::EC2 module"); ok($ec2,'VM::EC2->new'); my $natty = $ec2->describe_images(TEST_IMAGE); # defined in t/EC2TestSupport if ($ec2->error_str =~ /SignatureDoesNotMatch/) { BAIL_OUT($ec2->error_str); } ok($natty,'describe image by id'); is($natty->imageLocation,'755060610258/ebs/ubuntu-images/ubuntu-natty-11.04-i386-server-20110426-nano','$image->imageLocation'); like($natty->description,'/http:\/\/nolar\.info\/nano-ami/','$image->description'); is($natty->architecture,'i386','$image->architecture'); is(($natty->blockDeviceMapping)[0],'/dev/sda1=snap-90ed13fe:1:true:standard','$image->blockDeviceMapping'); is($natty->imageState,'available','$image->imageState'); my $owner = $natty->imageOwnerId(); my @i = $ec2->describe_images(-ownerId=>$natty->imageOwnerId, -filter=>{description=>$natty->description, 'manifest-location'=>$natty->imageLocation}); ok (@i == 1,'describe_images() with multiple filters'); is ($i[0],$natty,'describe_images() with multiple filters returns expected image'); # test tagging ok($natty->add_tags(Name=>'MyFavoriteImage',Description=>'Test tag added by VM::EC2'),'tag addition'); $natty->refresh; my $tags = $natty->tags; is($tags->{Name},'MyFavoriteImage','tag retrieval'); @i = $ec2->describe_images(-filter=>{'tag:Name' => 'MyFavoriteImage', 'tag:Description' => '*VM::EC2'}); is ($i[0],$natty,'retrieve by tags'); ok($natty->add_tags(Name=>'MyLeastFavoriteImage'),'tag replacement'); sleep 1; # takes a while to register $natty->refresh; is($natty->tags->{Name},'MyLeastFavoriteImage','tag replacement'); ok($natty->delete_tags(['Name','Description']),'tag deletion'); sleep 1; # takes a short while to register $natty->refresh; $tags = $natty->tags; # should be no tags now is(scalar keys %$tags,0,'tag deletion'); # exercise availability regions and keys my @regions = $ec2->describe_regions; ok(scalar @regions,'describe regions'); my $r = $ec2->describe_regions($regions[0]); is ($r,$regions[0],'describe regions by name'); my @zones = $ec2->describe_availability_zones(); ok(scalar @zones,'describe zones'); my $z = $ec2->describe_availability_zones($zones[0]); is ($z,$zones[0],'describe zones by name'); # make sure that we can get zones from each region my $cnt; foreach (@regions) { @zones = $_->zones; $cnt++ if @zones; } is ($cnt,scalar @regions,'each region has availability zones'); my @keys = $ec2->describe_key_pairs; ok(scalar @keys,'describe keys'); # security groups my @sg = $ec2->describe_security_groups(); ok(@sg>0,'describe_security_groups'); ok(scalar(grep {$_->name =~ /default/} @sg),'default security group present'); # error handling $ec2->print_error(0); is($ec2->call('IncorrectAction'),undef,'errors return undef'); my $error = $ec2->error; is($error->code,'InvalidAction','error code on invalid action'); is($ec2->call('RunInstances',(Foo=>'bar')),undef,'errors return undef'); is($ec2->error->code,'UnknownParameter','error code on invalid parameter'); my $msg = $ec2->error->message; like($ec2->error_str,qr/UnknownParameter/,'error code interpolation'); like($ec2->error_str,qr/$msg/,'error message interpolation'); my $e = $ec2->error; is($ec2->error_str,"$e",'error object interpolation'); $ec2->raise_error(1); eval { $ec2->call('RunInstances',(Foo=>'bar')); }; like($@,qr/UnknownParameter/,'raise error mode'); $ec2->raise_error(0); } exit 0; VM-EC2-1.23/t/07.instance.t000555001751001751 1541412100273360 15151 0ustar00lsteinlstein000000000000#-*-Perl-*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.t' use strict; use ExtUtils::MakeMaker; use File::Temp qw(tempfile); use FindBin '$Bin'; use lib "$Bin/lib","$Bin/../lib","$Bin/../blib/lib","$Bin/../blib/arch"; use constant TEST_COUNT => 33; use Test::More tests => TEST_COUNT; use EC2TestSupport; use constant IMG_NAME => 'Test_Image_from_libVM_EC2'; $SIG{TERM} = $SIG{INT} = sub { exit 0 }; # run the termination # this script exercises instances and volumes my($ec2, $instance,$key,$address,$deallocate_address,$volume,$image); my $msg = ' # The next two tests will launch three "micro" instances under your Amazon account # and then terminate them, incurring a one hour runtime charge each. This will # incur a charge of $0.06 (as of July 2012), which may be covered under # the AWS free tier. Also be aware that these tests may take a while # (several minutes) due to tests that launch, start, and stop instances. # (this prompt will timeout automatically in 15s) '; SKIP: { skip "account information unavailable",TEST_COUNT unless setup_environment(); skip "instance tests declined", TEST_COUNT unless confirm_payment($msg); require_ok('VM::EC2'); $ec2 = VM::EC2->new(-print_error=>1,-region=>'us-east-1') or BAIL_OUT("Can't load VM::EC2 module"); cleanup(); my $natty = $ec2->describe_images(TEST_IMAGE); # defined in t/lib/EC2TestSupport BAIL_OUT($ec2->error_str) unless $natty; $key = $ec2->create_key_pair("MyTestKey$$"); $key or BAIL_OUT("could not create test key"); my $finger = $key->fingerprint; print STDERR "# Spinning up an instance...\n"; $instance = $natty->run_instances(-max_count => 1, -user_data => 'xyzzy', -key_name => $key, -instance_type => 't1.micro') or warn $ec2->error_str; sleep 1; ok($instance,'run_instances()'); $instance->add_tags(Name=>'test instance created by VM::EC2'); $ec2->wait_for_instances($instance); is($instance->current_status,'running','instance is running'); is($instance->userData,'xyzzy','user data is available to instance'); # allocate or reuse an elastic IP address to test association my @addresses = grep {!$_->instanceId} $ec2->describe_addresses(); if (@addresses) { $address = $addresses[0]; } else { $address = $ec2->allocate_address; $deallocate_address++; } SKIP: { skip "no elastic addresses available for testing",2 unless $address; ok($instance->associate_address($address),'elastic address association'); sleep 2; $instance->refresh; ok($instance->disassociate_address($address),'address disassociation'); } # volume management my $zone = $instance->placement; $volume = $ec2->create_volume(-size=>1,-availability_zone=>$zone) or warn $ec2->error_str; $volume->add_tag(Name=>'Test volume created by VM::EC2'); ok($volume,'volume creation'); $ec2->wait_for_volumes($volume); SKIP: { skip "could not create a new volume, status was ".$volume->current_status,6 unless $volume->current_status eq 'available'; my $a = $instance->attach_volume($volume => '/dev/sdg1'); ok($a,'attach()'); $ec2->wait_for_attachments($a); is($a->current_status,'attached','attach volume to instance'); ok(!$a->deleteOnTermination,'delete on termination flag set to false'); $a->deleteOnTermination(1); $a->refresh; ok($a->deleteOnTermination,'delete on termination flag set to true'); is($volume->current_status,'in-use','volume reports correct attachment'); my @mapping = $instance->blockDeviceMapping; my ($b) = grep {$_ eq '/dev/sdg1'} @mapping; ok($b,'block device mapping reports correct list'); ok($b->deleteOnTermination,'delete on termination flag set to true'); $b->deleteOnTermination(0); ($b) = grep {$_ eq '/dev/sdg1'} $instance->blockDeviceMapping; ok(!$b->deleteOnTermination,'set delete on termination to false'); is($volume->deleteOnTermination,$b->deleteOnTermination,'deleteOnTermination flags in sync'); my $d = $volume->detach; ok($d,'detach volume from instance'); $ec2->wait_for_attachments($d); is($volume->current_status,'available','detached volume becomes available'); ok($ec2->delete_volume($volume),'delete volume'); undef $volume; } $ec2->print_error(0); # avoid deliberate error message ok(!$instance->userData('abcdefg'),"don't change user data on running instance"); $ec2->print_error(1); print STDERR "# Stopping instance...\n"; ok($instance->stop('wait'),'stop running instance'); is($instance->current_status,'stopped','stopped instance reports correct state'); ok($instance->userData('abcdefg'),"can change user data on stopped instance"); is($instance->userData,'abcdefg','user data set ok'); # after stopping instance, should be console output ok($instance->console_output,'console output available'); like($instance->console_output,qr/Linux version/,'console output is plausible'); # create an image here print STDERR "# Creating an image...\n"; $image = $instance->create_image(-name=>IMG_NAME,-description=>'Delete me!') or warn $ec2->error_str; ok($image,'create image ok'); SKIP: { skip "image tests skipped because image creation failed",5 unless $image; for (my $cnt=0; $cnt<20 && $image->current_status eq 'pending'; $cnt++) { sleep 5; } is($image->current_status,'available','image becomes available'); ok(!$image->is_public,'newly created image not public'); ok($image->make_public(1),'make image public'); ok($image->is_public,'image now public'); my @block_devices = $image->blockDeviceMapping; ok(@block_devices>0,'block devices defined in image'); my @snapshots = map {$_->snapshotId} @block_devices; ok($ec2->deregister_image($image),'deregister_image'); foreach (@snapshots) { $ec2->delete_snapshot($_) if $_; } } } # SKIP exit 0; END { $ec2->print_error(0) if $ec2; if ($instance) { print STDERR "# Terminating $instance...\n"; $instance->terminate(); } if ($key) { print STDERR "# Removing test key...\n"; $ec2->delete_key_pair($key); } if ($address && $deallocate_address) { print STDERR "# Deallocating $address...\n"; $ec2->release_address($address); } if ($volume) { print STDERR "# Deleting volume...\n"; my $a = $volume->detach(); $ec2->wait_for_attachments($a) if $a; $ec2->delete_volume($volume); } if ($image) { print STDERR "# Deleting image...\n"; $ec2->deregister_image($image); } cleanup(); } sub cleanup { return unless $ec2; my $img = $ec2->describe_images({name=>IMG_NAME}); if ($img) { print STDERR "Deleting dangling image...\n"; $ec2->deregister_image($img); } my @v = $ec2->describe_volumes({'tag:Name'=>'Test volume created by VM::EC2'}); if (@v) { print STDERR "Deleting dangling volumes...\n"; $ec2->delete_volume($_) foreach @v; } } VM-EC2-1.23/t/05.spot_instance.t000555001751001751 335512100273360 16175 0ustar00lsteinlstein000000000000#-*-Perl-*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.t' use strict; use ExtUtils::MakeMaker; use File::Temp qw(tempfile); use FindBin '$Bin'; use lib "$Bin/lib","$Bin/../lib","$Bin/../blib/lib","$Bin/../blib/arch"; use constant TEST_COUNT => 6; use Test::More tests => TEST_COUNT; use EC2TestSupport; $SIG{TERM} = $SIG{INT} = sub { exit 0 }; # run the termination # this script exercises spot instance requests my($ec2,@requests); SKIP: { skip "account information unavailable",TEST_COUNT unless setup_environment(); require_ok('VM::EC2'); $ec2 = VM::EC2->new(-print_error=>1,-region=>'us-east-1') or BAIL_OUT("Can't load VM::EC2 module"); my @requests = $ec2->request_spot_instances(-spot_price => 0.001, # too low - will never be satisfied -instance_type => 't1.micro', -image_id => TEST_IMAGE, -instance_count => 4, -type => 'one-time', -security_group => 'default') or die $ec2->error_str; is(scalar @requests,4,'Correct number of spot instances requested'); my %state = map {$_->current_state => 1} @requests; my @state = keys %state; is("@state",'open','Spot instances are all open'); my $r = $ec2->describe_spot_instance_requests($requests[0]); is($r,$requests[0],'describe_spot_instance_requests works'); my @c = $ec2->cancel_spot_instance_requests(@requests); is(scalar @c, scalar @requests,'cancel_spot_instance_requests working as expected'); %state = map {$_->current_state => 1} @requests; @state = keys %state; is("@state",'cancelled','spot instances are now cancelled'); } undef @requests; exit 0; END { $ec2->cancel_spot_instance_requests(@requests) if $ec2 && @requests; } VM-EC2-1.23/t/08.staging.t000555001751001751 1410312100273360 14774 0ustar00lsteinlstein000000000000#-*-Perl-*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.t' use strict; use ExtUtils::MakeMaker; use File::Temp qw(tempfile); use FindBin '$Bin'; use lib "$Bin/lib","$Bin/../lib","$Bin/../blib/lib","$Bin/../blib/arch"; use constant TEST_COUNT => 31; use Test::More tests => TEST_COUNT; use EC2TestSupport; $SIG{TERM} = $SIG{INT} = sub { exit 0 }; # run the termination # this script exercises the staging manager, servers and instances my($ec2,$manager); my $msg = ' # This test will launch two "micro" instances under your Amazon account # and then terminate them, incurring a one hour runtime charge for each. # This will incur a charge of \$0.04 (as of July 2012), which may be covered # under the AWS free tier. Also be aware that this test may take several # minutes to complete due to tests that launch, start, and stop instances. # # [this prompt will timeout automatically in 15s] '; setup_environment(); require_ok('VM::EC2::Staging::Manager'); SKIP: { skip "; account information unavailable",TEST_COUNT-1 unless setup_environment(); skip "; instance tests declined", TEST_COUNT-1 unless confirm_payment($msg); skip "; this system does not have ssh, rsh and dd command line tools in PATH", TEST_COUNT-1 unless VM::EC2::Staging::Manager->environment_ok(); $ec2 = VM::EC2->new(); $manager = $ec2->staging_manager(-instance_type=> 't1.micro', -on_exit => 'run', # don't terminate user's servers! -verbose => 0, ) or BAIL_OUT("Can't load VM::EC2::Staging::Manager module"); # remove preexisting volumes, servers used for testing cleanup(); my $volume_count = $manager->volumes; print STDERR "# spinning up a test server...\n"; my $server1 = $manager->get_server(-name => 'test_server'); ok($server1,'staging server creation successful'); $server1->add_tag(StagingTest=>1); # so that we can correctly identify and remove it ok($server1->ping,'staging server is reachable'); my %servers = map {$_=>1} $manager->servers; ok($servers{$server1},'staging server is registered correctly'); my $mgr = VM::EC2::Staging::Manager->new(); is($manager,$mgr,'manager behaves in a singleton manner'); is($mgr->on_exit,'run',"manager accessors don't change unexpectedly"); print STDERR "# allocating a test volume...\n"; my $volume = $manager->get_volume(-name => 'test_volume', -fstype => 'ext3', -size => 1); ok($volume,'volume creation works'); $volume->add_tag(StagingTest=>1); # so that we can correctly identify and remove it is($volume->fstype,'ext3','volume fstype method returns correct value'); ok($volume->size==1,'volume size method returns correct value'); is($volume->server,$server1,'volume is automounted on preexisting server'); my $vol = $manager->get_volume(-name => 'test_volume', -fstype => 'ext3', -size => 1); is($vol,$volume,'get_volume() returns identical volume when same name requested'); my $testdir = $Bin; # we're going to use current directory for file copying ok($volume->put($testdir),'rsync exits with good status code'); my @listing = $volume->ls('-1','t'); is($listing[0],'01.describe.t','put copied files with correct structure'); # (need lots more tests of syntactic correctness of the rsync methods) my $used_zone = $server1->placement; my ($new_zone) = grep {$_ ne $used_zone} $manager->ec2->describe_availability_zones({state=>'available'}); print STDERR "# spinning up a second test server...\n"; my $server2 = $manager->get_server(-name => 'test_server2', -availability_zone => $new_zone); isnt($server1,$server2,'got new server in new zone when zone forced'); $server2->add_tag(StagingTest=>1); # so that we can correctly identify and remove it ok($volume->mounted,'mounted state correct when mounted'); my @volumes = $server1->volumes; cmp_ok(scalar @volumes,'==',1,'server1 has 1 volumes mounted'); print STDERR "# detaching/remounting volume...\n"; my $status = $volume->detach; $ec2->wait_for_attachments($status); ok(!$volume->mounted,'mounted state correct when detached'); @volumes = $server1->volumes; cmp_ok(scalar @volumes,'==',0,'server1 has 0 volumes mounted'); $server1->mount_volume($volume=>'/mnt/test'); ok($volume->mounted,'mounted state correct when mounted'); is($volume->mtpt,'/mnt/test','volume mounted on correct mtpt'); is($volume->server,$server1,'volume mounted on correct server'); my $output = $server1->scmd('df /mnt/test'); my $mtdev = $volume->mtdev; like($output,"/$mtdev/mi",'server agrees with volume on mount point and device'); @volumes = $server1->volumes; cmp_ok(scalar @volumes,'==',1,'server1 has 1 volume mounted'); print STDERR "# provisioning a second test volume...\n"; my $volume2 = $server2->provision_volume(-size=>1); ok($volume2,'volume creation on server2 successful'); is($volume2->server,$server2,"volume2 has correct server"); @volumes = $server2->volumes; cmp_ok(scalar @volumes,'==',1,'server2 has 1 registered volume'); # try a copy ok($manager->rsync($volume=>$volume2),'rsync from volume to volume successful'); @listing = $volume2->ls('-1','t'); is($listing[0],'01.describe.t','rsync copied files with correct structure'); @volumes = $manager->volumes; cmp_ok(scalar @volumes,'==',$volume_count + 2,'manager has 2 new registered volumes'); print STDERR "# deleting a volume...\n"; ok($volume2->delete,'volume deletion successful'); @volumes = $manager->volumes; cmp_ok(scalar @volumes,'==',$volume_count + 1,'manager has 1 new registered volume'); } # SKIP exit 0; sub cleanup { reset_cache(); reset_declined(); if ($ec2) { my @servers = $ec2->describe_instances({'tag:StagingTest' =>1,'instance-state-name'=>['running','stopped']}); if (@servers) { print STDERR "# terminating test staging servers\n"; $_->terminate foreach @servers; $ec2->wait_for_instances(@servers); } my @volumes = $ec2->describe_volumes({'tag:StagingTest' =>1,status=>'available'}); if (@volumes) { print STDERR "# deleting test staging volumes\n"; $ec2->delete_volume($_) foreach @volumes; $ec2->wait_for_volumes(@volumes); } } } END { cleanup(); } VM-EC2-1.23/t/02.keypairs.t000555001751001751 411312100273360 15141 0ustar00lsteinlstein000000000000#-*-Perl-*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.t' use strict; use ExtUtils::MakeMaker; use File::Temp qw(tempfile); use FindBin '$Bin'; use lib "$Bin/lib","$Bin/../lib","$Bin/../blib/lib","$Bin/../blib/arch"; use constant TEST_COUNT => 11; use Test::More tests => TEST_COUNT; use EC2TestSupport; # this script tests the keypairs functions setup_environment(); require_ok('VM::EC2'); SKIP: { skip "account information unavailable",TEST_COUNT-1 unless setup_environment(); my $ec2 = VM::EC2->new(-print_error=>1,-region=>'us-east-1') or BAIL_OUT("Can't load VM::EC2 module"); # make a key my $kn = 'VM-EC2 Test Key'; $ec2->delete_key_pair($kn); # in case it was already there my $key = $ec2->create_key_pair($kn); ok($key,'create key'); is($key->name,$kn,'create key name matches'); my @keys = $ec2->describe_key_pairs; ok(scalar @keys,'describe keys'); my @i = grep {$_->name eq $key} @keys; is(scalar @i,1,'get keys'); is($i[0]->fingerprint,$key->fingerprint,'fingerprints match'); ok($ec2->delete_key_pair($key),'delete key'); $ec2->print_error(0); # disable error message @keys = $ec2->describe_key_pairs($kn); is(scalar @keys,0,'delete key works'); $ec2->print_error(1); # reenable # this is a public key generated by ssh-keygen; the corresponding private key has been deleted my $bogus_key = 'ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC8o5qe3vdaONNbM3tnGKZwZWwPvTNTP69m3N8BNCqArsIellAuKzb9XwgQ85i5xiScetCMW99Pci9s9ky3WpctkJAxl645AiGF5u3xg7y+lDHTO0VI/hSWamIYtsP34nvM6eSkqaIoRZjgLvQE2kIoJQZFWMEY3cCPFBojWWWhSrpLh8YTra7IrjONGMzyq97bbqMg/1B146f2ZZKBpQEVNmeObf8LsNLJhWOLy6YsEytmH3kp5GrMmlTZoGBFHX7w+dkxIVgpm+5/zHDJuBgzB2DICR/mBmlTNZnPGEvvIzlPWsehdamoGWbDIssiGpTvGj21uhvtzCwhcni1jusn BogusKey'; $key = $ec2->import_key_pair('MyBogusKeyPair'=>$bogus_key) or warn $ec2->error_str; ok($key,'import key pair'); BAIL_OUT($ec2->error_str) unless $key; @keys = $ec2->describe_key_pairs('MyBogusKeyPair'); ok(scalar @keys,'import key pair'); ok($ec2->delete_key_pair($key),'delete imported key'); } exit 0; VM-EC2-1.23/t/lib000755001751001751 012100273360 13314 5ustar00lsteinlstein000000000000VM-EC2-1.23/t/lib/EC2TestSupport.pm000444001751001751 513712100273360 16623 0ustar00lsteinlstein000000000000package EC2TestSupport; use base 'Exporter'; use POSIX 'setsid','setpgid','tcsetpgrp'; our @EXPORT_OK = qw(setup_environment reset_declined reset_cache TEST_IMAGE confirm_payment); our @EXPORT = @EXPORT_OK; use constant TEST_IMAGE => 'ami-4a936a23'; # Nano natty - only 1 GB in size! sub reset_declined { unlink ('.declined','.payment_confirmed','.payment_declined') } sub reset_cache { unlink '.credentials' } sub setup_environment { return if -e '.declined'; unless ($ENV{EC2_ACCESS_KEY} && $ENV{EC2_SECRET_KEY}) { read_from_cache() && return 1; if ($ENV{AUTOMATED_TESTING}) { open my $f,'>.declined'; close $f; return; } eval { local $SIG{INT} = sub {warn "Interrupted!\n";die "interrupted" }; local $SIG{ALRM} = sub {warn "Timeout!\n" ;die "timeout"}; print STDERR <.declined'; close $f; return; } write_to_cache(); } 1; } sub write_to_cache { open my $f,'>.credentials'; print $f "EC2_ACCESS_KEY=$ENV{EC2_ACCESS_KEY}\n"; print $f "EC2_SECRET_KEY=$ENV{EC2_SECRET_KEY}\n"; close $f; } sub read_from_cache { open my $f,'.credentials' or return; chmod 0600,'.credentials'; while (<$f>) { chomp; my($key,$value) = split '='; $ENV{$key}||=$value; } return 1 if $ENV{EC2_ACCESS_KEY} && $ENV{EC2_SECRET_KEY}; } sub confirm_payment { my $msg = shift; return 1 if -e '.payment_confirmed'; return 0 if -e '.payment_declined'; if ($ENV{AUTOMATED_TESTING}) { open my $f,'>.payment_declined'; close $f; return; } print STDERR $msg; print STDERR "Do you want to proceed? [Y/n] "; my $result = eval { local $SIG{ALRM} = sub {warn "Timeout!\n"; die 'timeout'}; alarm(15); chomp(my $input = <>); $input ||= 'y'; $input =~ /^[yY]/; }; alarm(0); my $filename = $result ? '.payment_confirmed' : '.payment_declined'; open my $f,">$filename"; close $f; return $result; } sub msg { my $msg = shift; print STDERR $msg; alarm(10); chomp (my $result = <>); $result; } 1;