New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

edeliver makes it super hard to know what goes wrong when things go wrong #80

Closed
aaronjensen opened this Issue May 12, 2016 · 3 comments

Comments

Projects
None yet
2 participants
@aaronjensen
Contributor

aaronjensen commented May 12, 2016

In my recent battle with upgrading edeliver and trying to use upgrade, there were many many times when I would see errors with just an exit code and a block of script printed out. This was especially horrible when it was the AWS perl script being redirected into perl.

I propose that we at least:

  1. Remove all > /dev/null and the like from remote run scripts when verbose is enabled (or maybe generally and print the output only if there is an error).
  2. Find another way to print failures that doesn't involve regurgitating an entire perl script in the console.
  3. Ensure that the AWS script outputs that it cannot find a file when that's all the error is.
@bharendt

This comment has been minimized.

Contributor

bharendt commented May 15, 2016

edeliver hides all output until you use the --verbose option. In that case all output of all bash commands executed by edeliver is printed. When using the --debug option, you are also able to inspect every single bash command executed by edeliver.

  1. This is exactly what edeliver does.

Of course, it is not impossible that there would be a mistake at any line of the edeliver code and redirecting directly to /dev/null is used wrongly instead of redirecting to the SILENCE env. And it would be nice if you could reference the code you believe is incorrect or should be improved.
But it does not look like there is any wrong redirection to /dev/null:

$ grep -rn 'dev/null' libexec/ strategies/  | grep -v '2>/'
libexec//core:340:  while kill -0 $_edeliver_script_pid >/dev/null 2>&1; do
libexec//core:341:    if kill -0 $_parent_pid >/dev/null 2>&1; then
libexec//core:345:         [[ "$_child_pid" =~ ^[0-9]+$ ]] && kill -9 $_child_pid >/dev/null 2>&1
libexec//core:347:      kill -9 $_edeliver_script_pid >/dev/null 2>&1
libexec//core:367:  declare -F "$_function" > /dev/null && eval "$_function $@"
libexec//erlang:761:      ls -al | grep erts- > /dev/null && {
libexec//erlang-init:481:    SILENCE="&> /dev/null"

Occurrences in __monitor_parent_pid() from libexec/core:340-347 are used internally to monitor the script process, __exec_if_defined() from libexec/core:367 is a check of which its output should not be used. Same for libexec//erlang:761,

libexec/erlang-init:481 shows how it works. edeliver redirects all output to $SILENCE instead of /dev/null directly, which is set according to the --verbose option.

Printing the output only if there is an error is not possible, because the remote commands are executed concurrently on all deploy hosts (in bash you can't capture the output of a spawned process).

  1. edeliver always prints the (remotely) executed command if it fails. This helps to reproduce and locate the error on the remote host.

In case of downloading the release from aws, that command is the aws perl script. Using this scipt inline allows us to deploy releases from aws to any host whithout any dependencies on that host, e.g. an aws client.

  1. If the aws script fails, it means that the file could not be copied.

This is the only purpose of the script.

But of course there might be still different reasons for that:

  • wrong aws credentials
  • file to upload does not exist
  • file to download does not exist
  • destination dir does not exist

I don't like to touch that script at all, but if you would like to add some more output, feel free to submit a pull request or find a bash script that does the same.

Than we would not need to embed the perl script into the copy step of the deploy command. Unfortunately the onliest aws bash script did not work and is not maintained any more.

Btw: you can also use a scp location as release store, which should be even faster as aws if it is located in your own (deploy) network.

@aaronjensen

This comment has been minimized.

Contributor

aaronjensen commented May 15, 2016

Thank you for the detailed reply. I'm sure that some of the issues I ran into had to do with me not running --verbose while testing locally (we always run with --verbose on our build agents), so maybe there is only the problem of the aws script...

grep -v '2>/'

I believe this is the problem, when things go wrong, stderr is suppressed. This is true of the aws perl script:

libexec/erlang
426:  AWS_ARGUMENTS="get ${AWS_BUCKET_NAME}/${_source_file}" AWS_ACCESS_KEY_ID="$AWS_ACCESS_KEY_ID" AWS_SECRET_ACCESS_KEY="$AWS_SECRET_ACCESS_KEY" perl $BASE_PATH/libexec/aws 2>/dev/null > "$_destination_file" || {
585:    AWS_ACCESS_KEY_ID="$AWS_ACCESS_KEY_ID" AWS_SECRET_ACCESS_KEY="$AWS_SECRET_ACCESS_KEY" ${BASE_PATH}/libexec/aws ls ${AWS_BUCKET_NAME} 2>/dev/null | grep -o "${APP}_.*.${_release_type}.tar.gz" | sort -bt. -k1,1 -k2,2n -k3,3n -k4,4n -k5,5n
627:      AWS_ARGUMENTS=\"get ${AWS_BUCKET_NAME}/${_release_file} \" AWS_ACCESS_KEY_ID=\"$AWS_ACCESS_KEY_ID\" AWS_SECRET_ACCESS_KEY=\"$AWS_SECRET_ACCESS_KEY\" perl > ${APP}_${_release_version}.tar.gz 2>/dev/null <<'EOF'${_aws_script_content}EOF ;"

That is, of course, assuming that it prints anything at all if things go wrong. Maybe it doesn't, I don't know because it is supressed. What I do know, is that when I'm trying to get edeliver working or I'm just going about my day-to-day after it is working, it is super confusing to get this as output:

[22:05:55]-----> Uploading archive of release 2.6.1-7293-gb0557ac from s3 release store
[22:05:55]bash: line 3498: warning: here-document at line 5 delimited by end-of-file (wanted `EOF#!/usr/bin/perl')
[22:05:56]
[22:05:56]FAILED  22:
[22:05:56]ssh -o ConnectTimeout=3 deploy@edge.curadora.com 
[22:05:56]      [ -f ~/.profile ] && source ~/.profile
[22:05:56]      set -e
[22:05:56]      mkdir -p /var/www/booking/releases/2.6.1-7293-gb0557ac 
[22:05:56]      cd /var/www/booking/releases/2.6.1-7293-gb0557ac 
[22:05:56]      AWS_ARGUMENTS="get myapp/booking_2.6.1-7293-gb0557ac.upgrade.tar.gz " AWS_ACCESS_KEY_ID="XX" AWS_SECRET_ACCESS_KEY="XX" perl > booking_2.6.1-7293-gb0557ac.tar.gz 2>/dev/null <<'EOF'#!/usr/bin/perl
[22:05:56]#
[22:05:56]# Copyright 2007-2010 Timothy Kay
[22:05:56]# http://timkay.com/aws/
[22:05:56]#
[22:05:56]#    This program is free software: you can redistribute it and/or modify
[22:05:56]#    it under the terms of the GNU General Public License as published by
[22:05:56]#    the Free Software Foundation, either version 3 of the License, or
[22:05:56]#    (at your option) any later version.
[22:05:56]#
[22:05:56]#    This program is distributed in the hope that it will be useful,
[22:05:56]#    but WITHOUT ANY WARRANTY; without even the implied warranty of
[22:05:56]#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
[22:05:56]#    GNU General Public License for more details.
[22:05:56]#
[22:05:56]#    You should have received a copy of the GNU General Public License
[22:05:56]#    along with this program.  If not, see <http://www.gnu.org/licenses/>;.
[22:05:56]#
[22:05:56]
[22:05:56]
[22:05:56]$ec2_version = "2013-02-01";
[22:05:56]$sqs_version = "2009-02-01";
[22:05:56]$elb_version = "2010-07-01";
[22:05:56]$sdb_version = "2009-04-15";
[22:05:56]$iam_version = "2010-05-08";
[22:05:56]$sts_version = "2011-06-15";
[22:05:56]$pa_version  = "2009-01-06";
[22:05:56]$r53_version = "2012-02-29";
[22:05:56]
[22:05:56]
[22:05:56]#
[22:05:56]# Need to implement:
[22:05:56]#
[22:05:56]#   ConfirmProductInstance - not tested
[22:05:56]#   DescribeImageAttribute - not working "An internal error has occurred"
[22:05:56]#   ModifyImageAttribute
[22:05:56]#   ResetImageAttribute
[22:05:56]#
[22:05:56]/home/deploy/buildAgent/work/4bd1a45dbd96817c/booking/deps/edeliver/libexec/output: line 45: echo: write error: Resource temporarily unavailable
[22:05:56]# Windows support:
[22:05:56]#   BundleInstance
[22:05:56]#   DescribeBundleTasks
[22:05:56]#   CancelBundleTasks
[22:05:56]#
[22:05:56]
[22:05:56]@cmd = (
[22:05:56]    ["ec2", "add-group addgrp", CreateSecurityGroup, [
[22:05:56]   ["", GroupName],
[22:05:56]   ["d", GroupDescription],
[22:05:56]     ]],
[22:05:56]    ["ec2", "add-keypair addkey", CreateKeyPair, [["", KeyName]]],
[22:05:56]    ["ec2", "add-placement-group", CreatePlacementGroup, [
[22:05:56]   ["", GroupName],
[22:05:56]   ["s", Strategy],
[22:05:56]     ]],
[22:05:56]    ["ec2", "allocate-address allad", AllocateAddress],
[22:05:56]    ["ec2", "associate-address aad", AssociateAddress, [
[22:05:56]   ["", PublicIp],
[22:05:56]   ["i", InstanceId],
[22:05:56]     ]],
[22:05:56]    ["ec2", "attach-volume attvol", AttachVolume, [
[22:05:56]   ["", VolumeId],
[22:05:56]   ["i", InstanceId],
[22:05:56]   ["d", Device],
[22:05:56]     ]],
[22:05:56]    ["ec2", "authorize auth", AuthorizeSecurityGroupIngress, [
[22:05:56]   ["" => GroupName],
[22:05:56]   ["protocol P" => "IpPermissions.1.IpProtocol"],
[22:05:56]   [p => undef, undef, sub {
[22:05:56]       my($min, $max) = split(/-/, $_[0]."-".$_[0]);
[22:05:56]       ["IpPermissions.1.FromPort" => $min, "IpPermissions.1.ToPort" => $max];
[22:05:56]    }],
[22:05:56]   [q => "IpPermissions.1.ToPort"],
[22:05:56]   #["t", icmp type code],
[22:05:56]   ["source-group-user u" => "IpPermissions.1.Groups.N.UserId"],
[22:05:56]   ["source-group o" => "IpPermissions.1.Groups.N.GroupName"],
[22:05:56]   ["s" => "IpPermissions.1.IpRanges.N.CidrIp"],
[22:05:56]     ]],
[22:05:56]    ["ec2", "cancel-spot-instance-requests cancel csir", CancelSpotInstanceRequests, [
[22:05:56]   ["", SpotInstanceRequestIdN],
[22:05:56]     ]],
[22:05:56]    ["ec2", "confirm-product-instance", ConfirmProductInstance, [
[22:05:56]   ["", ProductCode],
[22:05:56]   ["i", InstanceId],
[22:05:56]     ]],
[22:05:56]    ["ec2", "create-image cimg", CreateImage, [
[22:05:56]   ["", InstanceId],
[22:05:56]   ["n", Name],
[22:05:56]   ["d", Description, ""],
[22:05:56]   ["no-reboot", NoReboot, false],
[22:05:56]     ]],
[22:05:56]    ["ec2", "create-snapshot csnap", CreateSnapshot, [
[22:05:56]   ["", VolumeId],
[22:05:56]   ["description", Description],
[22:05:56]     ]],
[22:05:56]    ["ec2", "create-spot-datafeed-subscription addsds", CreateSpotDatafeedSubscription, [
[22:05:56]   ["", Bucket],
[22:05:56]   ["b", Bucket],
[22:05:56]   ["p", Prefix, "spot/datafeed"],
[22:05:56]     ]],
[22:05:56]    ["ec2", "delete-spot-datafeed-subscription delsds", DeleteSpotDatafeedSubscription, []],
[22:05:56]    ["ec2", "describe-spot-datafeed-subscription dsds", DescribeSpotDatafeedSubscription, []],
[22:05:56]    ["ec2", "describe-spot-instance-requests dsir", DescribeSpotInstanceRequests, [
[22:05:56]   ["", SpotInstanceRequestIdN],
[22:05:56]     ]],
[22:05:56]    ["ec2", "describe-spot-price-history dsph", DescribeSpotPriceHistory, [
[22:05:56]   ["start", StartTime],
[22:05:56]   ["end", EndTime],
[22:05:56]   ["instance-type", InstanceType, "m1.small"],
[22:05:56]   ["description", ProductDescription, "Linux/UNIX"],
[22:05:56]     ]],
[22:05:56]    ["ec2", "create-volume cvol", CreateVolume, [
[22:05:56]   ["size", Size],
[22:05:56]   ["zone", AvailabilityZone],
[22:05:56]   ["snapshot", SnapshotId],
[22:05:56]     ]],
[22:05:56]    ["ec2", "delete-group delgrp", DeleteSecurityGroup, [["", GroupName]]],
[22:05:56]    ["ec2", "delete-placement-group", DeletePlacementGroup, [["", GroupName]]],
[22:05:56]    ["ec2", "delete-keypair delkey", DeleteKeyPair, [["", KeyName]]],
[22:05:56]    ["ec2", "delete-snapshot delsnap", DeleteSnapshot, [["", SnapshotId]]],
[22:05:56]    ["ec2", "delete-volume delvol", DeleteVolume, [["", VolumeId]]],
[22:05:56]    ["ec2", "deregister", DeregisterImage, [["", ImageId]]],
[22:05:56]    ["ec2", "describe-addresses dad", DescribeAddresses, [["", PublicIpN]]],
[22:05:56]    ["ec2", "describe-availability-zones daz", DescribeAvailabilityZones, [["", ZoneNameN]]],
[22:05:56]    ["ec2", "describe-security-groups describe-group describe-groups dgrp", DescribeSecurityGroups, [
[22:05:56]   ["", GroupNameN],
[22:05:56]   ["GroupName g" => "GroupNameN"],
[22:05:56]   ["GroupId i" => "GroupIdN"],
[22:05:56]   ["filter F", undef, undef, \&parse_tags_describe],
[22:05:56]     ]],
[22:05:56] 
[22:05:56]    ["ec2", "describe-image-attribute", DescribeImageAttribute, [
[22:05:56]   ["", ImageId],
[22:05:56]   ["l", launchPermission],
[22:05:56]   ["p", productCodes],
[22:05:56]   ["kernel", "kernel"],
[22:05:56]   ["ramdisk", "ramdisk"],
[22:05:56]   ["B", "blockDeviceMapping"],
[22:05:56]     ]],
[22:05:56]    ["ec2", "describe-images dim", DescribeImages, [
[22:05:56]   ["", ImageIdN],
[22:05:56]   ["o", OwnerN],
[22:05:56]   ["x", ExecutableByN],
[22:05:56]     ]],
[22:05:56]    ["ec2", "describe-instances din", DescribeInstances, [["", InstanceIdN]]],
[22:05:56]    ["ec2", "describe-instance-attributes dinatt", DescribeInstanceAttribute, [
[22:05:56]   ["", InstanceId],
[22:05:56]   ["attribute a" => "Attribute"],
[22:05:56]     ]],
[22:05:56]    ["ec2", "describe-keypairs dkey", DescribeKeyPairs, [["", KeyNameN]]],
[22:05:56]    ["ec2", "describe-placement-groups", DescribePlacementGroups, [["", GroupNameN]]],
[22:05:56]    ["ec2", "describe-regions dreg", DescribeRegions],
[22:05:56]    ["ec2", "describe-reserved-instances", DescribeReservedInstances, [
[22:05:56]   ["", ReservedInstanceIdN],
[22:05:56]     ]],
[22:05:56]    ["ec2", "describe-reserved-instances-offerings", DescribeReservedInstancesOfferings, [
[22:05:56]   ["offering", ReservedInstancesOfferingIdN],
[22:05:56]   ["instance-type", InstanceType],
[22:05:56]   ["availability-zone", AvailabilityZone],
[22:05:56]   ["z", AvailabilityZone],
[22:05:56]   ["description", ProductDescription],
[22:05:56]     ]],
[22:05:56]    ["ec2", "describe-snapshot-attribute dsa", DescribeSnapshotAttribute, [
[22:05:56]   ["", SnapshotIdN],
[22:05:56]   ["attribute", Attribute],
[22:05:56]     ]],
[22:05:56]    ["ec2", "reset-snapshot-attribute rsa", ResetSnapshotAttribute, [
[22:05:56]   ["", SnapshotIdN],
[22:05:56]   ["attribute", Attribute],
[22:05:56]     ]],
[22:05:56]    ["ec2", "modify-snapshot-attribute msa", ModifySnapshotAttribute, [
[22:05:56]   ["", SnapshotId],
[22:05:56]   ["user", UserId],
[22:05:56]   ["group", UserGroup],
[22:05:56]   ["attribute", Attribute],
[22:05:56]   ["type", OperationType],
[22:05:56]     ]],
[22:05:56]    ["ec2", "describe-snapshots dsnap", DescribeSnapshots, [
[22:05:56]   ["", SnapshotIdN],
[22:05:56]   ["owner", Owner, "self"],
[22:05:56]   ["restorableby", RestorableBy],
[22:05:56]     ]],
[22:05:56]    ["ec2", "describe-volumes dvol", DescribeVolumes, [["", VolumeIdN]]],
[22:05:56]    ["ec2", "describe-volume-status dvs", DescribeVolumeStatus, [
[22:05:56]   ["", VolumeIdN],
[22:05:56]   ["filter f", undef, undef, \&parse_filter],
[22:05:56]     ]],
[22:05:56]    ["ec2", "detach-volume detvol", DetachVolume, [["", VolumeId]]],
[22:05:56]    ["ec2", "disassociate-address disad", DisassociateAddress, [["", PublicIp]]],
[22:05:56]    ["ec2", "get-console-output gco", GetConsoleOutput, [["", InstanceId]]],
[22:05:56]    ["ec2", "purchase-reserved-instance-offering", PurchaseReservedInstancesOffering, [
[22:05:56]   ["offering-id", ReservedInstancesOfferingId],
[22:05:56]   ["instance-count", InstanceCount],
[22:05:56]     ]],
[22:05:56]    ["ec2", "reboot-instances reboot", RebootInstances, [["", InstanceIdN]]],
[22:05:56]    ["ec2", "release-address rad", ReleaseAddress, [["", PublicIp]]],
[22:05:56]    ["ec2", "register-image register", RegisterImage, [
[22:05:56]   ["", ImageLocation],
[22:05:56]   ["name n" => Name],
[22:05:56]   ["description d" => Description],
[22:05:56]   ["architecture a" => Architecture],
[22:05:56]   [kernel => KernelId],
[22:05:56]   [ramdisk => RamdiskId],
[22:05:56]   ["root-device-name" => RootDeviceName, "/dev/sda1"],
[22:05:56]   ["block-device-mapping b", undef, undef, \&parse_block_device_mapping],
[22:05:56]   ["device-name" => "BlockDeviceMapping.N.DeviceName"],
[22:05:56]   ["no-device" => "BlockDeviceMapping.N.Ebs.NoDevice"],
[22:05:56]   ["virtual-name" => "BlockDeviceMapping.N.VirtualName"],
[22:05:56]   [snapshot => "BlockDeviceMapping.N.Ebs.SnapshotId"],
[22:05:56]   ["volume-size" => "BlockDeviceMapping.N.Ebs.VolumeSize"],
[22:05:56]   ["delete-on-termination" => "BlockDeviceMapping.N.Ebs.DeleteOnTermination"],
[22:05:56]     ]],
[22:05:56]    ["ec2", "request-spot-instances req-spot rsi", RequestSpotInstances, [
[22:05:56]   ["" => "LaunchSpecification.ImageId", "ami-4a0df923"],
[22:05:56]   ["price p" => SpotPrice],
[22:05:56]   ["instance-count n" => InstanceCount, 1],
[22:05:56]   ["type r" => Type, "one-time"],
[22:05:56]   ["valid-from-date" => ValidFrom],
[22:05:56]   ["valid-until-date" => ValidUntil],
[22:05:56]   ["launch-group" => LaunchGroup],
[22:05:56]   ["availability-zone-group" => AvailabilityZoneGroup],
[22:05:56]   ["user-data d" => "LaunchSpecification.UserData", undef,
[22:05:56]    sub {encode_base64($_[0], "")}],
[22:05:56]   ["user-data-file f" => "LaunchSpecification.UserData", undef,
[22:05:56]    sub {encode_base64(load_file($_[0]))}],
[22:05:56]   ["group g" => "LaunchSpecification.SecurityGroupN"],
[22:05:56]   ["a", "LaunchSpecification.AddressingType"],
[22:05:56]   ["key k" => "LaunchSpecification.KeyName"],
[22:05:56]   ["instance-type t" => "LaunchSpecification.InstanceType", "t1.micro"],
[22:05:56]   ["availability-zone z" => "LaunchSpecification.Placement.AvailabilityZone"],
[22:05:56]   [kernel => "LaunchSpecification.KernelId"],
[22:05:56]   [ramdisk => "LaunchSpecification.RamdiskId"],
[22:05:56]   [subnet => "LaunchSpecification.SubnetId"],
[22:05:56]   ["block-device-mapping b", undef, undef, \&parse_block_device_mapping_with_launch_specification],
[22:05:56]   ["device-name" => "LaunchSpecification.BlockDeviceMapping.N.DeviceName"],
[22:05:56]   ["no-device" => "LaunchSpecification.BlockDeviceMapping.N.Ebs.NoDevice"],
[22:05:56]   ["virtual-name" => "LaunchSpecification.BlockDeviceMapping.N.VirtualName"],
[22:05:56]   [snapshot => "LaunchSpecification.BlockDeviceMapping.N.Ebs.SnapshotId"],
[22:05:56]   ["volume-size" => "LaunchSpecification.BlockDeviceMapping.N.Ebs.VolumeSize"],
[22:05:56]   ["profile-arn" => "LaunchSpecification.IamInstanceProfile.Arn"],
[22:05:56]   ["profile-name" => "LaunchSpecification.IamInstanceProfile.Name"],
[22:05:56]   ["delete-on-termination" => "LaunchSpecification.BlockDeviceMapping.N.Ebs.DeleteOnTermination"],
[22:05:56]  onitor => "LaunchSpecification.Monitoring.Enabled"],
[22:05:56]     ]],
[22:05:56]    ["ec2", "revoke", RevokeSecurityGroupIngress, [
[22:05:56]   ["" => GroupName],
[22:05:56]   ["protocol P" => "IpPermissions.1.IpProtocol"],
[22:05:56]   ["p" => undef, undef, sub
[22:05:56]    {
[22:05:56]        my($min, $max) = split(/-/, $_[0]."-".$_[0]);
[22:05:56]        ["IpPermissions.1.FromPort" => $min, "IpPermissions.1.ToPort" => $max];
[22:05:56]    }],
[22:05:56]   ["q", "IpPermissions.1.ToPort"],
[22:05:56]   #["t", icmp type code],
[22:05:56]   ["source-group-user u" => "IpPermissions.1.Groups.N.UserId"],
[22:05:56]   ["source-group o" => "IpPermissions.1.Groups.N.GroupName"],
[22:05:56]   ["s" => "IpPermissions.1.IpRanges.N.CidrIp"],
[22:05:56]     ]],
[22:05:56]    ["ec2", "run-instances run-instance run", RunInstances, [
[22:05:56]   ["", ImageId],
[22:05:56]   ["instance-count n", undef, 1, sub
[22:05:56]    {
[22:05:56]        my($min, $max) = split(/-/, $_[0]."-".$_[0]);
[22:05:56]        [MinCount => $min, MaxCount => $max];
[22:05:56]    }],
[22:05:56]   ["group g", SecurityGroupN],
[22:05:56]   ["key k", KeyName],
[22:05:56]   ["user-data d", UserData, undef, sub {encode_base64($_[0], "")}],
[22:05:56]   ["user-data-file f", UserData, undef, sub {encode_base64(load_file($_[0]))}],
[22:05:56]   ["a", AddressingType],
[22:05:56]   ["instance-type type t i", InstanceType],
[22:05:56]   ["availability-zone z", "Placement.AvailabilityZone"],
[22:05:56]   ["kernel", KernelId],
[22:05:56]   ["ramdisk", RamdiskId],
[22:05:56]   ["block-device-mapping b", undef, undef, \&parse_block_device_mapping],
[22:05:56]   ["device-name" => "BlockDeviceMapping.N.DeviceName"],
[22:05:56]   ["no-device" => "BlockDeviceMapping.N.Ebs.NoDevice"],
[22:05:56]   ["virtual-name" => "BlockDeviceMapping.N.VirtualName"],
[22:05:56]   ["snapshot s" => "BlockDeviceMapping.N.Ebs.SnapshotId"],
[22:05:56]   ["volume-size" => "BlockDeviceMapping.N.Ebs.VolumeSize"],
[22:05:56]   ["profile-arn" => "IamInstanceProfile.Arn"],
[22:05:56]   ["profile-name role" => "IamInstanceProfile.Name"],
[22:05:56]   ["delete-on-termination" => "BlockDeviceMapping.N.Ebs.DeleteOnTermination"],
[22:05:56]   ["monitor m" => "Monitoring.Enabled"],
[22:05:56]   ["disable-api-termination" => DisableApiTermination],
[22:05:56]   ["instance-initiated-shutdown-behavior" => InstanceInitiatedShutdownBehavior],
[22:05:56]   ["placement-group" => "Placement.GroupName"],
[22:05:56]   ["subnet s" => SubnetId],
[22:05:56]   ["private-ip-address" => PrivateIpAddress],
[22:05:56]   ["client-token" => ClientToken],
[22:05:56]     ]],
[22:05:56]    ["ec2", "start-instances start", StartInstances, [["", InstanceIdN]]],
[22:05:56]    ["ec2", "stop-instances stop", StopInstances, [["", InstanceIdN]]],
[22:05:56]    ["ec2", "modify-instance-attribute minatt", ModifyInstanceAttribute, [["", InstanceId],
[22:05:56]                                    ["block-device-mapping b", undef, undef, \&parse_block_device_mapping],
[22:05:56]                                    ["disable-api-termination", "DisableApiTermination.Value"],
[22:05:56]                                    ["ebs-optimized", EbsOptimized],
[22:05:56]                                    ["group-id g", "GroupIdN"],
[22:05:56]                                    ["instance-initiated-shutdown-behavior", "InstanceInitiatedShutdownBehavior.Value"],
[22:05:56]                                    ["instance-type t", "InstanceType.Value"],
[22:05:56]                                    ["kernel", "Kernel.Value"],
[22:05:56]                                    ["ramdisk", "Ramdisk.Value"],
[22:05:56]                                    ["source-dest-check", "SourceDestCheck.Value"],
[22:05:56]                                    ["user-data d", "UserData.Value", undef, sub {encode_base64($_[0], "")}],
[22:05:56]                                    ["user-data-file f", "UserData.Value", undef, sub {encode_base64(load_file($_[0]))}],
[22:05:56]                                    ]],
[22:05:56]    ["ec2", "terminate-instances tin", TerminateInstances, [["", InstanceIdN]]],
[22:05:56]    ["ec2", "create-tags ctags", CreateTags, [
[22:05:56]   ["" => "ResourceIdN"],
[22:05:56]   ["tag", undef, undef, \&parse_tags],
[22:05:56]     ]],
[22:05:56]    ["ec2", "describe-tags dtags", DescribeTags, [
[22:05:56]   ["filter", undef, undef, \&parse_tags_describe],
[22:05:56]     ]],
[22:05:56]    ["ec2", "delete-tags deltags", DeleteTags, [
[22:05:56]   ["" => ResourceIdN],
[22:05:56]   ["tag", undef, undef, \&parse_tags_delete],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    #############
[22:05:56]    ###  ELB  ###
[22:05:56]    #############
[22:05:56]
[22:05:56]    ["elb", "configure-healthcheck ch", ConfigureHealthCheck, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["target", "HealthCheck.Target"],
[22:05:56]   ["healthy-threshold", "HealthCheck.HealthyThreshold"],
[22:05:56]   ["unhealthy-threshold", "HealthCheck.UnhealthyThreshold"],
[22:05:56]   ["interval", "HealthCheck.Interval"],
[22:05:56]   ["timeout", "HealthCheck.Timeout"],
[22:05:56]     ]],
[22:05:56]    ["elb", "create-app-cookie-stickiness-policy cacsp", CreateAppCookieStickinessPolicy, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["policy-name", PolicyName],
[22:05:56]   ["cookie-name", CookieName],
[22:05:56]     ]],
[22:05:56]    ["elb", "create-lb-cookie-stickiness-policy clbcsp", CreateLBCookieStickinessPolicy, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["policy-name", PolicyName],
[22:05:56]   ["expiration-period", "policy-name", PolicyName],
[22:05:56]     ]],
[22:05:56]    ["elb", "create-lb clb", CreateLoadBalancer, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["availability-zone", "AvailabilityZones.memberN"],
[22:05:56]   ["protocol", "Listeners.member.1.Protocol"],
[22:05:56]   ["loadbalancerport", "Listeners.member.1.LoadBalancerPort"],
[22:05:56]   ["instanceport", "Listeners.member.1.InstancePort"],
[22:05:56]     ]],
[22:05:56]    ["elb", "create-lb-listeners clbl", CreateLoadBalancerListeners, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["listener", "Listeners.memberN"],
[22:05:56]     ]],
[22:05:56]    ["elb", "delete-lb dellb", DeleteLoadBalancer, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]     ]],
[22:05:56]    ["elb", "delete-lb-listeners dlbl", DeleteLoadBalancerListeners, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["loadbalancerport", "LoadBalancerPorts.member.1"],
[22:05:56]     ]],
[22:05:56]    ["elb", "delete-lb-policy dlbp", DeleteLoadBalancerPolicy, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["policy-name", PolicyName],
[22:05:56]     ]],
[22:05:56]    ["elb", "describe-instance-health dih", DescribeInstanceHealth, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["listener", "Listeners.memberN"],
[22:05:56]     ]],
[22:05:56]    ["elb", "describe-lbs dlb", DescribeLoadBalancers, [
[22:05:56]   ["", LoadBalancerNameN],
[22:05:56]     ]],
[22:05:56]    ["elb", "disable-zones-for-lb dlbz", DisableAvailabilityZonesForLoadBalancer, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["availability-zone", "AvailabilityZones.memberN"],
[22:05:56]     ]],
[22:05:56]    ["elb", "enable-zones-for-lb elbz", EnableAvailabilityZonesForLoadBalancer, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["availability-zone", "AvailabilityZones.memberN"],
[22:05:56]     ]],
[22:05:56]    ["elb", "register-instances-with-lb rlbi", RegisterInstancesWithLoadBalancer, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["instance", "Instances.member.N.InstanceId"],
[22:05:56]     ]],
[22:05:56]    ["elb", "deregister-instances-from-lb dlbi", DeregisterInstancesFromLoadBalancer, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["instance", "Instances.member.N.InstanceId"],
[22:05:56]     ]],
[22:05:56]    ["elb", "set-lb-listener-ssl-cert slblsc", SetLoadBalancerListenerSSLCertificate, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["lb-port", LoadBalancerPort],
[22:05:56]   ["cert-id", SSLCertificateId],
[22:05:56]     ]],
[22:05:56]    ["elb", "set-lb-policies-of-listener slbpol", SetLoadBalancerPoliciesOfListener, [
[22:05:56]   ["", LoadBalancerName],
[22:05:56]   ["policy-name", "PolicyNames.memberN"],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    #############
[22:05:56]    ###  IAM  ###
[22:05:56]    #############
[22:05:56]
[22:05:56]    ["iam", "groupaddpolicy pgp", PutGroupPolicy, [
[22:05:56]   [" g" => GroupName],
[22:05:56]   [p => PolicyName],
[22:05:56]   [e, undef, undef, \&parse_addpolicy_effect],
[22:05:56]   [a, undef, undef, \&parse_addpolicy_action],
[22:05:56]   [r, undef, undef, \&parse_addpolicy_resource],
[22:05:56]   [o, undef, undef, \&parse_addpolicy_output],
[22:05:56]     ]],
[22:05:56]    ["iam", "groupadduser", AddUserToGroup, [
[22:05:56]   [" g" => GroupName],
[22:05:56]   [u => UserName],
[22:05:56]     ]],
[22:05:56]    ["iam", "groupcreate cg", CreateGroup, [
[22:05:56]   [" g" => GroupName],
[22:05:56]   [p => Path],
[22:05:56]     ]],
[22:05:56]    ["iam", "groupdel", DeleteGroup, [
[22:05:56]   [" g" => GroupName],
[22:05:56]     ]],
[22:05:56]    ["iam", "groupdelpolicy", DeleteGroupPolicy, [
[22:05:56]   [" g" => GroupName],
[22:05:56]   [p => PolicyName],
[22:05:56]     ]],
[22:05:56]    ["iam", "grouplistbypath lg", ListGroups],
[22:05:56]    ["iam", "grouplistpolicies lgp", ListGroupPolicies, [
[22:05:56]   [" g" => GroupName],
[22:05:56]   [p => PolicyName],
[22:05:56]     ]],
[22:05:56]    # GetGroupPolicy is automatically invoked when grouplistpolicies has a -p PolicyName
[22:05:56]    ["iam", "groupgetpolicy", GetGroupPolicy, [
[22:05:56]   [" g" => GroupName],
[22:05:56]   [p => PolicyName],
[22:05:56]     ]],
[22:05:56]    ["iam", "grouplistusers gg", GetGroup, [
[22:05:56]   [" g" => GroupName],
[22:05:56]     ]],
[22:05:56]    ["iam", "groupmod", UpdateGroup, [
[22:05:56]   [" g" => GroupName],
[22:05:56]   [n => NewGroupName],
[22:05:56]   [p => NewPath],
[22:05:56]     ]],
[22:05:56]    ["iam", "groupremoveuser", RemoveUserFromGroup, [
[22:05:56]   [" g" => GroupName],
[22:05:56]   [u => UserName],
[22:05:56]     ]],
[22:05:56]    ["iam", "groupuploadpolicy", PutGroupPolicy, [
[22:05:56]   [" g" => GroupName],
[22:05:56]   [p => PolicyName],
[22:05:56]   [o => PolicyDocument],
[22:05:56]   [f => PolicyDocument, undef, sub {load_file($_[0])}],
[22:05:56]     ]],
[22:05:56]    ["iam", "useraddcert", UploadSigningCertificate, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [c => CertificateBody],
[22:05:56]   [f => CertificateBody, undef, sub {load_file($_[0])}],
[22:05:56]     ]],
[22:05:56]    ["iam", "useraddkey cak", CreateAccessKey, [
[22:05:56]   [" u" => UserName],
[22:05:56]     ]],
[22:05:56]    ["iam", "useraddloginprofile clp", CreateLoginProfile, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [p => Password],
[22:05:56]     ]],
[22:05:56]    ["iam", "useraddpolicy pup", PutUserPolicy, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [p => PolicyName],
[22:05:56]   [e, undef, undef, \&parse_addpolicy_effect],
[22:05:56]   [a, undef, undef, \&parse_addpolicy_action],
[22:05:56]   [r, undef, undef, \&parse_addpolicy_resource],
[22:05:56]   [o, undef, undef, \&parse_addpolicy_output],
[22:05:56]     ]],
[22:05:56]    ["iam", "usercreate cu", CreateUser, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [p => Path],
[22:05:56]     ]],
[22:05:56]    ["iam", "userdeactivatemfadevice", DeactivateMFADevice, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [s => SerialNumber],
[22:05:56]     ]],
[22:05:56]    ["iam", "userdel", DeleteUser, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [s => XXX],
[22:05:56]     ]],
[22:05:56]    ["iam", "userdelcert", DeleteSigningCertificate, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [c => CertificateId],
[22:05:56]     ]],
[22:05:56]    ["iam", "userdelkey", DeleteAccessKey, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [k => AccessKeyId],
[22:05:56]     ]],
[22:05:56]    ["iam", "userdelloginprofile dlp", DeleteLoginProfile, [
[22:05:56]   [" u" => UserName],
[22:05:56]     ]],
[22:05:56]    ["iam", "userdelpolicy", DeleteUserPolicy, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [p => PolicyName],
[22:05:56]     ]],
[22:05:56]    ["iam", "userenablemfadevice", EnableMFADevice, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [s => SerialNumber],
[22:05:56]   [c1 => AuthenticationCode1],
[22:05:56]   [c2 => AuthenticationCode2],
[22:05:56]     ]],
[22:05:56]    ["iam", "usergetattributes gu", GetUser, [
[22:05:56]   [" u" => UserName],
[22:05:56]     ]],
[22:05:56]    ["iam", "usergetloginprofile glp", GetLoginProfile, [
[22:05:56]   [" u" => UserName],
[22:05:56]     ]],
[22:05:56]    ["iam", "userlistbypath lu", ListUsers, [
[22:05:56]   [" p" => PathPrefix],
[22:05:56]     ]],
[22:05:56]    ["iam", "userlistcerts", ListSigningCertificates, [
[22:05:56]   [" u" => UserName],
[22:05:56]     ]],
[22:05:56]    ["iam", "userlistgroups", ListGroupsForUser, [
[22:05:56]   [" u" => Username],
[22:05:56]     ]],
[22:05:56]    ["iam", "userlistkeys", ListAccessKeys, [
[22:05:56]   [" u" => UserName],
[22:05:56]     ]],
[22:05:56]    ["iam", "userlistmfadevices", ListMFADevices, [
[22:05:56]   [" u" => UserName],
[22:05:56]     ]],
[22:05:56]    ["iam", "userlistpolicies lup", ListUserPolicies, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [p => PolicyName],
[22:05:56]     ]],
[22:05:56]    # GetUserPolicy is automatically invoked when userlistpolicies has a -p PolicyName
[22:05:56]    ["iam", "usergetpolicy", GetUserPolicy, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [p => PolicyName],
[22:05:56]     ]],
[22:05:56]    ["iam", "usermod", UpdateUser, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [n => NewUserName],
[22:05:56]   [p => NewPath],
[22:05:56]     ]],
[22:05:56]    ["iam", "usermodcert", UpdateSigningCertificate, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [c => CertificateId],
[22:05:56]   [s => Status],
[22:05:56]     ]],
[22:05:56]    ["iam", "usermodkey", UpdateAccessKey, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [a => AccessKeyId],
[22:05:56]   [s => Status],
[22:05:56]     ]],
[22:05:56]    ["iam", "usermodloginprofile ulp", UpdateLoginProfile, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [p => Password],
[22:05:56]     ]],
[22:05:56]    ["iam", "userresyncmfadevice", ResyncMFADevice, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [s => SerialNumber],
[22:05:56]   [c1 => AuthenticationCode1],
[22:05:56]   [c2 => AuthenticationCode2],
[22:05:56]     ]],
[22:05:56]    ["iam", "useruploadpolicy", PutUserPolicy, [
[22:05:56]   [" u" => UserName],
[22:05:56]   [p => PolicyName],
[22:05:56]   [o => PolicyDocument],
[22:05:56]   [f => PolicyDocument, undef, sub {load_file($_[0])}],
[22:05:56]     ]],
[22:05:56]    ["iam", "servercertdel", DeleteServerCertificate, [
[22:05:56]   [" s" => ServerCertificateName],
[22:05:56]     ]],
[22:05:56]    ["iam", "servercertgetattributes", GetServerCertificate, [
[22:05:56]   [" s" => ServerCertificate],
[22:05:56]     ]],
[22:05:56]    ["iam", "servercertlistbypath", ListServerCertificates, [
[22:05:56]   [" p" => PathPrefix],
[22:05:56]     ]],
[22:05:56]    ["iam", "servercertmod", UpdateServerCertificate, [
[22:05:56]   [" p" => NewPath],
[22:05:56]   [s => ServerCertificateName],
[22:05:56]   [n => NewServerCertificateName],
[22:05:56]     ]],
[22:05:56]    ["iam", "servercertupload", UploadServerCertificate, [
[22:05:56]   [" s" => ServerCertificateName],
[22:05:56]   [p => Path],
[22:05:56]   [b => CertificateBody, undef, sub {load_file($_[0])}],
[22:05:56]   [k => PrivateKey, undef, sub {load_file($_[0])}],
[22:05:56]   [c => CertificateChain, undef, sub {load_file($_[0])}],
[22:05:56]     ]],
[22:05:56]    ["iam", "accountaliascreate caa", CreateAccountAlias,[
[22:05:56]   ["" => AccountAlias],
[22:05:56]     ]],
[22:05:56]    ["iam", "accountaliasdelete daa", DeleteAccountAlias,[
[22:05:56]   ["" => AccountAlias],
[22:05:56]     ]],
[22:05:56]    ["iam", "accountaliaslist laa", ListAccountAliases],
[22:05:56]    ["iam", "listroles lr", ListRoles, [
[22:05:56]   [" p" => "PathPrefix", "/"],
[22:05:56]   ["marker m" => "Marker"],
[22:05:56]   ["maxitems i" => "MaxItems"],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["s3", "ls", LS],
[22:05:56]    ["s3", "get cat", GET],
[22:05:56]    ["s3", "head", HEAD],
[22:05:56]    ["s3", "mkdir", MKDIR],
[22:05:56]    ["s3", "put", PUT],
[22:05:56]    ["s3", "delete rmdir rm", DELETE],
[22:05:56]    ["s3", "copy cp", COPY],
[22:05:56]    ["s3", "dmo", DMO],
[22:05:56]    ["s3", "post", POST],
[22:05:56]
[22:05:56]    ["sqs", "add-permission addperm", AddPermission, [
[22:05:56]   ["" => QueueUri],
[22:05:56]   [label => Label],
[22:05:56]   [account => AWSAccountIdN],
[22:05:56]   [action => ActionNameN],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sqs", "change-message-visibility cmv", ChangeMessageVisibility, [
[22:05:56]   ["" => QueueUri],
[22:05:56]   [handle => ReceiptHandle],
[22:05:56]   [timeout => VisibilityTimeout],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sqs", "create-queue cq", CreateQueue, [
[22:05:56]   ["" => QueueName],
[22:05:56]   [timeout => DefaultVisibilityTimeout],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sqs", "delete-message dm", DeleteMessage, [
[22:05:56]   ["" => QueueUri],
[22:05:56]   [handle => ReceiptHandle],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sqs", "delete-queue dq", DeleteQueue, [
[22:05:56]   ["" => QueueUri],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sqs", "get-queue-attributes gqa", GetQueueAttributes, [
[22:05:56]   ["" => QueueUri],
[22:05:56]   [attribute => AttributeNameN],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sqs", "list-queues lq", ListQueues, [
[22:05:56]   ["" => QueueNamePrefix],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sqs", "receive-message recv", ReceiveMessage, [
[22:05:56]   ["" => QueueUri],
[22:05:56]   [attribute => AttributeNameN],
[22:05:56]   [n => MaxNumberOfMessages],
[22:05:56]   [timeout => VisibilityTimeout],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sqs", "remove-permission remperm", RemovePermission, [
[22:05:56]   ["" => QueueUri],
[22:05:56]   [label => Label],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sqs", "send-message send", SendMessage, [
[22:05:56]   ["" => QueueUri],
[22:05:56]  essage => MessageBody, "", sub {encode_message($_[0])}],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sqs", "set-queue-attributes sqa", SetQueueAttributes, [
[22:05:56]   ["" => QueueUri],
[22:05:56]   [attribute => "Attribute.Name"],
[22:05:56]   [value => "Attribute.Value"],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["sdb", "create-domain cdom", CreateDomain, [
[22:05:56]   ["" => DomainName],
[22:05:56]     ]],
[22:05:56]    ["sdb", "delete-attributes datt", DeleteAttributes, [
[22:05:56]   ["" => DomainName],
[22:05:56]   [i => ItemName],
[22:05:56]   [n => "Attribute.N.Name"],
[22:05:56]   [v => "Attribute.N.Value"],
[22:05:56]   [xn => "Expected.N.Name"],
[22:05:56]   [xv => "Expected.N.Value"],
[22:05:56]   [exists => "Expected.N.Exists"],
[22:05:56]     ]],
[22:05:56]    ["sdb", "delete-domain ddom", DeleteDomain, [
[22:05:56]   ["" => DomainName],
[22:05:56]     ]],
[22:05:56]    ["sdb", "get-attributes gatt", GetAttributes, [
[22:05:56]   ["" => DomainName],
[22:05:56]   [i => ItemName],
[22:05:56]   [n => AttributeName],
[22:05:56]   [c => ConsistentRead],
[22:05:56]     ]],
[22:05:56]    ["sdb", "list-domains ldom", ListDomains, [
[22:05:56]  ax => MaxNumberOfDomains],
[22:05:56]   [next => NextToken],
[22:05:56]     ]],
[22:05:56]    ["sdb", "put-attributes patt", PutAttributes, [
[22:05:56]   ["" => DomainName],
[22:05:56]   [i => ItemName],
[22:05:56]   [n => "Attribute.N.Name"],
[22:05:56]   [v => "Attribute.N.Value"],
[22:05:56]   [replace => "Attribute.N.Replace"],
[22:05:56]   [xn => "Expected.N.Name"],
[22:05:56]   [xv => "Expected.N.Value"],
[22:05:56]   [exists => "Expected.N.Exists"],
[22:05:56]     ]],
[22:05:56]    ["sdb", "select", Select, [
[22:05:56]   ["" => SelectExpression],
[22:05:56]   [c => ConsistentRead],
[22:05:56]   [next => NextToken],
[22:05:56]     ]],
[22:05:56]    #####  R53 (Route 53, DNS)
[22:05:56]    ["r53", "list-resource-record-sets lrrs", 'GET|rrset', [
[22:05:56]   ['' => zone_id],
[22:05:56]   [xml => __xml],
[22:05:56]   [simple => __simple],
[22:05:56]   [name => name],
[22:05:56]   [type => type],
[22:05:56]   [identifier => identifier],
[22:05:56]  axitems => maxitems],
[22:05:56]     ]],
[22:05:56]    ["r53", "get-change gch", 'GET|', [
[22:05:56]   ['' => change_id], 
[22:05:56]     ]],
[22:05:56]    ["r53", "get-hosted-zone ghz", 'GET|', [
[22:05:56]       ['', zone_id],
[22:05:56]     ]],
[22:05:56]    ["r53", "create-hosted-zone chz", 'POST|', [
[22:05:56]   ['' => Name],
[22:05:56]   ['ref' => CallerReference],
[22:05:56]   ['comment' => Comment],
[22:05:56]     ]],
[22:05:56]    ["r53", "delete-hosted-zone dhz", 'DELETE|', [
[22:05:56]   ['' => zone_id],
[22:05:56]     ]],
[22:05:56]    ["r53", "list-resource-record-sets lrrs", 'GET|rrset', [
[22:05:56]   ['' => zone_id],
[22:05:56]      axitems => maxitems],
[22:05:56]     ]],
[22:05:56]    ["r53", "change-resource-record-set crrs", 'POST|rrset', [
[22:05:56]   ['' => zone_id],
[22:05:56]   ['name n', Name],
[22:05:56]   ['action a', Action],
[22:05:56]   ['type t', Type],
[22:05:56]   ['ttl l', TTL],
[22:05:56]   ['value v', Value],
[22:05:56]   ['comment c', Comment],
[22:05:56]     ]],
[22:05:56]
[22:05:56]    ["pa", "lookup", ItemLookup, [
[22:05:56]   ["" => ItemId],
[22:05:56]   ["type t" => IdType],
[22:05:56]   ["r" => ResponseGroup],
[22:05:56]   ["c" => Condition],
[22:05:56]   ["a" => AssociateTag],
[22:05:56]     ]],
[22:05:56]    );
[22:05:56]
[22:05:56]
[22:05:56]$isUnix = guess_is_unix();
[22:05:56]$home = get_home_directory();
[22:05:56]
[22:05:56]# Figure out $cmd.  If the program is run as other than "aws", then $0 contains
[22:05:56]# the command.  This way, you can link aws to the command names (with or without
[22:05:56]# ec2 or s3 prefix) and not have to type "aws".
[22:05:56]unshift @ARGV, $1 if $0 =~ /^(?:.*[\\/])?(?:(?:ec2|pa|s3|sqs|sdb)-?)?(.+?)(?:\..+)?$/ && $1 !~ /^l?aws/;
[22:05:56]
[22:05:56]if ((!@ARGV || join(@ARGV, "") == "-") && $ENV{"AWS_ARGUMENTS"}) {
[22:05:56]  @ARGV=split(/ /, $ENV{"AWS_ARGUMENTS"});
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]# parse meta-parameters, leaving parameters in @argv
[22:05:56]
[22:05:56]{
[22:05:56]    my(%keyword);
[22:05:56]
[22:05:56]    # The %need_arg items must have a value.  If they aren't of the form
[22:05:56]    # --foo=bar, then slurp up the next item as the value.  Thus, for example,
[22:05:56]    #  --region=eu  and  --region eu  both work, with or without the =.
[22:05:56]    my(%need_arg, $key_for_arg);
[22:05:56]    @needs_arg{qw(region)} = undef;
[22:05:56]
[22:05:56]    my(%meta);
[22:05:56]    @meta{qw(1 assume cmd0 content_length curl curl_options cut d delimiter dns_alias dump_xml exec expire_time fail h help http
[22:05:56]       insecure insecure_signing insecure_aws insecureaws install json l limit_rate link
[22:05:56]       max_time marker md5 no_vhost parts prefix private progress public queue r region request requester retry role ruby quiet
[22:05:56]       s3host sanity_check set_acl sha1 sign silent simple sts_host t v verbose vv vvv wait xml yaml)} = undef;
[22:05:56]
[22:05:56]    my @awsrc = "";
[22:05:56]    for (split(/(?:\#.*?(?=
[22:05:56])|'(.*?)'|"((?:\[\\"]|.)*?)"|((?:\.|\$.|[^\s\'\"\#])+))/s, load_file_silent("$home/.awsrc")))
[22:05:56]    {
[22:05:56]  if (/^\s+$/)
[22:05:56]  {
[22:05:56]      push @awsrc, "" if length($awsrc[$#awsrc]);
[22:05:56]  }
[22:05:56]  else
[22:05:56]  {
[22:05:56]      $awsrc[$#awsrc] .= $_;
[22:05:56]  }
[22:05:56]    }
[22:05:56]    pop @awsrc unless length($awsrc[$#awsrc]);
[22:05:56]
[22:05:56]    for (@awsrc, @ARGV)
[22:05:56]    {
[22:05:56]  if ($key_for_arg)
[22:05:56]  {
[22:05:56]      $ {$key_for_arg} = $_;
[22:05:56]      undef $key_for_arg;
[22:05:56]  }
[22:05:56]  elsif (/^--([\w\-]+?)(?:=(.*))?$/s)
[22:05:56]  {
[22:05:56]      my($key0, $val) = ($1, $2);
[22:05:56]      (my $key = $key0) =~ s/-/_/g;
[22:05:56]      if (exists $needs_arg{$key} && !defined $val)
[22:05:56]      {
[22:05:56]      $key_for_arg = $key;
[22:05:56]      }
[22:05:56]      elsif (exists $keyword{$key})
[22:05:56]      {
[22:05:56]      push @argv, $_;
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]      die "--$key0: mispelled meta parameter?
[22:05:56]" unless exists $meta{$key};
[22:05:56]      $ {$key} = defined $val? $val: 1;
[22:05:56]      # --cmd0 is used to call self but without getting the command from $0
[22:05:56]      undef $cmd if $key eq "cmd0" && $val;
[22:05:56]      }
[22:05:56]  }
[22:05:56]  elsif (/^-(\w+)$/)
[22:05:56]  {
[22:05:56]      if (exists $keyword{$1})
[22:05:56]      {
[22:05:56]      push @argv, $_;
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]      for (split(//, $1))
[22:05:56]      {
[22:05:56]          die "-$_: mispelled meta parameter?
[22:05:56]" unless exists $meta{$_};
[22:05:56]          s/^(\d)$/d$1/;
[22:05:56]          $ {$_}++;
[22:05:56]      }
[22:05:56]      }
[22:05:56]  }
[22:05:56]  else
[22:05:56]  {
[22:05:56]      if ($cmd)
[22:05:56]      {
[22:05:56]      push @argv, $_;
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]      $cmd = $_;
[22:05:56]
[22:05:56]      # moved this code here, so that arguments to specific ec2, s3, and sqs commands
[22:05:56]      # are active only if the particular command is indicated
[22:05:56]
[22:05:56]      # make a hash of aws keywords (%keyword), which are not treated as meta-parameters
[22:05:56]      for (@cmd)
[22:05:56]      {
[22:05:56]          next unless grep /^\Q$cmd $/, split(" ", $_->[1]);
[22:05:56]          $cmd_data = $_;
[22:05:56]          push @{$cmd_data->[3]}, ["filter", undef, undef, \&parse_filter] if $_->[1] =~ / describe/;
[22:05:56]          for (@{$cmd_data->[3]})
[22:05:56]          {
[22:05:56]          for (split(" ", $_->[0]))
[22:05:56]          {
[22:05:56]              (my $key = $_) =~ s/-/_/g;
[22:05:56]              $keyword{$key} = undef;
[22:05:56]          }
[22:05:56]          }
[22:05:56]          last;
[22:05:56]      }
[22:05:56]      }
[22:05:56]  }
[22:05:56]    }
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]$h ||= $help;
[22:05:56]$v ||= $verbose;
[22:05:56]$v = 2 if $vv;
[22:05:56]$v = 3 if $vvv;
[22:05:56]
[22:05:56]$curl ||= "curl";
[22:05:56]
[22:05:56]$ENV{COLUMNS}-- if $ENV{COLUMNS} && $ENV{EMACS};
[22:05:56]
[22:05:56]if ($cut)
[22:05:56]{
[22:05:56]    my $columns = $ENV{COLUMNS};
[22:05:56]    ($columns) = qx[stty -a <&2] =~ /;\s*columns\s*(\d+);/s unless $columns;
[22:05:56]    open STDOUT, "|cut -c -$columns" if $columns;
[22:05:56]}
[22:05:56]
[22:05:56]# Exercise for the reader: why is this END block here?  (Hint: bug in Perl?)
[22:05:56]END {close STDOUT}
[22:05:56]
[22:05:56]# Don't know if the -gov- default for $s3host is correct... are there other GovCloud regions, and what endpoint do they use?
[22:05:56]$s3host ||= $ENV{S3_URL} || ($region =~ /-gov-/? "s3-$region.amazonaws.com": "s3.amazonaws.com");
[22:05:56]$sts_host ||= $ENV{STS_URL} || ($s3host =~ /^s3-(.*?)\.amazonaws\.com$/? "sts.$1.amazonaws.com": "sts.amazonaws.com");
[22:05:56]
[22:05:56]print STDERR "aws versions: (ec2: $ec2_version, sqs: $sqs_version, elb: $elb_version, sdb: $sdb_version, iam: $iam_version)
[22:05:56]" if $v;
[22:05:56]
[22:05:56]$insecsign = "--insecure" if $insecure || $insecure_signing;
[22:05:56]$insecureaws = "--insecure" if $insecureaws || $insecure_aws;
[22:05:56]
[22:05:56]$scheme = $http? "http": "https";
[22:05:56]
[22:05:56]$silent ||= !-t;
[22:05:56]$retry = 3 unless length($retry);
[22:05:56]
[22:05:56]
[22:05:56]if ($role)
[22:05:56]{
[22:05:56]    if ($role == 1)
[22:05:56]    {
[22:05:56]  my $cmd = qq[$curl -s --max-time 2 --fail  http://169.254.169.254/latest/meta-data/iam/security-credentials/];
[22:05:56]  print "$cmd
[22:05:56]" if $v;
[22:05:56]  ($role) = qx[$cmd];
[22:05:56]    }
[22:05:56]    if ($role)
[22:05:56]    {
[22:05:56]  my $cmd = qq[$curl -s --max-time 2 --fail http://169.254.169.254/latest/meta-data/iam/security-credentials/$role];
[22:05:56]  print "$cmd
[22:05:56]" if $v;
[22:05:56]  my $json = qx[$cmd];
[22:05:56]  ($awskey) = $json =~ /"AccessKeyId" : "(.*?)"/;
[22:05:56]  ($secret) = $json =~ /"SecretAccessKey" : "(.*?)"/;
[22:05:56]  ($session) = $json =~ /"Token" : "(.*?)"/;
[22:05:56]    }
[22:05:56]}
[22:05:56]
[22:05:56]unless ($awskey && $secret)
[22:05:56]{
[22:05:56]    ($awskey, $secret, $session) = @ENV{qw(AWS_ACCESS_KEY_ID AWS_SECRET_ACCESS_KEY AWS_SESSION_TOKEN)};
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]if ($assume)
[22:05:56]{
[22:05:56]    $assume =~ s/\'//g;
[22:05:56]
[22:05:56]    my($sec, $min, $hour, $mday, $mon, $year, undef, undef, undef) = gmtime(time + $time_offset);
[22:05:56]    my $zulu = sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ", 1900 + $year, $mon + 1, $mday, $hour, $min, $sec;
[22:05:56]
[22:05:56]    my %data = (
[22:05:56]  AWSAccessKeyId => $awskey, SignatureMethod => ($sha1? HmacSHA1: HmacSHA256), SignatureVersion => 2, Version => $sts_version, Timestamp => $zulu,
[22:05:56]  Action => AssumeRole,
[22:05:56]  RollSessionName => TimKayAWS,
[22:05:56]  RoleArn => $assume,
[22:05:56]  );
[22:05:56]    $data{SecurityToken} = $session if $session;
[22:05:56]
[22:05:56]    my($url);
[22:05:56]    
[22:05:56]    for (sort keys %data)
[22:05:56]    {
[22:05:56]  $url .= "&" if $url;
[22:05:56]  $url .= "$_=@{[encode_url($data{$_})]}";
[22:05:56]    }
[22:05:56]
[22:05:56]    my $sig = sign("GET
[22:05:56]$sts_host
[22:05:56]/
[22:05:56]$url", $data{SignatureMethod});
[22:05:56]    $url = "https://$sts_host/?Signature=@{[encode_url($sig)]}&$url";
[22:05:56]    my $xml = qx[$curl -s '$url'];
[22:05:56]
[22:05:56]    if ($xml !~ /<AccessKeyId>/)
[22:05:56]    {
[22:05:56]  print $xml unless $fail;
[22:05:56]  exit 22;
[22:05:56]    }
[22:05:56]
[22:05:56]    for ($xml)
[22:05:56]    {
[22:05:56]  ($awskey) = /<AccessKeyId>\s*(.*?)\s*<\/AccessKeyId>/s;
[22:05:56]  ($secret) = /<SecretAccessKey>\s*(.*?)\s*<\/SecretAccessKey>/s;
[22:05:56]  ($session) = /<SessionToken>\s*(.*?)\s*<\/SessionToken>/s;
[22:05:56]    }
[22:05:56]
[22:05:56]    print "awskey = $awskey
[22:05:56]";
[22:05:56]    print "secret = $secret
[22:05:56]";
[22:05:56]    print "session = $session
[22:05:56]";
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]# unfortunately, you can't have a delimiter of "1" this way
[22:05:56]if ($d || $delimiter == 1)
[22:05:56]{
[22:05:56]    $delimiter = "/";
[22:05:56]}
[22:05:56]
[22:05:56]for ([m => 60], [h => 60 * 60], [d => 24 * 60 * 60], [w => 7 * 24 * 60 * 60],o => 30 * 24 * 60 * 60], [y => 365.25 * 24 * 60 * 60])
[22:05:56]{
[22:05:56]    $expire_time = $1 * $_->[1] if $expire_time =~ /^(-?\d+)$_->[0]$/;
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]# run a sanity check if $home/.awsrc doesn't exists, or if it was requested
[22:05:56]
[22:05:56]if (!-e "$home/.awsrc" || $sanity_check)
[22:05:56]{
[22:05:56]    if (!$silent)
[22:05:56]    {
[22:05:56]  if ($role)
[22:05:56]  {
[22:05:56]      if ($role == 1)
[22:05:56]      {
[22:05:56]      if (qx[$curl -s --fail  http://169.254.169.254/latest/meta-data/iam/security-credentials/] !~ /\w/)
[22:05:56]      {
[22:05:56]          warn "sanity-check: no role found
[22:05:56]";
[22:05:56]      }
[22:05:56]      }
[22:05:56]  }
[22:05:56]  elsif (($ENV{AWS_SECRET_ACCESS_KEY} && $ENV{AWS_ACCESS_KEY_ID}) || ($ENV{EC2_SECRET_KEY} && $ENV{EC2_ACCESS_KEY}))
[22:05:56]  {
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    my($curl_version) = qx[$curl -V] =~ /^curl\s+([\d\.]+)/s;
[22:05:56]    print "curl version: $curl_version
[22:05:56]" if $v >= 2;
[22:05:56]    if (xcmp($curl_version, "7.12.3") < 0)
[22:05:56]    {
[22:05:56]  $retry = undef;
[22:05:56]  warn "sanity-check: This curl (v$curl_version) does not support --retry (>= v7.12.3), so --retry is disabled
[22:05:56]" unless $silent;
[22:05:56]    }
[22:05:56]
[22:05:56]    my $aws = qx[$curl -q -s $insecureaws --include $scheme://connection.$s3host/test];
[22:05:56]    print $aws if $v >= 2;
[22:05:56]    my($d, $mon, $y, $h, $m, $s) = $aws =~ /^Date: ..., (..) (...) (....) (..):(..):(..) GMT
[22:05:56]?$/m;
[22:05:56]
[22:05:56]    if (!$d)
[22:05:56]    {
[22:05:56]  $aws = qx[$curl -q -s --insecure --include $scheme://connection.$s3host/test];
[22:05:56]  ($d, $mon, $y, $h, $m, $s) = $aws =~ /^Date: ..., (..) (...) (....) (..):(..):(..) GMT
[22:05:56]?$/m;
[22:05:56]  if ($d)
[22:05:56]  {
[22:05:56]      warn "sanity-check: Your host SSL certificates are not working for curl.exe.  Try using --insecure-aws (e.g., aws --insecure-aws ls)
[22:05:56]";
[22:05:56]  }
[22:05:56]  else
[22:05:56]  {
[22:05:56]      $aws = qx[$curl -q -s --insecure --include http://connection.$s3host/test];
[22:05:56]      ($d, $mon, $y, $h, $m, $s) = $aws =~ /^Date: ..., (..) (...) (....) (..):(..):(..) GMT
[22:05:56]?$/m;
[22:05:56]      if ($d)
[22:05:56]      {
[22:05:56]      die "sanity-check:  Your curl doesn't seem to support SSL.  Try using --http (e.g., aws --http ls)
[22:05:56]";
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]      die "sanity-check:  Problems accessing AWS.  Is curl installed?
[22:05:56]";
[22:05:56]      }
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    if (eval {require Time::Local})
[22:05:56]    {
[22:05:56]  $mon = {Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4, Jun => 5, Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11}->{$mon};
[22:05:56]  my $t = Time::Local::timegm($s, $m, $h, $d, $mon, $y);
[22:05:56]  $time_offset = $t - time;
[22:05:56]  warn "sanity-check: Your system clock is @{[abs($time_offset)]} seconds @{[$time_offset > 0? 'behind': 'ahead']}.
[22:05:56]" if !$silent && abs($time_offset) > 5;
[22:05:56]    }
[22:05:56]}
[22:05:56]
[22:05:56]$curl_options .= " -q -g -S";
[22:05:56]$curl_options .= " --remote-time";
[22:05:56]$curl_options .= " --retry $retry" if length($retry);
[22:05:56]$curl_options .= " --fail" if $fail;
[22:05:56]$curl_options .= " --verbose" if $v >= 2;
[22:05:56]$curl_options .= $progress? " --progress": " -s";
[22:05:56]$curl_options .= " --max-time $max_time" if $max_time;
[22:05:56]$curl_options .= " --limit-rate $limit_rate" if $limit_rate;
[22:05:56]
[22:05:56]
[22:05:56]#use Digest::SHA1 qw(sha1);
[22:05:56]#use Digest::SHA::PurePerl qw(sha1);
[22:05:56]#use MIME::Base64; -- added encode_base64() below
[22:05:56]
[22:05:56]use IO::File;
[22:05:56]use File::Temp qw(tempfile);
[22:05:56]use Digest::MD5 qw(md5 md5_hex);
[22:05:56]
[22:05:56]
[22:05:56]if ($install)
[22:05:56]{
[22:05:56]    die "Usage: .../aws --install
[22:05:56]" if $install && @argv;
[22:05:56]
[22:05:56]    if (-w "/usr/bin")
[22:05:56]    {
[22:05:56]  chomp(my $dir = qx[pwd]);
[22:05:56]  my $path = $0;
[22:05:56]  $path = "$dir/$0" if $0 !~ /^\//;
[22:05:56]
[22:05:56]  if ($dir !~ /^\/usr\/bin$/)
[22:05:56]  {
[22:05:56]      print STDERR "copying aws to /usr/bin/
[22:05:56]";
[22:05:56]      my $aws = load_file($0) or die "installation failed (can't load script)
[22:05:56]";
[22:05:56]      if (-e "/usr/bin/aws")
[22:05:56]      {
[22:05:56]      unlink "/usr/bin/aws" or die "can't unlink old /usr/bin/aws
[22:05:56]";
[22:05:56]      }
[22:05:56]      save_file("/usr/bin/aws", $aws);
[22:05:56]      die "installation failed (can't copy script)
[22:05:56]" unless load_file("/usr/bin/aws") eq $aws;
[22:05:56]      chmod 0555, "/usr/bin/aws";
[22:05:56]      chdir "/usr/bin";
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    chmod 0555, $0;
[22:05:56]    make_links($0);
[22:05:56]    die "installation failed
[22:05:56]";
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]if ($link)
[22:05:56]{
[22:05:56]    die "Usage: .../aws --link[=short|long] [-bare]
[22:05:56]" if $link && @argv;
[22:05:56]
[22:05:56]    make_links($0);
[22:05:56]}
[22:05:56]
[22:05:56]sub make_links
[22:05:56]{
[22:05:56]    my($target) = @_;
[22:05:56]
[22:05:56]    #
[22:05:56]    # Create symlinks to this program named for all available
[22:05:56]    # commands.  Then the script can be invoked as "s3mkdir foo"
[22:05:56]    # rather than "aws mkdir foo".  (Run this command in /usr/bin
[22:05:56]    # or /usr/local/bin.)
[22:05:56]    #
[22:05:56]    # aws -link
[22:05:56]    # symlinks all command names (ec2-delete-group, ec2delgrp, ec2-describe-groups, ec2dgrp, etc.)
[22:05:56]    # aws -link=short
[22:05:56]    # symlinks only the short versions of command names (ec2delgrp, ec2dgrp, etc.)
[22:05:56]    # aws -link=long
[22:05:56]    # symlinks only the long versions of command names (ec2-delete-group, ec2-describe-groups, etc.)
[22:05:56]    #
[22:05:56]    # The -bare option creates symlinks without the ec2 and s3 prefixes
[22:05:56]    # (delete-group, delgrp, etc.).  Be careful using this option, as
[22:05:56]    # commands named "ls", "mkdir", "rmdir", etc. are created.
[22:05:56]
[22:05:56]    for (@cmd)
[22:05:56]    {
[22:05:56]  my($service, $cmd, $action) = @$_;
[22:05:56]
[22:05:56]  for my $fn (split(' ', $cmd))
[22:05:56]  {
[22:05:56]      my($dash) = $fn =~ /(-)/;
[22:05:56]
[22:05:56]      next if $dash && $link eq "short";
[22:05:56]      next if !$dash && $link eq "long";
[22:05:56]
[22:05:56]      $fn = "$service$dash$fn" unless $bare;
[22:05:56]
[22:05:56]      unlink $fn;
[22:05:56]      symlink($target, $fn) or die "$fn: $!
[22:05:56]";
[22:05:56]      #print "symlink $fn --> $target
[22:05:56]";
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    exit;
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]if (!$cmd_data)
[22:05:56]{
[22:05:56]    my $output = "$cmd: unknown command
[22:05:56]" if $cmd;
[22:05:56]    $output .= "Usage: aws ACTION [--help]
[22:05:56]  where ACTION is one of
[22:05:56]";
[22:05:56]    my(%output);
[22:05:56]    for (@cmd)
[22:05:56]    {
[22:05:56]  my($service, $cmd, $action, $param) = @$_;
[22:05:56]  $output{$service} .= " $cmd";
[22:05:56]    }
[22:05:56]    for my $service (sort keys %output)
[22:05:56]    {
[22:05:56]  $output .= "    $service";
[22:05:56]  while ($output{$service} =~ /\s*(.{1,80})(?:\s|$)/g)
[22:05:56]  {
[22:05:56]      my($one) = ($1);
[22:05:56]      $output .= "    " if $output =~ /
[22:05:56]$/;
[22:05:56]      $output .= "        $one
[22:05:56]";
[22:05:56]  }
[22:05:56]    }
[22:05:56]    $output .= "aws versions: (ec2 $ec2_version, sqs $sqs_version, elb $elb_version, sdb $sdb_version)
[22:05:56]";
[22:05:56]    die $output;
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]{
[22:05:56]    my($service, $cmd, $action, $param) = @$cmd_data;
[22:05:56]
[22:05:56]    if ($h)
[22:05:56]    {
[22:05:56]  my $help = "Usage: aws $cmd";
[22:05:56]  for (@$param)
[22:05:56]  {
[22:05:56]      my($aa, $key, $default) = @$_;
[22:05:56]
[22:05:56]      my(@help);
[22:05:56]      my @aa = split(/\s+/, $aa);
[22:05:56]      @aa = "" unless @aa;
[22:05:56]      for my $a (@aa)
[22:05:56]      {
[22:05:56]      my $x = "-$a " if $a;
[22:05:56]      $x = "--$a " if length($a) > 1;
[22:05:56]
[22:05:56]      my($name, $N) = $key =~ /^(.*?)(N?)$/;
[22:05:56]      my $ddd = "..." if $N eq "N";
[22:05:56]      if ($key =~ /\.N\./)
[22:05:56]      {
[22:05:56]          ($name) = $key =~ /.*\.(.*)$/;
[22:05:56]          $ddd = "...";
[22:05:56]      }
[22:05:56]      my $def = " ($default)" if $default;
[22:05:56]
[22:05:56]      push @help, "$x$name$ddd$def";
[22:05:56]      }
[22:05:56]      $help .= " [" . join("|", @help) . "]";
[22:05:56]  }
[22:05:56]  $help .= " BUCKET[/OBJECT] [SOURCE]" if $service eq "s3";
[22:05:56]  $help .= "
[22:05:56]";
[22:05:56]  print STDERR $help;
[22:05:56]  exit;
[22:05:56]    }
[22:05:56]
[22:05:56]
[22:05:56]    my($result);
[22:05:56]
[22:05:56]    if ($service eq "ec2" || $service eq "sqs" || $service eq "elb" || $service eq "sdb" || $service eq "iam" || $service eq "pa")
[22:05:56]    {
[22:05:56]  #print STDERR "(@{[join(', ', @argv)]})
[22:05:56]" if $v;
[22:05:56]
[22:05:56]  my(%count);
[22:05:56]
[22:05:56]  my @list = (Action => $action);
[22:05:56]
[22:05:56]  for (my $i = 0; $i < @argv; $i++)
[22:05:56]  {
[22:05:56]      my($b);
[22:05:56]
[22:05:56]      if ($argv[$i] =~ /^--?(.*)$/)
[22:05:56]      {
[22:05:56]      ($b) = ($1);
[22:05:56]      ++$i;
[22:05:56]      }
[22:05:56]
[22:05:56]      # The Amazon tools have special cases in them too
[22:05:56]      $list[1] = "GetGroupPolicy" if $action eq ListGroupPolicies && $b eq "p";
[22:05:56]      $list[1] = "GetUserPolicy" if $action eq ListUserPolicies && $b eq "p";
[22:05:56]
[22:05:56]      #
[22:05:56]      # find the right param
[22:05:56]      #
[22:05:56]      for (@$param)
[22:05:56]      {
[22:05:56]      my($a, $key, $default, $cref) = @$_;
[22:05:56]      # A leading space in $a is significant, so careful with split()...
[22:05:56]      next unless length($a) == 0 && length($b) == 0 || grep /^$b$/, split(/\s+/, $a);
[22:05:56]      my $data = $argv[$i];
[22:05:56]      my $count = ++$count{$a};
[22:05:56]      if ($key)
[22:05:56]      {
[22:05:56]          $key =~ s/N$/\.$count/;
[22:05:56]          $key =~ s/\.N\./\.$count\./;
[22:05:56]          $data = $cref->($data) if $cref;
[22:05:56]          push @list, $key => $data;
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]          $data = $cref->($data);
[22:05:56]          for (my $i = 0; $i < @$data; $i += 2)
[22:05:56]          {
[22:05:56]          my $key = $data->[$i];
[22:05:56]          $key =~ s/N$/\.$count/;
[22:05:56]          $key =~ s/\.N\./\.$count\./;
[22:05:56]          push @list, $key => $data->[$i + 1];
[22:05:56]          }
[22:05:56]      }
[22:05:56]      last;
[22:05:56]      }
[22:05:56]  }
[22:05:56]
[22:05:56]  # add the defaults
[22:05:56]  for (@$param)
[22:05:56]  {
[22:05:56]      my($a, $key, $default, $cref) = @$_;
[22:05:56]      if ($default && $count{$a} == 0)
[22:05:56]      {
[22:05:56]      my $count = ++$count{$a};
[22:05:56]      if ($key)
[22:05:56]      {
[22:05:56]          $key =~ s/N$/\.$count/;
[22:05:56]          $key =~ s/\.N\./\.$count\./;
[22:05:56]          $default = $cref->($data) if $cref;
[22:05:56]          push @list, $key => $default;
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]          my $data = $cref->($default);
[22:05:56]          for (my $i = 0; $i < @$data; $i += 2)
[22:05:56]          {
[22:05:56]          my $key = $data->[$i];
[22:05:56]          $key =~ s/N$/\.$count/;
[22:05:56]          $key =~ s/\.N\./\.$count\./;
[22:05:56]          push @list, $key => $data->[$i + 1];
[22:05:56]          }
[22:05:56]      }
[22:05:56]      }
[22:05:56]  }
[22:05:56]
[22:05:56]  push @list, @final_list;
[22:05:56]  print STDERR "ec2(@{[join(', ', @list)]})
[22:05:56]" if $v;
[22:05:56]
[22:05:56]  if ($service eq "pa")
[22:05:56]  {
[22:05:56]      $result = pa(@list);
[22:05:56]  }
[22:05:56]  else
[22:05:56]  {
[22:05:56]      $result = ec2($service, @list);
[22:05:56]  }
[22:05:56]    }
[22:05:56]    elsif ($service eq "s3")
[22:05:56]    {
[22:05:56]  my(@file, @head);
[22:05:56]
[22:05:56]  for (@argv)
[22:05:56]  {
[22:05:56]      if (/^(?:x-amz-|Cache-|Content-|Expires:|If-|Range:)/i)
[22:05:56]      {
[22:05:56]      push @head, $_;
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]      push @file, $_;
[22:05:56]      }
[22:05:56]  }
[22:05:56]
[22:05:56]  my $bucket = shift @file;
[22:05:56]
[22:05:56]  if ($action eq DMO)
[22:05:56]  {
[22:05:56]      my($temp_fh, $temp_fn) = tempfile(UNLINK => 1);
[22:05:56]      print $temp_fh "<Delete>
[22:05:56]";
[22:05:56]      print $temp_fh "    <Quiet>true</Quiet>
[22:05:56]" if $quiet;
[22:05:56]
[22:05:56]      die "missing object: specifify one or more objects to delete
[22:05:56]" if @file == 0;
[22:05:56]
[22:05:56]      for (@file)
[22:05:56]      {
[22:05:56]      if (/^-$/)
[22:05:56]      {
[22:05:56]          for (split(" ", load_file($_)))
[22:05:56]          {
[22:05:56]          print $temp_fh "    <Object><Key>$_</Key></Object>
[22:05:56]";
[22:05:56]          }
[22:05:56]          next;
[22:05:56]      }
[22:05:56]      print $temp_fh "    <Object><Key>$_</Key></Object>
[22:05:56]";
[22:05:56]      }
[22:05:56]
[22:05:56]      print $temp_fh "</Delete>
[22:05:56]";
[22:05:56]      $temp_fh->flush;
[22:05:56]
[22:05:56]      system "cat $temp_fn" if $v;
[22:05:56]
[22:05:56]      $action = PUT;
[22:05:56]      $md5 = 1;
[22:05:56]      $bucket .= "?delete";
[22:05:56]      @file = $temp_fn;
[22:05:56]
[22:05:56]      print "bucket = $bucket
[22:05:56]file = $file
[22:05:56]action = $action
[22:05:56]" if $v;
[22:05:56]  }
[22:05:56]
[22:05:56]  my $file = shift @file;
[22:05:56]  warn "ignored: @file
[22:05:56]" if @file;
[22:05:56]
[22:05:56]  my $MB5 = 5 * 1024 * 1024;
[22:05:56]  my $GB5 = 1024 * $MB5;
[22:05:56]  my $SZ = -s $file;
[22:05:56]
[22:05:56]  if ($action eq PUT && ($parts || $bucket !~ /\?/ && $SZ > $GB5))
[22:05:56]  {
[22:05:56]      $bucket =~ s/^([^\?\/]+)(\?|$ )/$1\/$2/xs; # turn abc or abc? into abc/ or abc/?
[22:05:56]      $bucket .= $file if $bucket =~ /\/$/;
[22:05:56]
[22:05:56]      # delete previous partial multi-part uploads
[22:05:56]      for (1..10)
[22:05:56]      {
[22:05:56]      print "deleting multipart uploads $bucket...
[22:05:56]" if $v;
[22:05:56]      my $xml = s3(DELETE, undef, "$bucket?upload");
[22:05:56]      if ($xml)
[22:05:56]      {
[22:05:56]          print $xml if $v;
[22:05:56]          last;
[22:05:56]      }
[22:05:56]      }
[22:05:56]
[22:05:56]      $parts = int(($SZ + $GB5 - 1) / $GB5) unless $parts > 1;
[22:05:56]      my $slice = int(($SZ + $parts - 1) / $parts);
[22:05:56]      if ($slice < $MB5 && $parts > 1)
[22:05:56]      {
[22:05:56]      $parts = int(($SZ + $MB5 - 1) / $MB5);
[22:05:56]      $slice = $MB5;
[22:05:56]      print STDERR "multipart upload: Too many parts makes slice too small; adjusting to $parts parts
[22:05:56]";
[22:05:56]      }
[22:05:56]      my($uploadId) = s3(POST, undef, "$bucket?uploads", undef, @head) =~ /<UploadId>(.*?)<\/UploadId>/;
[22:05:56]      print "uploadId = $uploadId
[22:05:56]" if $v;
[22:05:56]      die "missing uploadId
[22:05:56]" if !$uploadId;
[22:05:56]      for (my $i = 0; $i < $parts; $i++)
[22:05:56]      {
[22:05:56]      my $beg = $i * $slice + 1;
[22:05:56]      my $end = $beg + $slice - 1;
[22:05:56]      $end = $SZ if $end > $SZ;
[22:05:56]      local $content_length = $end - $beg + 1;
[22:05:56]      local($exit_code);
[22:05:56]      for my $iter (0..$retry)
[22:05:56]      {
[22:05:56]          print "failed to upload partNumber=@{[$i + 1]}... retrying #$iter of $retry...
[22:05:56]" if $iter && !$fail;
[22:05:56]          undef $exit_code;
[22:05:56]          my $cmd = "tail -c +$beg $file |head -c $content_length";
[22:05:56]          print "$cmd (bytes)
[22:05:56]" if $v;
[22:05:56]          open STDIN, "$cmd|" or die "part @{[$i + 1]}: $!";
[22:05:56]          s3(PUT, undef, "$bucket?partNumber=@{[$i + 1]}&uploadId=$uploadId", "-");
[22:05:56]          last unless $exit_code == 23;
[22:05:56]      }
[22:05:56]      if ($exit_code)
[22:05:56]      {
[22:05:56]          print "failed to upload partNumber=@{[$i + 1]}
[22:05:56]" if !$fail;
[22:05:56]          s3(DELETE, undef, "$bucket?uploadId=$uploadId");
[22:05:56]          exit $exit_code;
[22:05:56]      }
[22:05:56]      }
[22:05:56]      s3(POST, undef, "$bucket?uploadId=$uploadId");
[22:05:56]  }
[22:05:56]  else
[22:05:56]  {
[22:05:56]      my($last_marker, $marker);
[22:05:56]
[22:05:56]      for (;;)
[22:05:56]      {
[22:05:56]      my $r = s3($action, $marker, $bucket, $file, @head);
[22:05:56]      if ($r !~ /^<\?xml/)
[22:05:56]      {
[22:05:56]          print $r;
[22:05:56]          exit;
[22:05:56]      }
[22:05:56]      $r =~ s/<\?xml.*?>
[22:05:56]?\s*//;
[22:05:56]      $result .= $r;
[22:05:56]      ($marker) = $r =~ /.*<Key>(.*?)<\/Key>/;
[22:05:56]      last if $r !~ /<IsTruncated>true<\/IsTruncated>/ || $marker le $last_marker;
[22:05:56]      $last_marker = $marker;
[22:05:56]      }
[22:05:56]  }
[22:05:56]    }
[22:05:56]    elsif ($service eq "r53")  # which has its own different approach
[22:05:56]    {
[22:05:56]  my $idraw = shift @argv;
[22:05:56]  my ($id) = $idraw =~ /([A-Z0-9]+)/;  # lose any /hostedzone/ or /change/ prefix
[22:05:56]  my ($pname, $aname) = @{ $param->[0] };
[22:05:56]  shift @$param unless $pname;
[22:05:56]  my $r53_endpoint = 'route53.amazonaws.com';
[22:05:56]  my $url="https://$r53_endpoint/$r53_version/"; 
[22:05:56]  my ($method,$reqaction) = split(/\|/, $action);
[22:05:56]  die "No method (action = '$action') for $cmd." unless $method;
[22:05:56]  my (%prefix) = (zone_id => 'hostedzone',
[22:05:56]          change_id => 'change');
[22:05:56]  $url .= "$prefix{$aname}/$id" if $prefix{$aname};  # /hostedzone/xxx or /change/xxx 
[22:05:56]  $url .= "/$reqaction" if $reqaction;
[22:05:56]  $url .= "?" if $method eq 'GET';
[22:05:56]  my %args;
[22:05:56]  my $content;
[22:05:56]  while (@argv)
[22:05:56]  {
[22:05:56]      my $key = shift @argv;
[22:05:56]      my ($key1, $val1, $key2) = $key =~ /--(\w+)=(.*)|-(\w+)/;
[22:05:56]      $key1 ||= $key2;
[22:05:56]      $val1 ||= shift(@argv);
[22:05:56]      for (@$param)
[22:05:56]      {
[22:05:56]      my ($paramkey, $urlkey) = @$_;
[22:05:56]      next unless  $paramkey =~ /(\s+|^)$key1(\s+|$)/;
[22:05:56]      $args{$urlkey} = $val1;
[22:05:56]      last;
[22:05:56]      }
[22:05:56]  }
[22:05:56]  my (@days)=(qw(Sun Mon Tue Wed Thu Fri Sat));
[22:05:56]  my (@months)=(qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
[22:05:56]  my ($sec, $min, $hour, $mday, $mon, $year, $dow, undef, undef) = gmtime(time + $time_offset);
[22:05:56]  my $zulu = sprintf ("%s, %02d %s %04d %02d:%02d:%02d GMT",
[22:05:56]              $days[$dow], $mday, $months[$mon], 1900 + $year, $hour, $min, $sec);
[22:05:56]  my $algo = 'HmacSHA' . ($sha1 ? '1' : '256');
[22:05:56]  my $sig = sign ($zulu, $algo);
[22:05:56]  my $auth = "AWS3-HTTPS AWSAccessKeyId=$awskey,Algorithm=$algo,Signature=$sig";
[22:05:56]  my @curl = ('-H' => "'X-Amzn-Authorization: $auth'",
[22:05:56]          '-H' => "'x-amz-date: $zulu'" );
[22:05:56]  push (@curl, '-H' => "x-amz-security-token:$session") if $session;
[22:05:56]  
[22:05:56]  my $cmd;
[22:05:56]  if ($method eq 'GET')
[22:05:56]  {
[22:05:56]      $url .= join ('&', map { encode_url($_)."=".encode_url($args{$_}) }
[22:05:56]            grep { ! /^__/ } sort keys %args);
[22:05:56]  }
[22:05:56]  elsif ($method eq 'PUT')
[22:05:56]  {
[22:05:56]      die "can't put yet";
[22:05:56]  }
[22:05:56]  elsif ($method eq 'DELETE')
[22:05:56]  {
[22:05:56]      # nothing special to do in this case.  URL is set up.
[22:05:56]      push (@curl, '-X' => $method); # must make it use this method.
[22:05:56]  }
[22:05:56]  else  # method must be POST 
[22:05:56]  {
[22:05:56]      my $hdr = R53_xml_data() -> {'header'};
[22:05:56]      my $xmlsrc = R53_xml_data() -> {$action};
[22:05:56]      for (keys %args) {
[22:05:56]      my $val = $args{$_};
[22:05:56]      $xmlsrc =~ s/(<$_>)/$1$val/;
[22:05:56]      }
[22:05:56]      $xmlsrc =~ s/'/'\''/g;
[22:05:56]      push (@curl, '--data' => "'$hdr$xmlsrc'");
[22:05:56]      push (@curl, '-H' => "'Content-type: text/xml'");
[22:05:56]  }
[22:05:56]
[22:05:56]  $cmd = qq[$curl $curl_options @curl $url];
[22:05:56]
[22:05:56]  print "$cmd
[22:05:56]" if $v;
[22:05:56]  $result = qx[$cmd];
[22:05:56]  print "$resp
[22:05:56]" if $v;
[22:05:56]  
[22:05:56]    }
[22:05:56]    else
[22:05:56]    {
[22:05:56]  die;
[22:05:56]    }
[22:05:56]
[22:05:56]    if ($xml)
[22:05:56]    {
[22:05:56]  print xmlpp($result);
[22:05:56]    }
[22:05:56]    elsif ($yaml)
[22:05:56]    {
[22:05:56]        print xml2yaml($result);
[22:05:56]    }
[22:05:56]    elsif ($json)
[22:05:56]    {
[22:05:56]        print xml2json($result);
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<ListBucketResult|<ListAllMyBucketsResult/ && ($l || $d1 || $exec || $simple))
[22:05:56]    {
[22:05:56]  #   <ListAllMyBucketsResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
[22:05:56]        # <Owner>
[22:05:56]  #       <ID>c1438ce900acb0db547b3708dc29ca60370d8174ee55305050d2990dcf27109c</ID>
[22:05:56]  #       <DisplayName>timkay681</DisplayName>
[22:05:56]        # </Owner>
[22:05:56]        # <Buckets>
[22:05:56]  #       <Bucket>
[22:05:56]  #           <Name>3.14</Name>
[22:05:56]  #           <CreationDate>2007-03-04T22:29:34.000Z</CreationDate>
[22:05:56]  #       </Bucket>
[22:05:56]  #
[22:05:56]
[22:05:56]  #   <ListBucketResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
[22:05:56]  #       <Name>boopsielog</Name>
[22:05:56]  #       <Prefix></Prefix>
[22:05:56]  #       <Marker></Marker>
[22:05:56]  #       <MaxKeys>1000</MaxKeys>
[22:05:56]  #       <IsTruncated>false</IsTruncated>
[22:05:56]  #       <Contents>
[22:05:56]  #               <Key>ec201-2008-08-20-access.log.gz</Key>
[22:05:56]  #               <LastModified>2008-08-21T03:01:51.000Z</LastModified>
[22:05:56]  #               <ETag>&quot;baa27b2e8def9acf8c2f3690e230e37a&quot;</ETag>
[22:05:56]  #               <Size>2405563</Size>
[22:05:56]  #               <Owner>
[22:05:56]  #                       <ID>c1438ce900acb0db547b3708dc29ca60370d8174ee55305050d2990dcf27109c</ID>
[22:05:56]  #                       <DisplayName>timkay681</DisplayName>
[22:05:56]  #               </Owner>
[22:05:56]  #               <StorageClass>STANDARD</StorageClass>
[22:05:56]  #       </Contents>
[22:05:56]
[22:05:56]  my $isdir = $result =~ /<ListAllMyBucketsResult/;
[22:05:56]  my($owner1) = $result =~ /<DisplayName>(.*?)<\/DisplayName>/s;
[22:05:56]
[22:05:56]  my(@result);
[22:05:56]
[22:05:56]  my($prefix) = $result =~ /<Prefix>(.*?)<\/Prefix>/;
[22:05:56]
[22:05:56]  while ($result =~ /<(?:Contents|Bucket|CommonPrefixes)>\s*(.*?)\s*<\/(?:Contents|Bucket|CommonPrefixes)>/sg)
[22:05:56]  {
[22:05:56]      my($item) = ($1);
[22:05:56]      my $key = dentity($item =~ /<(?:Key|Name|Prefix)>(.*?)<\/(?:Key|Name|Prefix)>/s);
[22:05:56]      my($size) = $item =~ /<Size>(.*?)<\/Size>/s;
[22:05:56]      my($mod) = $item =~ /<(?:LastModified|CreationDate)>(.*?)<\/(?:LastModified|CreationDate)>/s;
[22:05:56]      my($owner) = $item =~ /<DisplayName>(.*?)<\/DisplayName>/s;
[22:05:56]
[22:05:56]      $key =~ s/^\Q$prefix // if $delimiter;
[22:05:56]
[22:05:56]      for ($mod)
[22:05:56]      {
[22:05:56]      s/T/ /g;
[22:05:56]      s/\.000Z//;
[22:05:56]      }
[22:05:56]
[22:05:56]      push @result, [$item, $key, $size, $mod, $owner || $owner1 || "unknown"];
[22:05:56]  }
[22:05:56]
[22:05:56]  if ($t)
[22:05:56]  {
[22:05:56]      @result = sort {$a->[3] cmp $b->[3]} @result;
[22:05:56]  }
[22:05:56]
[22:05:56]  if ($r)
[22:05:56]  {
[22:05:56]      @result = reverse @result;
[22:05:56]  }
[22:05:56]
[22:05:56]  for (@result)
[22:05:56]  {
[22:05:56]      my($item, $key, $size, $mod, $owner) = (@$_);
[22:05:56]      if ($l)
[22:05:56]      {
[22:05:56]      $key = printable($key);
[22:05:56]      if ($isdir)
[22:05:56]      {
[22:05:56]          print "drwx------  2 $owner   0 $mod $key
[22:05:56]";
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]          printf "-rw-------  1 $owner %10.0f $mod %s
[22:05:56]", $size, $key;
[22:05:56]      }
[22:05:56]      }
[22:05:56]      elsif ($d1)
[22:05:56]      {
[22:05:56]      print "$key
[22:05:56]";
[22:05:56]      }
[22:05:56]      elsif ($simple)
[22:05:56]      {
[22:05:56]      printf "%10.0f  $mod    %s
[22:05:56]", $size, $key;
[22:05:56]      }
[22:05:56]      elsif ($exec)
[22:05:56]      {
[22:05:56]      #local $_ = sprintf "%10.0f $mod    $key
[22:05:56]", $size;
[22:05:56]      #local @_ = ($size, $mod, $key);
[22:05:56]      my($bucket, $prefix) = split(/\//, $argv[0], 2);
[22:05:56]      eval $exec;
[22:05:56]      last if $? & 127; # if the user hits control-c during a system() call...
[22:05:56]      }
[22:05:56]  }
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<CreateKeyPairResponse/)
[22:05:56]    {
[22:05:56]  print $result =~ /<keyMaterial>(.*?)<\/keyMaterial>/s, "
[22:05:56]";
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<GetConsoleOutputResponse/)
[22:05:56]    {
[22:05:56]  print decode_base64($result =~ /<output>(.*?)<\/output>/s);
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<DescribeInstanceAttributeResponse/)
[22:05:56]    {
[22:05:56]  print+ $result =~ /<value>(.*?)<\/value>/, "
[22:05:56]";
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<RunInstancesResponse|<DescribeInstancesResponse|<RequestSpotInstancesResponse|<DescribeSpotInstanceRequestsResponse/ && ($simple || $wait))
[22:05:56]    {
[22:05:56]  if ($result =~ /<RequestSpotInstancesResponse|<DescribeSpotInstanceRequestsResponse/)
[22:05:56]  {
[22:05:56]      for (;;)
[22:05:56]      {
[22:05:56]      my(@instanceId, @spotType, @spotState, @spotPrice);
[22:05:56]
[22:05:56]      while ($result =~ /(<spotInstanceRequestSet.*?<\/spotInstanceRequestSet>)/sg)
[22:05:56]      {
[22:05:56]          my($result) = ($1);
[22:05:56]          while ($result =~ /(<item(?:<item.*?<\/item>|.)*?<\/item>)/sg)
[22:05:56]          {
[22:05:56]          my($result) = ($1);
[22:05:56]          my($instanceId) = $result =~ /<instanceId>(.*?)<\/instanceId>/s;
[22:05:56]          my($spotType) = $result =~ /<type>(.*?)<\/type>/s;
[22:05:56]          my($spotState) = $result =~ /<state>(.*?)<\/state>/s;
[22:05:56]          my($spotPrice) = $result =~ /<spotPrice>(.*?)<\/spotPrice>/s;
[22:05:56]          push @instanceId, $instanceId;
[22:05:56]          push @spotType, $spotType;
[22:05:56]          push @spotState, $spotState;
[22:05:56]          push @spotPrice, $spotPrice;
[22:05:56]          }
[22:05:56]      }
[22:05:56]
[22:05:56]      my($open);
[22:05:56]
[22:05:56]      for (my $i = 0; $i < @instanceId; $i++)
[22:05:56]      {
[22:05:56]          $open += $spotState[$i] eq "open";
[22:05:56]          print "@{[$instanceId[$i] || '        ']}   $spotState[$i]      $spotType[$i]   $spotPrice[$i]
[22:05:56]";
[22:05:56]      }
[22:05:56]
[22:05:56]      print "open = $open
[22:05:56]";
[22:05:56]
[22:05:56]      last unless $wait && $open;
[22:05:56]
[22:05:56]      sleep $wait;
[22:05:56]      $result = qx[$0 --cmd0 --xml --region=$region describe-spot-instance-requests];
[22:05:56]      }
[22:05:56]
[22:05:56]      $result = qx[$0 --cmd0 --xml --region=$region describe-instances @instanceId];
[22:05:56]  }
[22:05:56]
[22:05:56]  for (;;)
[22:05:56]  {
[22:05:56]      my(@instanceId, @instanceState, @dnsName, @groupId);
[22:05:56]      my($groupId) = $result =~ /<groupId>(.*?)<\/groupId>/;
[22:05:56]
[22:05:56]      while ($result =~ /(<instancesSet.*?<\/instancesSet>)/sg)
[22:05:56]      {
[22:05:56]      my($result) = ($1);
[22:05:56]      while ($result =~ /(<item(?:<item.*?<\/item>|.)*?<\/item>)/sg)
[22:05:56]      {
[22:05:56]          my($result) = ($1);
[22:05:56]          my($instanceId) = $result =~ /<instanceId>(.*?)<\/instanceId>/s;
[22:05:56]          my($instanceState) = map {/<name>(.*?)<\/name>/s} $result =~ /<instanceState>(.*?)<\/instanceState>/s;
[22:05:56]          my($dnsName) = $result =~ /<dnsName>(.*?)<\/dnsName>/s;
[22:05:56]          push @instanceId, $instanceId;
[22:05:56]          push @instanceState, $instanceState;
[22:05:56]          push @dnsName, $dnsName;
[22:05:56]          push @groupId, $groupId;
[22:05:56]      }
[22:05:56]      }
[22:05:56]
[22:05:56]      my($pending);
[22:05:56]
[22:05:56]      for (my $i = 0; $i < @instanceId; $i++)
[22:05:56]      {
[22:05:56]      $pending += $instanceState[$i] eq "pending";
[22:05:56]      print "$instanceId[$i]  $instanceState[$i]  $dnsName[$i]    $groupId[$i]
[22:05:56]";
[22:05:56]      }
[22:05:56]
[22:05:56]      last unless $wait && $pending;
[22:05:56]
[22:05:56]      sleep $wait;
[22:05:56]      $result = qx[$0 --cmd0 --xml --region=$region describe-instances @instanceId];
[22:05:56]  }
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<ListQueuesResult/)
[22:05:56]    {
[22:05:56]  if ($simple)
[22:05:56]  {
[22:05:56]      while ($result =~ /<QueueUrl>(.*?)<\/QueueUrl>/g)
[22:05:56]      {
[22:05:56]      my($q) = ($1);
[22:05:56]      $q =~ s/^https?:\/\/.*?(?=\/)//;
[22:05:56]      print "$q
[22:05:56]";
[22:05:56]      }
[22:05:56]  }
[22:05:56]  else
[22:05:56]  {
[22:05:56]      print ary2tab(xml2ary(ListQueuesResult, $result), {title => "Queue URLs", empty => "no queues
[22:05:56]"});
[22:05:56]  }
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<GetQueueAttributesResponse/ && $simple)
[22:05:56]    {
[22:05:56]  while ($result =~ /<Attribute>(.*?)<\/Attribute>/sg)
[22:05:56]  {
[22:05:56]      if ($1 =~ /<Name>(.*?)<\/Name>.*?<Value>(.*?)<\/Value>/s)
[22:05:56]      {
[22:05:56]      print "$1   $2
[22:05:56]";
[22:05:56]      }
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    elsif ($result =~ /<ListDomainsResponse/)
[22:05:56]    {
[22:05:56]  my $ary = xml2ary(ListDomainsResult, $result);
[22:05:56]  if ($d1)
[22:05:56]  {
[22:05:56]      for (@$ary)
[22:05:56]      {
[22:05:56]      print $_->[1], "
[22:05:56]";
[22:05:56]      }
[22:05:56]  }
[22:05:56]  else
[22:05:56]  {
[22:05:56]      print ary2tab([@$ary]);
[22:05:56]  }
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<GetAttributesResponse/ && $d1)
[22:05:56]    {
[22:05:56]  while ($result =~ /<Attribute>(.*?)<\/Attribute>/sg)
[22:05:56]  {
[22:05:56]      my($name, $value) = $1 =~ /<Name>(.*?)<\/Name>\s*<Value>(.*?)<\/Value>/s;
[22:05:56]      print "$name    $value
[22:05:56]";
[22:05:56]  }
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<SelectResponse/ && ($simple || $d1))
[22:05:56]    {
[22:05:56]  while ($result =~ /<Item>(.*?)<\/Item>/sg)
[22:05:56]  {
[22:05:56]      my($item, $attr) = $1 =~ /<Name>(.*?)<\/Name>(.*)/;
[22:05:56]      while ($attr =~ /<Name>(.*?)<\/Name>\s*<Value>(.*?)<\/Value>/sg)
[22:05:56]      {
[22:05:56]      print "$item    $1  $2
[22:05:56]";
[22:05:56]      }
[22:05:56]  }
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<ReceiveMessageResult/)
[22:05:56]    {
[22:05:56]  if ($exec)
[22:05:56]  {
[22:05:56]      print xmlpp($result) if $v;
[22:05:56]      my($handle) = $result =~ /<ReceiptHandle>(.*?)<\/ReceiptHandle>/;
[22:05:56]      my $body = decode_url($result =~ /<Body>(.*?)<\/Body>/);
[22:05:56]      if ($handle && $body)
[22:05:56]      {
[22:05:56]      $exec = 'system "$body"' if $exec == 1;
[22:05:56]      my $rc = eval $exec;
[22:05:56]      if ($rc)
[22:05:56]      {
[22:05:56]          print "exec evaluated to non-zero ($rc): message not deleted from queue
[22:05:56]";
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]          my $cmd = qq[$0 dm $argv[0] --handle $handle];
[22:05:56]          print "$cmd
[22:05:56]" if $v;
[22:05:56]          my $dm = qx[$cmd];
[22:05:56]          print "$dm
[22:05:56]" if $v;
[22:05:56]      }
[22:05:56]      }
[22:05:56]  }
[22:05:56]  else
[22:05:56]  {
[22:05:56]      my $ary = xml2ary(Message, $result);
[22:05:56]      if ($simple)
[22:05:56]      {
[22:05:56]      my($id, $handle, $md5, $body);
[22:05:56]      for (@$ary)
[22:05:56]      {
[22:05:56]          $id = $_->[1] if $_->[0] eq MessageId;
[22:05:56]          $handle = $_->[1] if $_->[0] eq ReceiptHandle;
[22:05:56]          $md5 = $_->[1] if $_->[0] eq MD5OfBody;
[22:05:56]          $body = decode_url($_->[1]) if $_->[0] eq Body;
[22:05:56]      }
[22:05:56]      print "$handle  $body   $id $md5
[22:05:56]" if $handle;
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]      print ary2tab($ary, {title => "Messages", empty => "no messages
[22:05:56]"});
[22:05:56]      }
[22:05:56]  }
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<SendMessageResponse/ && $simple)
[22:05:56]    {
[22:05:56]  my($md5) = $result =~ /<MD5OfMessageBody>(.*?)<\/MD5OfMessageBody>/;
[22:05:56]  my($id) = $result =~ /<MessageId>(.*?)<\/MessageId>/;
[22:05:56]  print "$md5 $id
[22:05:56]";
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<(?:GetGroupPolicyResponse|GetUserPolicyResponse)/)
[22:05:56]    {
[22:05:56]  my($doc) = $result =~ /<PolicyDocument>(.*?)<\/PolicyDocument>/s;
[22:05:56]  $doc =~ s/%(..)/pack(H2,$1)/ge;
[22:05:56]  print $doc;
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<(?:ListUserPoliciesResponse)/)
[22:05:56]    {
[22:05:56]  my @member = $result =~ /<member>(.*?)<\/member>/g;
[22:05:56]  print join("
[22:05:56]", @member, undef);
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<GetQueueAttributesResponse/)
[22:05:56]    {
[22:05:56]  print ary2tab(xml2ary(GetQueueAttributesResult, $result, {key => Name, value => Value}), {title => "Attributes", empty => "no attributes
[22:05:56]"});
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<DescribeTagsResponse|<DescribeKeyPairsResponse/ && $simple)
[22:05:56]    {
[22:05:56]  while ($result =~ /<item>(.*?)<\/item>/sg)
[22:05:56]  {
[22:05:56]      my($item) = ($1);
[22:05:56]      my(@item);
[22:05:56]      while ($item =~ /<(.*?)>(.*?)<\/\1>/g)
[22:05:56]      {
[22:05:56]      push @item, $2;
[22:05:56]      }
[22:05:56]      print join("    ", @item), "
[22:05:56]";
[22:05:56]  }
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<ListGroupsResponse|GetGroupResponse|ListUsersResponse|ListAccessKeysResponse/ && $simple)
[22:05:56]    {
[22:05:56]  print map {join("   ", @$_) . "
[22:05:56]"} @{xml2Dary("member", $result)};
[22:05:56]    }
[22:05:56]    elsif ($result =~ /<ListGroupPoliciesResponse/ && $simple)
[22:05:56]    {
[22:05:56]  print map {join("   ", @$_) . "
[22:05:56]"} @{xml2Dary("PolicyNames", $result)};
[22:05:56]    }
[22:05:56]    else
[22:05:56]    {
[22:05:56]  print xml2tab($result) || xmlpp($result);
[22:05:56]    }
[22:05:56]
[22:05:56]    exit $exit_code;
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]sub xml2Dary
[22:05:56]{
[22:05:56]    my($tag, $result, $param, @result) = @_;
[22:05:56]    my(@key);
[22:05:56]    while ($result =~ /<$tag.*?>(.*?)<\/$tag>/sg)
[22:05:56]    {
[22:05:56]  my($elt) = ($1);
[22:05:56]  my(@val);
[22:05:56]  while ($elt =~ /<(.*?)>(.*?)<\/\1>/sg)
[22:05:56]  {
[22:05:56]      my($key, $val) = ($1, $2);
[22:05:56]      push @key, $key if !@result;
[22:05:56]      push @val, $val;
[22:05:56]  }
[22:05:56]  push @result, \@key if !@result && $param->{head};
[22:05:56]  push @result, \@val;
[22:05:56]    }
[22:05:56]    \@result;
[22:05:56]}
[22:05:56]
[22:05:56]sub xml2ary
[22:05:56]{
[22:05:56]    my($tag, $result, $param, @result) = @_;
[22:05:56]    for ($result =~ /<$tag.*?>(.*?)<\/$tag>/sg)
[22:05:56]    {
[22:05:56]  while (/<(.*?)>(.*?)<\/\1>/sg)
[22:05:56]  {
[22:05:56]      my($key, $val1) = ($1, $2);
[22:05:56]      my($val);
[22:05:56]      while ($val1 =~ /<(.+?)>(.*?)<\/\1>/sg)
[22:05:56]      {
[22:05:56]      if ($1 eq $param->{key})
[22:05:56]      {
[22:05:56]          $key = $2;
[22:05:56]      }
[22:05:56]      elsif ($1 eq $param->{value})
[22:05:56]      {
[22:05:56]          $val = $2;
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]          $val .= " " if $val;
[22:05:56]          $val .= "$1=$2";
[22:05:56]      }
[22:05:56]      }
[22:05:56]      $val = $val1 unless length($val);
[22:05:56]      push @result, [$key, $val];
[22:05:56]  }
[22:05:56]    }
[22:05:56]    \@result;
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]sub ary2tab
[22:05:56]{
[22:05:56]    my($ary, $param) = @_;
[22:05:56]    return $param->{empty} if exists $param->{empty} && !@$ary;
[22:05:56]    my(@width);
[22:05:56]    for (@$ary)
[22:05:56]    {
[22:05:56]  if (ref $_ eq SCALAR)
[22:05:56]  {
[22:05:56]      $_ = [$_];
[22:05:56]  }
[22:05:56]
[22:05:56]  if (ref $_ eq ARRAY)
[22:05:56]  {
[22:05:56]      for (my $i = 0; $i < @$_; $i++)
[22:05:56]      {
[22:05:56]      $width[$i] = length($_->[$i]) if $width[$i] < length($_->[$i]);
[22:05:56]      }
[22:05:56]  }
[22:05:56]    }
[22:05:56]    if ($param->{title})
[22:05:56]    {
[22:05:56]  my $width = -1;
[22:05:56]  $width += 2 + $_ for @width;
[22:05:56]  my $l = int(($width - length($param->{title})) / 2);
[22:05:56]  my $r = $width - length($param->{title}) - $l;
[22:05:56]  $output .= "+" . "-" x (@width - 1);
[22:05:56]  $output .= "-" x (2 + $_) for @width;
[22:05:56]  $output .= "+
[22:05:56]";
[22:05:56]  $output .= "| " . " " x $l . $param->{title} . " " x $r  . " |
[22:05:56]";
[22:05:56]    }
[22:05:56]    $output .= "+" . "-" x (2 + $_) for @width;
[22:05:56]    $output .= "+
[22:05:56]";
[22:05:56]    for (@$ary)
[22:05:56]    {
[22:05:56]  for (my $i = 0; $i < @width; $i++)
[22:05:56]  {
[22:05:56]      $output .= "| " . $_->[$i] . " " x (1 + $width[$i] - length($_->[$i]));
[22:05:56]  }
[22:05:56]  $output .= "|
[22:05:56]";
[22:05:56]    }
[22:05:56]    $output .= "+" . "-" x (2 + $_) for @width;
[22:05:56]    $output .= "+
[22:05:56]";
[22:05:56]}
[22:05:56]
[22:05:56]
[22:05:56]sub xml2tab
[22:05:56]{
[22:05:56]    my($xml) = @_;
[22:05:56]    my($output);
[22:05:56]    $xml =~ s/^<\?xml.*?>(
[22:05:56]?
[22:05:56])*//;
[22:05:56]    my @xml = grep !/^\s*$/, split(/(<.*?>)/, $xml);
[22:05:56]    my(@tag, @depth);
[22:05:56]    my $depth = 0;
[22:05:56]    for (my $i = 0; $i < @xml; $i++)
[22:05:56]    {
[22:05:56]  if ($xml[$i] =~ /^<(\w+)\/>$/)
[22:05:56]  {
[22:05:56]      next;
[22:05:56]  }
[22:05:56]  elsif ($xml[$i] =~ /^<(\w+)/)
[22:05:56]  {
[22:05:56]      my($tag) = ($1);
[22:05:56]      $tag[$i] = $tag;
[22:05:56]      $depth[$i] = ++$depth;
[22:05:56]  }
[22:05:56]  elsif ($xml[$i] =~ /^<\/(\w+)/)
[22:05:56]  {
[22:05:56]      my($tag) = ($1);
[22:05:56]      for (my $j = $i - 1; $j >= 0; $j--)
[22:05:56]      {
[22:05:56]      next if $depth[$j] > $depth;
[22:05:56]      next if $tag[$j] ne $tag;
[22:05:56]      $depth = $depth[$j] - 1;
[22:05:56]      last;
[22:05:56]      }
[22:05:56]  }
[22:05:56]  else
[22:05:56]  {
[22:05:56]      $tag[$i] = $xml[$i];
[22:05:56]      $depth[$i] = 99;
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    my(@parent, $depth, %head, @head, @table, $col);
[22:05:56]
[22:05:56]    my $skipre = qr/^(?:amiLaunchIndex|ETag|HostId|ipPermissions|Owner)$/;
[22:05:56]
[22:05:56]    for (my $i = 0; $i <= @xml; $i++)
[22:05:56]    {
[22:05:56]  $parent[$depth[$i]] = $tag[$i];
[22:05:56]
[22:05:56]  if (@head && $i == @xml || $depth[$i] && $depth[$i] < $depth)
[22:05:56]  {
[22:05:56]      unless (@head == 1 && $head[0] eq "RequestId")
[22:05:56]      {
[22:05:56]      for (@table)
[22:05:56]      {
[22:05:56]          $_ =ap {printable(dentity($_))} @$_{@head}];
[22:05:56]      }
[22:05:56]
[22:05:56]      unshift @table, [@head];
[22:05:56]
[22:05:56]      my(@width);
[22:05:56]
[22:05:56]      for (@table)
[22:05:56]      {
[22:05:56]          for (my $i = 0; $i < @head; $i++)
[22:05:56]          {
[22:05:56]          my $length = length($_->[$i]);
[22:05:56]          $width[$i] = $length if $width[$i] < $length;
[22:05:56]          }
[22:05:56]      }
[22:05:56]
[22:05:56]      my $sep = "+";
[22:05:56]
[22:05:56]      for (my $i = 0; $i < @head; $i++)
[22:05:56]      {
[22:05:56]          next if $head[$i] =~ /$skipre/;
[22:05:56]          $sep .= "-" x (2 + $width[$i]) . "+";
[22:05:56]      }
[22:05:56]
[22:05:56]      for (my $j = 0; $j < @table; $j++)
[22:05:56]      {
[22:05:56]          $output .= "$sep
[22:05:56]" if $j < 2;
[22:05:56]
[22:05:56]          for (my $i = 0; $i < @head; $i++)
[22:05:56]          {
[22:05:56]          next if $head[$i] =~ /$skipre/;
[22:05:56]          my $len = length($table[$j]->[$i]);
[22:05:56]          my $pad = $width[$i] - $len;
[22:05:56]          my $l = 1 + int($pad / 2);  # center justify
[22:05:56]          $l = 1 if $j;           # left justify all but first row
[22:05:56]          my $r = 2 + $pad - $l;
[22:05:56]          $output .= "|" . " " x $l . $table[$j]->[$i] . " " x $r;
[22:05:56]          }
[22:05:56]          $output .= "|
[22:05:56]";
[22:05:56]      }
[22:05:56]
[22:05:56]      $output .= "$sep
[22:05:56]";
[22:05:56]      }
[22:05:56]
[22:05:56]      $depth = 0;
[22:05:56]      %head = ();
[22:05:56]      @head = ();
[22:05:56]      @table = ();
[22:05:56]  }
[22:05:56]
[22:05:56]  my $tag2 = "$parent[$depth[$i] - 1]-$tag[$i]";
[22:05:56]
[22:05:56]  if ($tag[$i] =~ /^(?:LocationConstraint|Grant
[22:05:56]             |AttachVolumeResponse|Bucket|Contents|CommonPrefixes|AuthorizeSecurityGroupIngressResponse|CopyObjectResult
[22:05:56]             |CreateKeyPairResponse|CreateSecurityGroupResponse|CreateImageResponse|CreateSnapshotResponse|CreateVolumeResponse
[22:05:56]             |DeleteSecurityGroupResponse|DeleteKeyPairResponse|DeleteSnapshotResponse|DeleteVolumeResponse
[22:05:56]             |DetachVolumeResponse|Error|GetConsoleOutputResponse|ListBucketResult|RebootInstancesResponse
[22:05:56]             |RevokeSecurityGroupIngressResponse|AllocateAddressResponse|ReleaseAddressResponse|AssociateAddressResponse|DescribeRegionsResponse
[22:05:56]             |CreateQueueResponse|ResponseMetadata|DescribeSnapshotAttributeResponse|ModifySnapshotAttributeResponse|ResetSnapshotAttributeResponse
[22:05:56]             |CreateLoadBalancerResponse|DeleteLoadBalancerResponse
[22:05:56]             |DescribeSpotInstanceRequestsResponse|CancelSpotInstanceRequestsResponse|RequestSpotInstancesResponse|DescribeSpotPriceHistoryResponse
[22:05:56]             |ListGroupPoliciesResult|GetGroupPolicyResult
[22:05:56]             |SendMessageResult|CreateTagsResponse|DeleteTagsResponse
[22:05:56]      )$/x
[22:05:56]      || $tag2 =~ /^(?:addressesSet-item|availabilityZoneInfo-item|imagesSet-item|instancesSet-item
[22:05:56]             |ipPermissions-item|keySet-item|reservedInstancesOfferingsSet-item|securityGroupInfo-item|volumeSet-item|snapshotSet-item|regionInfo-item
[22:05:56]             |ReceiveMessageResult-Message
[22:05:56]             |LoadBalancerDescriptions-member
[22:05:56]             |ReceiveMessageResult-Message|spotInstanceRequestSet-item|spotPriceHistorySet-item
[22:05:56]             |GetAttributesResult-Attribute|SelectResult-Item
[22:05:56]             |CreateGroupResult-Group|Groups-member|CreateUserResult-User|Users-member|GetUserResult-User
[22:05:56]             |CreateAccessKeyResult-AccessKey|AccessKeyMetadata-member|tagSet-item
[22:05:56]      )$/x
[22:05:56]      || $i == @xml)
[22:05:56]  {
[22:05:56]      $depth = $depth[$i];
[22:05:56]      ###push @table, {"" => $tag[$i]};
[22:05:56]      push @table, {};
[22:05:56]  }
[22:05:56]
[22:05:56]  next unless $depth;
[22:05:56]
[22:05:56]  if ($depth[$i] == $depth + 1)
[22:05:56]  {
[22:05:56]      $col = $tag[$i];
[22:05:56]      push @head, $col unless exists $head{$col};
[22:05:56]      $head{$col} = undef;
[22:05:56]  }
[22:05:56]  if ($depth[$i] >= $depth + 2)
[22:05:56]  {
[22:05:56]      $table[$#table]->{$col} .= " " if $table[$#table]->{$col} && $depth[$i] < 99;
[22:05:56]      $table[$#table]->{$col} .= $tag[$i];
[22:05:56]      $table[$#table]->{$col} .= "=" if $depth[$i] < 99;
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    if (!@table || $dump_xml)
[22:05:56]    {
[22:05:56]  print STDERR "$xml
[22:05:56]";
[22:05:56]
[22:05:56]  for (my $i = 0; $i < @xml; $i++)
[22:05:56]  {
[22:05:56]      next unless $tag[$i];
[22:05:56]      print STDERR $depth[$i], "  " x $depth[$i], "$tag[$i]
[22:05:56]";
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    $output;
[22:05:56]}
[22:05:56]
[22:05:56]sub xmlpp
[22:05:56]{
[22:05:56]    my($xml) = @_;
[22:05:56]    my($indent, @path, $defer, @defer, $result) = "   ";
[22:05:56]
[22:05:56]    for ($xml =~ /<.*?>|[^<]*/sg)
[22:05:56]    {
[22:05:56]  if (/^<\/(\w+)/ || /^<(!\[endif)/)      # </... or <!--[endif]
[22:05:56]  {
[22:05:56]      my($tag) = ($1);
[22:05:56]      $tag = $path[$#path] if $tag eq "![endif";
[22:05:56]      push @path, @defer;
[22:05:56]      while (@path)
[22:05:56]      {
[22:05:56]      my $pop = pop @path;
[22:05:56]      last if $pop eq $tag;
[22:05:56]      }
[22:05:56]            $result .= "@{[$indent x @path]}@{[$defer =~ /^\s*(.*?)\s*$/s]}$_
[22:05:56]" if $defer || $_;
[22:05:56]            $defer = "";
[22:05:56]      @defer = ();
[22:05:56]  }
[22:05:56]
[22:05:56]  elsif (/[\/\?]\s*\>$/)              # .../> or ...?>
[22:05:56]  {
[22:05:56]            $result .= "@{[$indent x @path]}@{[$defer =~ /^\s*(.*?)\s*$/s]}
[22:05:56]" if $defer;
[22:05:56]      push @path, @defer;
[22:05:56]            $result .= "@{[$indent x @path]}@{[/^\s*(.*?)\s*$/s]}
[22:05:56]" if $_;
[22:05:56]            $defer = "";
[22:05:56]      @defer = ();
[22:05:56]  }
[22:05:56]
[22:05:56]  elsif (/^(?:[^<]|<!(?:[^-]|--[^\[]))/)      # (not <) or (< then not -) or (<!-- then not [)
[22:05:56]  {
[22:05:56]      if (!/^\s*$/)
[22:05:56]      {
[22:05:56]      if ($defer)
[22:05:56]      {
[22:05:56]          $defer .= $_;
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]          $result .= "@{[$indent x @path]}@{[/^\s*(.*?)\s*$/s]}
[22:05:56]";
[22:05:56]      }
[22:05:56]      }
[22:05:56]  }
[22:05:56]
[22:05:56]  else                        # <...
[22:05:56]  {
[22:05:56]      $result .= "@{[$indent x @path]}@{[$defer =~ /^\s*(.*?)\s*$/s]}
[22:05:56]" if $defer;
[22:05:56]      push @path, @defer;
[22:05:56]      $defer = $_;
[22:05:56]      @defer = /^<([^<>\s]+)/;
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    $result .= "@{[$indent x @path]}@{[$defer =~ /^\s*(.*?)\s*$/s]}
[22:05:56]" if $defer;
[22:05:56]
[22:05:56]    $result;
[22:05:56]}
[22:05:56]
[22:05:56]# Convert xml string to YAML format
[22:05:56]# Cf.: https://github.com/timkay/aws/pull/9
[22:05:56]sub xml2yaml {
[22:05:56]    my($result) = xmlpp(@_);
[22:05:56]    my($rubySymbol) = "";
[22:05:56]
[22:05:56]    $rubySymbol = ":" if $ruby;
[22:05:56]
[22:05:56]    $result =~ s#
[22:05:56]# #g;
[22:05:56]  $result =~ s#> #>
[22:05:56]#g;                            # remove all '
[22:05:56]'s
[22:05:56]  $result =~ s#</.*>##g;                            # remove closing tags
[22:05:56]  $result =~ s#<([a-z0-9:]*).*>#$rubySymbol\1: #gi; # opening tags -> symbols
[22:05:56]  $result =~ s#($rubySymbol[^:]+): (.+)#\1: "\2"#g; # opening tags -> symbols
[22:05:56]  $result =~ s#:?(.*)/:#\1:#g;                      # empty values
[22:05:56]  $result =~ s#:?(item|bucket|member): #- #gi;      # array items
[22:05:56]  $result =~ s#   #  #g;                             # tabs -> spaces
[22:05:56]  $result =~ s#^[ :]*
[22:05:56]##mg;                        # remove all empty lines
[22:05:56]  $result =~ s#[ ]+$##gm;                           # remove all trailing spaces
[22:05:56]  $result =~ s#^[^ 
[22:05:56]]+:
[22:05:56]#---
[22:05:56]#;                  # new document indicator
[22:05:56]  $result =~ s#^  ##mg;                             # shift left
[22:05:56]
[22:05:56]  $result;
[22:05:56]}
[22:05:56]
[22:05:56]# Convert xml string to JSON format
[22:05:56]sub xml2json
[22:05:56]{
[22:05:56] my $xml = shift @_;
[22:05:56]
[22:05:56] return unless (eval {require XML::Simple} &&
[22:05:56]                eval {require JSON});
[22:05:56]
[22:05:56] return unless $xml;
[22:05:56]
[22:05:56] my $coder = JSON->new()->relaxed()->utf8()->allow_blessed->convert_blessed->allow_nonref();
[22:05:56]
[22:05:56] my $ref = XML::Simple::XMLin($xml, ForceArray => [qw/Attribute Item/]);
[22:05:56] return $coder->encode($ref);
[22:05:56]}
[22:05:56]
[22:05:56]sub s3
[22:05:56]{
[22:05:56]    my($verb, $marker, $name, $file, @header) = @_;
[22:05:56]
[22:05:56]    $file ||= $name if $verb eq PUT && $ENV{S3_DIR};
[22:05:56]    $name = "$ENV{S3_DIR}/$name" if $ENV{S3_DIR};
[22:05:56]    $name =~ s/^([^\?\/]+)(\?|$ )/$1\/$2/xs; # turn abc or abc? into abc/ or abc/?
[22:05:56]    $name .= $file if $verb eq PUT && $name =~ /\/$/;
[22:05:56]
[22:05:56]    # read from stdin when
[22:05:56]    # aws put target
[22:05:56]    # aws put target -
[22:05:56]    # but not
[22:05:56]    # aws put target?acl
[22:05:56]    # what about
[22:05:56]    # aws put target?location
[22:05:56]
[22:05:56]    my($temp_fh);
[22:05:56]
[22:05:56]    if ($verb eq PUT && $file eq "-" && $content_length)
[22:05:56]    {
[22:05:56]  push @header, "Content-Length: $content_length";
[22:05:56]  push @header, "Transfer-Encoding:";
[22:05:56]    }
[22:05:56]    elsif ($verb eq PUT && ($file eq "-" || $file eq "" && $name !~ /\?acl$/))
[22:05:56]    {
[22:05:56]  # and not when a terminal
[22:05:56]  die "$0: will not to read from terminal (use \"-\" for filename to force)
[22:05:56]" if -t && $file ne "-";
[22:05:56]
[22:05:56]  ($temp_fh, $file) = tempfile(UNLINK => 1);
[22:05:56]  while (STDIN->read(my $buf, 16_384))
[22:05:56]  {
[22:05:56]      print $temp_fh $buf;
[22:05:56]  }
[22:05:56]  $temp_fh->flush;
[22:05:56]    }
[22:05:56]
[22:05:56]    # add a Content-Type header using mime.types
[22:05:56]    if ($verb eq PUT)
[22:05:56]    {
[22:05:56]  my($found_content_type, $found_content_md5);
[22:05:56]  for (@header)
[22:05:56]  {
[22:05:56]      $found_content_type++ if /^content-type:/i;
[22:05:56]      $found_content_md5++ if /^content-md5:/i;
[22:05:56]  }
[22:05:56]  if (!$found_content_type)
[22:05:56]  {
[22:05:56]      my($ext) = $name =~ /\.(\w+)$/;
[22:05:56]      if ($ext)
[22:05:56]      {
[22:05:56]      local(@ARGV);
[22:05:56]      for (qw(mime.types /etc/mime.types))
[22:05:56]      {
[22:05:56]          push @ARGV, $_ if -e $_;
[22:05:56]      }
[22:05:56]      if (@ARGV)
[22:05:56]      {
[22:05:56]          while (<>)
[22:05:56]          {
[22:05:56]          my($type, @ext) = split(/\s+/);
[22:05:56]          if (grep /^$ext$/, @ext)
[22:05:56]          {
[22:05:56]              push @header, "Content-Type: $type";
[22:05:56]              print STDERR "setting $header[$#header]
[22:05:56]" if $v;
[22:05:56]              last;
[22:05:56]          }
[22:05:56]          }
[22:05:56]      }
[22:05:56]      }
[22:05:56]  }
[22:05:56]  if (!$found_content_md5 && $md5)
[22:05:56]  {
[22:05:56]      # Too memory intensive:
[22:05:56]      #my $md5 = encode_base64(md5(load_file($file)), "");
[22:05:56]
[22:05:56]      my($md5);
[22:05:56]
[22:05:56]      if (!$isUnix)
[22:05:56]      {
[22:05:56]      # Uses Digest::MD5::File that isn't in base perl:
[22:05:56]      # (Use this choice for Windows, after installing the package)
[22:05:56]      require Digest::MD5::File;
[22:05:56]      $md5 = encode_base64(Digest::MD5::File::file_md5($file), "");
[22:05:56]      }
[22:05:56]      else
[22:05:56]      {
[22:05:56]      # Just right:
[22:05:56]      $md5 = encode_base64(pack("H*", (split(" ", qx[md5sum @{[cq($file)]}]))[0]), "");
[22:05:56]      }
[22:05:56]
[22:05:56]      push @header, "Content-MD5: $md5";
[22:05:56]      print STDERR "setting $header[$#header]
[22:05:56]" if $v;
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    $set_acl = "public-read"  if $public;
[22:05:56]    $set_acl = "private"  if $private;
[22:05:56]    # the multipart upload stuff is getting icky
[22:05:56]    push @header, "x-amz-acl: $set_acl" if $set_acl && $verb =~ /^(?:POST|PUT)$/ && $name !~ /\?partNumber=|\?uploadId=/;
[22:05:56]
[22:05:56]    $requester = "requester" if $requester == 1;
[22:05:56]    push @header, "x-amz-request-payer: $requester" if $requester;
[22:05:56]
[22:05:56]    # added a case for "copy", so that the source moves to a header
[22:05:56]    if ($verb eq COPY)
[22:05:56]    {
[22:05:56]  if ($name =~ /\/$/)
[22:05:56]  {
[22:05:56]      my($what) = $file =~ /([^\/]+)$/;
[22:05:56]      $name .= $what;
[22:05:56]  }
[22:05:56]  if ($file !~ /^\//)
[22:05:56]  {
[22:05:56]      (my $where = $name) =~ s/\/[^\/]+$/\//;
[22:05:56]      $file = "/$where$file";
[22:05:56]  }
[22:05:56]  push @header, "x-amz-copy-source: @{[encode_url($file)]}";
[22:05:56]  undef $file;
[22:05:56]  $verb = PUT;
[22:05:56]    }
[22:05:56]
[22:05:56]    my($prefix);
[22:05:56]
[22:05:56]    # added a case for "ls", so that a prefix can be specified
[22:05:56]    # (otherwise, the prefix looks like an object name)
[22:05:56]    if ($verb eq LS)
[22:05:56]    {
[22:05:56]  $name =~ s/^\///;
[22:05:56]  ($name, $prefix) = split(/\//, $name, 2);
[22:05:56]  $name .= "/" if $name;
[22:05:56]  $prefix ||= $file;
[22:05:56]  undef $file;
[22:05:56]  $verb = GET;
[22:05:56]    }
[22:05:56]
[22:05:56]    my($ub, $uo, $uq) = $name =~ /^(.+?)(?:\/(.*?))?(\?(?:acl|delete|location|logging|bittorrent|lifecycle|policy|requestPayment
[22:05:56]                          |uploadId=[\.\-\w]+
[22:05:56]                          |uploads
[22:05:56]                          |upload
[22:05:56]                          |partNumber=\d+&uploadId=[\.\-\w]+
[22:05:56]                          |partNumber=\d+
[22:05:56]                          |part
[22:05:56]                          |versioning|versions|website))?$/sx;
[22:05:56]
[22:05:56]    my $uname = encode_url($ub) . "/" . encode_url($uo) . $uq if $name;
[22:05:56]
[22:05:56]    if ($uq =~ /^\?(?:uploadId=(.*)|upload|partNumber=(\d+)(?:&uploadId=(.*))?|part)$/)
[22:05:56]    {
[22:05:56]  my($uploadId, $partNumber, @part) = ($1 || $3, $2);
[22:05:56]
[22:05:56]  unless ($uploadId)
[22:05:56]  {
[22:05:56]      my $xml = s3(GET, undef, "$ub?uploads");
[22:05:56]      while ($xml =~ /<Upload>(.*?)<\/Upload>/sg)
[22:05:56]      {
[22:05:56]      my($upload) = ($1);
[22:05:56]      if ($upload =~ /<Key>(.*?)<\/Key>/ && $1 eq $uo)
[22:05:56]      {
[22:05:56]          if ($upload =~ /<UploadId>(.*?)<\/UploadId>/)
[22:05:56]          {
[22:05:56]          $uploadId = $1;
[22:05:56]          last;
[22:05:56]          }
[22:05:56]      }
[22:05:56]      }
[22:05:56]  }
[22:05:56]
[22:05:56]  if ($verb eq POST || $uq eq "?part") # look up partNumber
[22:05:56]  {
[22:05:56]      my $xml = s3(GET, undef, "$ub/$uo?uploadId=$uploadId");
[22:05:56]      while ($xml =~ /<Part>(.*?)<\/Part>/sg)
[22:05:56]      {
[22:05:56]      my($part) = ($1);
[22:05:56]      if ($part =~ /<PartNumber>(.*?)<\/PartNumber>.*?<ETag>(.*?)<\/ETag>/s)
[22:05:56]      {
[22:05:56]          push @part, [$1, $2];
[22:05:56]          $partNumber = $1;
[22:05:56]      }
[22:05:56]      }
[22:05:56]      $partNumber++;
[22:05:56]  }
[22:05:56]
[22:05:56]  if ($verb eq POST && $uq =~ /^\?(?:uploadId=.*|upload)$/)
[22:05:56]  {
[22:05:56]      ($temp_fh, my $temp_fn) = tempfile(UNLINK => 1);
[22:05:56]      print $temp_fh "<CompleteMultipartUpload>
[22:05:56]";
[22:05:56]      for (@part)
[22:05:56]      {
[22:05:56]      print $temp_fh "  <Part>
[22:05:56]";
[22:05:56]      print $temp_fh "    <PartNumber>$_->[0]</PartNumber>
[22:05:56]";
[22:05:56]      print $temp_fh "    <ETag>$_->[1]</ETag>
[22:05:56]";
[22:05:56]      print $temp_fh "  </Part>
[22:05:56]";
[22:05:56]      }
[22:05:56]      print $temp_fh "</CompleteMultipartUpload>
[22:05:56]";
[22:05:56]      $temp_fh->flush;
[22:05:56]      $file = $temp_fn;
[22:05:56]      system "cat $file" if $v >= 2;
[22:05:56]  }
[22:05:56]
[22:05:56]  return "$uname: no matching multipart upload found
[22:05:56]" if $uq eq "?upload" && length($uploadId) == 0;
[22:05:56]
[22:05:56]  $uname .= "Id=$uploadId" if $uq eq "?upload";               # List Parts / Complete Multipart Upload / Abort Multipart Upload
[22:05:56]  $uname .= "&uploadId=$uploadId" if $uq =~ /^?partNumber=\d+$/;      # Upload Part NNN
[22:05:56]  $uname .= "Number=$partNumber&uploadId=$uploadId" if $uq eq "?part";    # Upload Part
[22:05:56]    }
[22:05:56]
[22:05:56]    if ($uq eq "?delete")
[22:05:56]    {
[22:05:56]  $verb = POST;
[22:05:56]    }
[22:05:56]
[22:05:56]    if ($v >= 2)
[22:05:56]    {
[22:05:56]  print "name = $name
[22:05:56]";
[22:05:56]  print "ub = $ub
[22:05:56]";
[22:05:56]  print "uo = $uo
[22:05:56]";
[22:05:56]  print "uq = $uq
[22:05:56]";
[22:05:56]  print "uname = $uname
[22:05:56]";
[22:05:56]    }
[22:05:56]
[22:05:56]    my($vhost, $vname) = ($s3host, $uname);
[22:05:56]    if (!$no_vhost)
[22:05:56]    {
[22:05:56]  ($vhost, $vname) = ($dns_alias? $1: "$1.$vhost", $2) if $uname =~ /^([0-9a-z][\.\-0-9a-z]{1,61}[0-9a-z])(?:\/(.*))?$/;
[22:05:56]    }
[22:05:56]    print STDERR "vhost=$vhost  vname=$vname
[22:05:56]" if $v;
[22:05:56]
[22:05:56]    my $isGETobj = ($verb eq HEAD || $verb eq GET) && $uname =~ /\/./ && $uname !~ /\?/;
[22:05:56]    my $expires = time + ($expire_time || 30) + $time_offset;
[22:05:56]
[22:05:56]    my($content_type, $content_md5);
[22:05:56]
[22:05:56]    for (@header)
[22:05:56]    {
[22:05:56]  if (/^(.*?):\s*(.*)$/)
[22:05:56]  {
[22:05:56]      $content_type = $2 if lc $1 eq "content-type";
[22:05:56]      $content_md5 = $2 if lc $1 eq "content-md5";
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    push @header, "x-amz-security-token:$session" if $session;
[22:05:56]
[22:05:56]    my $header_sign = join("
[22:05:56]", sort(map {s/^(.*?):\s*/\L$1:/s; $_} grep /^x-amz-/, @header), "") if @header;
[22:05:56]    my $header = join(" --header ", undef, map {cq($_)} @header);
[22:05:56]
[22:05:56]    if ($isGETobj && ($verb eq HEAD || !$fail) && !$request)
[22:05:56]    {
[22:05:56]  my $data = "HEAD
[22:05:56]$content_md5
[22:05:56]$content_type
[22:05:56]$expires
[22:05:56]$header_sign/$uname";
[22:05:56]  my $sig = sign($data);
[22:05:56]  my $url = "$scheme://$vhost/$vname@{[$vname =~ /\?/? '&': '?']}AWSAccessKeyId=@{[encode_url($awskey)]}&Expires=$expires&Signature=@{[encode_url($sig)]}";
[22:05:56]  my $cmd = qq[$curl $curl_options $insecureaws $header --head @{[cq($url)]}];
[22:05:56]  print STDERR "$cmd
[22:05:56]" if $v;
[22:05:56]  my $head = qx[$cmd];
[22:05:56]
[22:05:56]  print STDERR $head if $v;
[22:05:56]
[22:05:56]  my($code) = $head =~ /^HTTP\/\d+\.\d+\s+(\d+\s+.*?)
[22:05:56]?
[22:05:56]/s;
[22:05:56]
[22:05:56]  if ($code !~ /^2\d\d\s/)
[22:05:56]  {
[22:05:56]      print STDERR "$code
[22:05:56]" unless $v;
[22:05:56]      $exit_code = 22;
[22:05:56]      exit $exit_code;
[22:05:56]  }
[22:05:56]
[22:05:56]  if ($verb eq HEAD)
[22:05:56]  {
[22:05:56]      print $head;
[22:05:56]      return;
[22:05:56]  }
[22:05:56]    }
[22:05:56]
[22:05:56]    my($content);
[22:05:56]    $content = "--upload-file @{[cq($file)]}" if $file;
[22:05:56]
[22:05:56]    if ($verb eq GET && $file)
[22:05:56]    {
[22:05:56]  if ($file =~ /\/$/ || -d $file)
[22:05:56]  {
[22:05:56]      $file .= "/" if $file !~ /\/$/;
[22:05:56]      #Why doesn't #1 work?
[22:05:56]      #$file .= "#1";
[22:05:56]      my($name) = $name =~ /(?:.*\/)?(.*)$/;
[22:05:56]      $file .= $name;
[22:05:56]  }
[22:05:56]  $content = "--create-dirs --output @{[cq($file)]}";
[22:05:56]    }
[22:05:56]
[22:05:56]    # added a case for "mkdir", so that "$name .= $file"  gets defeated
[22:05:56]    # in the mkdir case - We don't want the file we are uploading to be
[22:05:56]    # name is the location constraint file.
[22:05:56]
[22:05:56]  {
[22:05:56]
[22:05:56]Process exited with code 1

Of course, I know by now that this means that it couldn't upload/download. As you said, I do not know why. Sometimes this is an intermittent aws failure, sometimes its a bug in my deploy, etc. Touching that script does sound terrible, so I do not blame you for not wanting to 😄

edeliver always prints the (remotely) executed command if it fails

This is helpful if you know why, but when I first started using the tool it left me thinking that that was the error message. Perhaps a message prior to printing the actual command could be added:

A remote command failed on $HOST, output of the command is above and the command itself will be printed below for debugging purposes.

Maybe it'd be nice if you were able to replace the script when printing the error with some placeholder so it doesn't fill up the log and distract from any message that may appear if stderr isn't suppressed. You could also print a standard help message if this fails: || (echo There was a problem downloading the release, ensure it exists in the release store)

Btw: you can also use a scp location as release store, which should be even faster as aws if it is located in your own (deploy) network.

This is good to know, maybe I'll give this a shot.

Thanks!

bharendt added a commit that referenced this issue May 17, 2016

Don't include contents of `libexec/aws` script into error output
if uploading or downloading of release from/to aws release store
fails. See #80.

@bharendt bharendt closed this in 0512323 May 25, 2016

@aaronjensen

This comment has been minimized.

Contributor

aaronjensen commented May 25, 2016

Looks like this was actually addressed last week (very cool, thank you!) and #77 was addressed by 0512323 I'll give them a shot. Thanks again!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment