1package VM::EC2::Staging::Manager; 2 3=head1 NAME 4 5VM::EC2::Staging::Manager - Automate VMs and volumes for moving data in and out of cloud. 6 7=head1 SYNOPSIS 8 9 use VM::EC2::Staging::Manager; 10 11 my $ec2 = VM::EC2->new(-region=>'us-east-1'); 12 my $staging = $ec2->staging_manager(-on_exit => 'stop', # default, stop servers when process exists 13 -verbose => 1, # default, verbose progress messages 14 -scan => 1, # default, scan region for existing staging servers and volumes 15 -image_name => 'ubuntu-precise-12.04', # default server image 16 -user_name => 'ubuntu', # default server login name 17 ); 18 19 # Assuming an EBS image named ami-12345 is located in the US, copy it into 20 # the South American region, returning the AMI ID in South America 21 my $new_image = $staging->copy_image('ami-12345','sa-east-1'); 22 23 # provision a new server, using defaults. Name will be assigned automatically 24 my $server = $staging->provision_server(-availability_zone => 'us-east-1a'); 25 26 # retrieve a new server named "my_server", if one exists. If not, it creates one 27 # using the specified options 28 my $server = $staging->get_server(-name => 'my_server', 29 -availability_zone => 'us-east-1a', 30 -instance_type => 't1.micro'); 31 32 # open up an ssh session in an xterm 33 $server->shell; 34 35 # run a command over ssh on the server. See VM::EC2::Staging::Server 36 $server->ssh('whoami'); 37 38 # run a command over ssh on the server, returning the result as an array of lines or a 39 # scalar string, similar to backticks (``) 40 my @password_lines = $server->scmd('cat /etc/passwd'); 41 42 # run a command on the server and read from it using a filehandle 43 my $fh = $server->scmd_read('ls -R /usr/lib'); 44 while (<$fh>) { # do something } 45 46 # run a command on the server and write to it using a filehandle 47 my $fh = $server->scmd_write('sudo -s "cat >>/etc/fstab"'); 48 print $fh "/dev/sdf3 /mnt/demo ext3 0 2\n"; 49 close $fh; 50 51 # Provision a new volume named "Pictures". Will automatically be mounted to a staging server in 52 # the specified zone. Server will be created if needed. 53 my $volume = $staging->provision_volume(-name => 'Pictures', 54 -fstype => 'ext4', 55 -availability_zone => 'us-east-1a', 56 -size => 2) or die $staging->error_str; 57 58 # gets an existing volume named "Pictures" if it exists. Otherwise provisions a new volume; 59 my $volume = $staging->get_volume(-name => 'Pictures', 60 -fstype => 'ext4', 61 -availability_zone => 'us-east-1a', 62 -size => 2) or die $staging->error_str; 63 64 # copy contents of local directory /opt/test to remote volume $volume using rsync 65 # See VM::EC2::Staging::Volume 66 $volume->put('/opt/test/'); 67 68 # same thing, but first creating a subdirectory on the remote volume 69 $volume->put('/opt/test/' => './mirrors/'); 70 71 # copy contents of remote volume $volume to local directory /tmp/test using rsync 72 $volume->get('/tmp/test'); 73 74 # same thing, but from a subdirectory of the remote volume 75 $volume->get('./mirrors/' => '/tmp/test'); 76 77 # server to server transfer (works both within and between availability regions) 78 my $south_america = VM::EC2->new(-region=>'sa-east-1')->staging_manager; # create a staging manager in Sao Paolo 79 my $volume2 = $south_america->provision_volume(-name => 'Videos', 80 -availability_zone => 'sa-east-1a', 81 -size => 2); 82 $staging->rsync("$volume/mirrors" => "$volume2/us-east"); 83 84 $staging->stop_all_servers(); 85 $staging->start_all_servers(); 86 $staging->terminate_all_servers(); 87 $staging->force_terminate_all_servers(); 88 89=head1 DESCRIPTION 90 91VM::EC2::Staging::Manager manages a set of EC2 volumes and servers 92in a single AWS region. It was primarily designed to simplify the 93process of provisioning and populating volumes, but it also provides a 94handy set of ssh commands that allow you to run remote commands 95programmatically. 96 97The manager also allows you to copy EBS-backed AMIs and their attached 98volumes from one region to another, something that is otherwise 99difficult to do. 100 101The main classes are: 102 103 VM::EC2::Staging::Manager -- A set of volume and server resources in 104 a single AWS region. 105 106 VM::EC2::Staging::Server -- A staging server running somewhere in the 107 region. It is a VM::EC2::Instance 108 extended to provide remote command and 109 copy facilities. 110 111 VM::EC2::Staging::Volume -- A staging disk volume running somewhere in the 112 region. It is a VM::EC2::Volume 113 extended to provide remote copy 114 facilities. 115 116Staging servers can provision volumes, format them, mount them, copy 117data between local and remote (virtual) machines, and execute secure 118shell commands. Staging volumes can mount themselves on servers, run a 119variety of filesystem-oriented commands, and invoke commands on the 120servers to copy data around locally and remotely. 121 122See L<VM::EC2::Staging::Server> and L<VM::EC2::Staging::Volume> for 123the full details. 124 125=head1 Constructors 126 127The following methods allow you to create new 128VM::EC2::Staging::Manager instances. Be aware that only one manager is 129allowed per EC2 region; attempting to create additional managers in 130the same region will return the same one each time. 131 132=cut 133 134use strict; 135use VM::EC2 ':standard'; 136use Carp 'croak','longmess'; 137use File::Spec; 138use File::Path 'make_path','remove_tree'; 139use File::Basename 'dirname','basename'; 140use Scalar::Util 'weaken'; 141use String::Approx 'adistr'; 142use File::Temp 'tempfile'; 143 144use constant GB => 1_073_741_824; 145use constant SERVER_STARTUP_TIMEOUT => 120; 146use constant LOCK_TIMEOUT => 10; 147use constant VERBOSE_DEBUG => 3; 148use constant VERBOSE_INFO => 2; 149use constant VERBOSE_WARN => 1; 150 151my (%Zones,%Instances,%Volumes,%Managers); 152my $Verbose; 153my ($LastHost,$LastMt); 154 155=head2 $manager = $ec2->staging_manager(@args) 156 157This is a simplified way to create a staging manager. First create the 158EC2 object in the desired region, and then call its staging_manager() 159method: 160 161 $manager = VM::EC2->new(-region=>'us-west-2')->staging_manager() 162 163The staging_manager() method is only known to VM::EC2 objects if you 164first "use" VM::EC2::Staging::Manager. 165 166=over 4 167 168=item Required Arguments 169 170None. 171 172=item Optional Arguments 173 174The optional arguments change the way that the manager creates new 175servers and volumes. 176 177 -on_exit What to do with running servers when the manager goes 178 out of scope or the script exits. One of 'run', 179 'stop' (default), or 'terminate'. "run" keeps all 180 created instances running, so beware! 181 182 -architecture Architecture for newly-created server 183 instances (default "i386"). Can be overridden in calls to get_server() 184 and provision_server(). 185 186 -instance_type Type of newly-created servers (default "m1.small"). Can be overridden 187 in calls to get_server() and provision_server(). 188 189 -root_type Root type for newly-created servers (default depends 190 on the -on_exit behavior; "ebs" for exit behavior of 191 "stop" and "instance-store" for exit behavior of "run" 192 or "terminate". 193 194 -image_name Name or ami ID of the AMI to use for creating the 195 instances of new servers. Defaults to 'ubuntu-precise-12.04'. 196 If the image name begins with "ami-", then it is 197 treated as an AMI ID. Otherwise it is treated as 198 a name pattern and will be used to search the AMI 199 name field using the wildcard search "*$name*". 200 Names work better than AMI ids here, because the 201 latter change from one region to another. If multiple 202 matching image candidates are found, then an alpha 203 sort on the name is used to find the image with the 204 highest alpha sort value, which happens to work with 205 Ubuntu images to find the latest release. 206 207 -availability_zone Availability zone for newly-created 208 servers. Default is undef, in which case a random 209 zone is selected. 210 211 -username Username to use for ssh connections. Defaults to 212 "ubuntu". Note that this user must be able to use 213 sudo on the instance without providing a password, 214 or functionality of this module will be limited. 215 216 -verbose Integer level of verbosity. Level 1 prints warning 217 messages. Level 2 (the default) adds informational 218 messages as well. Level 3 adds verbose debugging 219 messages. Level 0 suppresses all messages. 220 221 -quiet (deprecated) If true, turns off all verbose messages. 222 223 -scan Boolean, default true. If true, scans region for 224 volumes and servers created by earlier manager 225 instances. 226 227 -reuse_key Boolean, default true. If true, creates a single 228 ssh keypair for each region and reuses it. Note that 229 the private key is kept on the local computer in the 230 directory ~/.vm-ec2-staging, and so additional 231 keypairs may be created if you use this module on 232 multiple local machines. If this option is false, 233 then a new keypair will be created for every server 234 you partition. 235 236 -reuse_volumes Boolean, default true. If this flag is true, then 237 calls to provision_volume() will return existing 238 volumes if they share the same name as the requested 239 volume. If no suitable existing volume exists, then 240 the most recent snapshot of this volume is used to 241 create it in the specified availability zone. Only 242 if no volume or snapshot exist will a new volume be 243 created from scratch. 244 245 -dotdir Path to the directory that contains keyfiles and other 246 stable configuration information for this module. 247 Defaults to ~/.vm_ec2_staging. You may wish to change 248 this to, say, a private dropbox directory or an NFS-mount 249 in order to share keyfiles among machines. Be aware of 250 the security implications of sharing private key files. 251 252 -server_class By default, staging server objects created by the manager 253 are of class type VM::EC2::Staging::Server. If you create 254 a custom server subclass, you need to let the manager know 255 about it by passing the class name to this argument. 256 257 -volume_class By default, staging volume objects created by the manager 258 are of class type VM::EC2::Staging::Volume. If you create 259 a custom volume subclass, you need to let the manager know 260 about it by passing the class name to this argument. 261 262=back 263 264=head2 $manager = VM::EC2::Staging::Manager(-ec2 => $ec2,@args) 265 266This is a more traditional constructur for the staging manager. 267 268=over 4 269 270=item Required Arguments 271 272 -ec2 A VM::EC2 object. 273 274=item Optional Arguments 275 276All of the arguments listed in the description of 277VM::EC2->staging_manager(). 278 279=back 280 281=cut 282 283sub VM::EC2::staging_manager { 284 my $self = shift; 285 return VM::EC2::Staging::Manager->new(@_,-ec2=>$self) 286} 287 288 289sub new { 290 my $self = shift; 291 my %args = @_; 292 $args{-ec2} ||= VM::EC2->new(); 293 294 if (my $manager = $self->find_manager($args{-ec2}->endpoint)) { 295 return $manager; 296 } 297 298 $args{-on_exit} ||= $self->default_exit_behavior; 299 $args{-reuse_key} ||= $self->default_reuse_keys; 300 $args{-username} ||= $self->default_user_name; 301 $args{-architecture} ||= $self->default_architecture; 302 $args{-root_type} ||= $self->default_root_type; 303 $args{-instance_type} ||= $self->default_instance_type; 304 $args{-reuse_volumes} ||= $self->default_reuse_volumes; 305 $args{-image_name} ||= $self->default_image_name; 306 $args{-availability_zone} ||= undef; 307 $args{-verbose} = $self->default_verbosity unless exists $args{-verbose}; 308 $args{-scan} = 1 unless exists $args{-scan}; 309 $args{-pid} = $$; 310 $args{-dotdir} ||= $self->default_dot_directory_path; 311 $args{-volume_class} ||= $self->default_volume_class; 312 $args{-server_class} ||= $self->default_server_class; 313 314 $args{-verbose} = 0 if $args{-quiet}; 315 316 # bring in classes 317 foreach ('-server_class','-volume_class') { 318 eval "use $args{$_};1" or croak "Can't use $args{$_}" 319 unless $args{$_}->can('new'); 320 } 321 322 # create accessors 323 my $class = ref $self || $self; 324 foreach (keys %args) { 325 (my $func_name = $_) =~ s/^-//; 326 next if $self->can($func_name); 327 eval <<END; 328sub ${class}::${func_name} { 329 my \$self = shift; 330 my \$d = \$self->{$_}; 331 \$self->{$_} = shift if \@_; 332 return \$d; 333} 334END 335 die $@ if $@; 336 } 337 338 $Verbose = $args{-verbose}; # package global, for a few edge cases 339 my $obj = bless \%args,ref $class || $class; 340 weaken($Managers{$obj->ec2->endpoint} = $obj); 341 if ($args{-scan}) { 342 $obj->info("Scanning for existing staging servers and volumes in ",$obj->ec2->endpoint,".\n"); 343 $obj->scan_region; 344 } 345 return $obj; 346} 347 348 349# class method 350# the point of this somewhat odd way of storing managers is to ensure that there is only one 351# manager per endpoint, and to avoid circular references in the Server and Volume objects. 352sub find_manager { 353 my $class = shift; 354 my $endpoint = shift; 355 return unless $endpoint; 356 return $Managers{$endpoint}; 357} 358 359=head1 Interzone Copying of AMIs and Snapshots 360 361This library provides convenience methods for copying whole AMIs as 362well as individual snapshots from one zone to another. It does this by 363gathering information about the AMI/snapshot in the source zone, 364creating staging servers in the source and target zones, and then 365copying the volume data from the source to the target. If an 366AMI/snapshot does not use a recognized filesystem (e.g. it is part of 367an LVM or RAID disk set), then block level copying of the entire 368device is used. Otherwise, rsync() is used to minimize data transfer 369fees. 370 371Note that interzone copying of instance-backed AMIs is B<not> 372supported. Only EBS-backed images can be copied in this way. 373 374See also the command-line script migrate-ebs-image.pl that comes with 375this package. 376 377=head2 $new_image_id = $manager->copy_image($source_image,$destination_zone,@register_options) 378 379This method copies the AMI indicated by $source_image from the zone 380that $manager belongs to, into the indicated $destination_zone, and 381returns the AMI ID of the new image in the destination zone. 382 383$source_image may be an AMI ID, or a VM::EC2::Image object. 384 385$destination_zone may be a simple region name, such as "us-west-2", or 386a VM::EC2::Region object (as returned by VM::EC2->describe_regions), 387or a VM::EC2::Staging::Manager object that is associated with the 388desired region. The latter form gives you control over the nature of 389the staging instances created in the destination zone. For example, if 390you wish to use 'm1.large' high-I/O instances in both the source and 391destination reasons, you would proceed like this: 392 393 my $source = VM::EC2->new(-region=>'us-east-1' 394 )->staging_manager(-instance_type=>'m1.large', 395 -on_exit =>'terminate'); 396 my $destination = VM::EC2->new(-region=>'us-west-2' 397 )->staging_manager(-instance_type=>'m1.large', 398 -on_exit =>'terminate'); 399 my $new_image = $source->copy_image('ami-123456' => $destination); 400 401If present, the named argument list @register_options will be passed 402to register_image() and used to override options in the destination 403image. This can be used to set ephemeral device mappings, which cannot 404currently be detected and transferred automatically by copy_image(): 405 406 $new_image =$source->copy_image('ami-123456' => 'us-west-2', 407 -description => 'My AMI western style', 408 -block_devices => '/dev/sde=ephemeral0'); 409 410=head2 $dest_kernel = $manager->match_kernel($src_kernel,$dest_zone) 411 412Find a kernel in $dest_zone that matches the $src_kernel in the 413current zone. $dest_zone can be a VM::EC2::Staging manager object, a 414region name, or a VM::EC2::Region object. 415 416=cut 417 418############################################# 419# copying AMIs from one zone to another 420############################################# 421sub copy_image { 422 my $self = shift; 423 my ($imageId,$destination,@options) = @_; 424 my $ec2 = $self->ec2; 425 426 my $image = ref $imageId && $imageId->isa('VM::EC2::Image') ? $imageId 427 : $ec2->describe_images($imageId); 428 $image 429 or croak "Unknown image '$imageId'"; 430 $image->imageType eq 'machine' 431 or croak "$image is not an AMI"; 432# $image->platform eq 'windows' 433# and croak "It is not currently possible to migrate Windows images between regions via this method"; 434 $image->rootDeviceType eq 'ebs' 435 or croak "It is not currently possible to migrate instance-store backed images between regions via this method"; 436 437 my $dest_manager = $self->_parse_destination($destination); 438 439 my $root_type = $image->rootDeviceType; 440 if ($root_type eq 'ebs') { 441 return $self->_copy_ebs_image($image,$dest_manager,\@options); 442 } else { 443 return $self->_copy_instance_image($image,$dest_manager,\@options); 444 } 445} 446 447=head2 $new_snapshot_id = $manager->copy_snapshot($source_snapshot,$destination_zone) 448 449This method copies the EBS snapshot indicated by $source_snapshot from 450the zone that $manager belongs to, into the indicated 451$destination_zone, and returns the ID of the new snapshot in the 452destination zone. 453 454$source_snapshot may be an string ID, or a VM::EC2::Snapshot object. 455 456$destination_zone may be a simple region name, such as "us-west-2", or 457a VM::EC2::Region object (as returned by VM::EC2->describe_regions), 458or a VM::EC2::Staging::Manager object that is associated with the 459desired region. 460 461Note that this call uses the Amazon CopySnapshot API call that was 462introduced in 2012-12-01 and no longer involves the creation of 463staging servers in the source and destination regions. 464 465=cut 466 467sub copy_snapshot { 468 my $self = shift; 469 my ($snapId,$dest_manager) = @_; 470 my $snap = $self->ec2->describe_snapshots($snapId) 471 or croak "Couldn't find snapshot for $snapId"; 472 my $description = "duplicate of $snap, created by ".__PACKAGE__." during snapshot copying"; 473 my $dest_region = ref($dest_manager) && $dest_manager->can('ec2') 474 ? $dest_manager->ec2->region 475 : "$dest_manager"; 476 477 $self->info("Copying snapshot $snap from ",$self->ec2->region," to $dest_region...\n"); 478 my $snapshot = $snap->copy(-region => $dest_region, 479 -description => $description); 480 481 while (!eval{$snapshot->current_status}) { 482 sleep 1; 483 } 484 $self->info("...new snapshot = $snapshot; status = ",$snapshot->current_status,"\n"); 485 486 # copy snapshot tags 487 my $tags = $snap->tags; 488 $snapshot->add_tags($tags); 489 490 return $snapshot; 491} 492 493sub _copy_instance_image { 494 my $self = shift; 495 croak "This module is currently unable to copy instance-backed AMIs between regions.\n"; 496} 497 498sub _copy_ebs_image { 499 my $self = shift; 500 my ($image,$dest_manager,$options) = @_; 501 502 # apply overrides 503 my %overrides = @$options if $options; 504 505 # hashref with keys 'name', 'description','architecture','kernel','ramdisk','block_devices','root_device' 506 # 'is_public','authorized_users' 507 $self->info("Gathering information about image $image.\n"); 508 my $info = $self->_gather_image_info($image); 509 510 my $name = $info->{name}; 511 my $description = $info->{description}; 512 my $architecture = $info->{architecture}; 513 my $root_device = $info->{root_device}; 514 my $platform = $info->{platform}; 515 my ($kernel,$ramdisk); 516 517 # make sure we have a suitable image in the destination region 518 # if the virtualization type is HVM 519 my $is_hvm = $image->virtualization_type eq 'hvm'; 520 if ($is_hvm) { 521 $self->_find_hvm_image($dest_manager->ec2, 522 $root_device, 523 $architecture, 524 $platform) 525 or croak "Destination region ",$dest_manager->ec2->region," does not currently support HVM images of this type"; 526 } 527 528 if ($info->{kernel} && !$overrides{-kernel}) { 529 $self->info("Searching for a suitable kernel in the destination region.\n"); 530 $kernel = $self->_match_kernel($info->{kernel},$dest_manager,'kernel') 531 or croak "Could not find an equivalent kernel for $info->{kernel} in region ",$dest_manager->ec2->endpoint; 532 $self->info("Matched kernel $kernel\n"); 533 } 534 535 if ($info->{ramdisk} && !$overrides{-ramdisk}) { 536 $self->info("Searching for a suitable ramdisk in the destination region.\n"); 537 $ramdisk = ( $self->_match_kernel($info->{ramdisk},$dest_manager,'ramdisk') 538 || $dest_manager->_guess_ramdisk($kernel) 539 ) or croak "Could not find an equivalent ramdisk for $info->{ramdisk} in region ",$dest_manager->ec2->endpoint; 540 $self->info("Matched ramdisk $ramdisk\n"); 541 } 542 543 my $block_devices = $info->{block_devices}; # format same as $image->blockDeviceMapping 544 545 $self->info("Copying EBS volumes attached to this image (this may take a long time).\n"); 546 my @bd = @$block_devices; 547 my %dest_snapshots = map { 548 $_->snapshotId 549 ? ($_->snapshotId => $self->copy_snapshot($_->snapshotId,$dest_manager)) 550 : () 551 } @bd; 552 553 $self->info("Waiting for all snapshots to complete. This may take a long time.\n"); 554 my $state = $dest_manager->ec2->wait_for_snapshots(values %dest_snapshots); 555 my @errored = grep {$state->{$_} eq 'error'} values %dest_snapshots; 556 croak ("Snapshot(s) @errored could not be completed due to an error") 557 if @errored; 558 559 # create the new block device mapping 560 my @mappings; 561 for my $source_ebs (@$block_devices) { 562 my $dest = "$source_ebs"; # interpolates into correct format 563 $dest =~ s/=([\w-]+)/'='.($dest_snapshots{$1}||$1)/e; # replace source snap with dest snap 564 push @mappings,$dest; 565 } 566 567 # ensure choose a unique name 568 if ($dest_manager->ec2->describe_images({name => $name})) { 569 print STDERR "An image named '$name' already exists in destination region. "; 570 $name = $self->_token($name); 571 print STDERR "Renamed to '$name'\n"; 572 } 573 574 # merge block device mappings if present 575 if (my $m = $overrides{-block_device_mapping}||$overrides{-block_devices}) { 576 push @mappings,(ref $m ? @$m : $m); 577 delete $overrides{-block_device_mapping}; 578 delete $overrides{-block_devices}; 579 } 580 581 # helpful for recovering failed process 582 my $block_device_info_args = join ' ',map {"-b $_"} @mappings; 583 584 my $img; 585 586 if ($is_hvm) { 587 $self->info("Registering snapshot in destination with the equivalent of:\n"); 588 $self->info("ec2-register -n '$name' -d '$description' -a $architecture --virtualization-type hvm --root-device-name $root_device $block_device_info_args\n"); 589 $self->info("Note: this is a notional command line that can only be used by AWS development partners.\n"); 590 $img = $self->_create_hvm_image(-ec2 => $dest_manager->ec2, 591 -name => $name, 592 -root_device_name => $root_device, 593 -block_device_mapping => \@mappings, 594 -description => $description, 595 -architecture => $architecture, 596 -platform => $image->platform, 597 %overrides); 598 } 599 600 else { 601 $self->info("Registering snapshot in destination with the equivalent of:\n"); 602 $self->info("ec2-register -n '$name' -d '$description' -a $architecture --kernel '$kernel' --ramdisk '$ramdisk' --root-device-name $root_device $block_device_info_args\n"); 603 $img = $dest_manager->ec2->register_image(-name => $name, 604 -root_device_name => $root_device, 605 -block_device_mapping => \@mappings, 606 -description => $description, 607 -architecture => $architecture, 608 $kernel ? (-kernel_id => $kernel): (), 609 $ramdisk ? (-ramdisk_id => $ramdisk): (), 610 %overrides, 611 ); 612 $img or croak "Could not register image: ",$dest_manager->ec2->error_str; 613 } 614 615 # copy launch permissions 616 $img->make_public(1) if $info->{is_public}; 617 $img->add_authorized_users(@{$info->{authorized_users}}) if @{$info->{authorized_users}}; 618 619 # copy tags 620 my $tags = $image->tags; 621 $img->add_tags($tags); 622 623 # Improve the snapshot tags 624 my $source_region = $self->ec2->region; 625 my $dest_region = $dest_manager->ec2->region; 626 for (@mappings) { 627 my ($snap) = /(snap-[0=9a-f]+)/ or next; 628 $snap = $dest_manager->ec2->describe_snapshots($snap) or next; 629 $snap->add_tags(Name => "Copy image $image($source_region) to $img($dest_region)"); 630 } 631 632 return $img; 633} 634 635# copying an HVM image requires us to: 636# 1. Copy each of the snapshots to the destination region 637# 2. Find a public HVM image in the destination region that matches the architecture, hypervisor type, 638# and root device type of the source image. (note: platform must not be 'windows' 639# 3. Run a cc2 instance: "cc2.8xlarge", but replace default block device mapping with the new snapshots. 640# 4. Stop the image. 641# 5. Detach the root volume 642# 6. Initialize and attach a new root volume from the copied source root snapshot. 643# 7. Run create_image() on the instance. 644# 8. Terminate the instance and clean up. 645sub _create_hvm_image { 646 my $self = shift; 647 my %args = @_; 648 649 my $ec2 = $args{-ec2}; 650 651 # find a suitable image that we can run 652 $self->info("Searching for a suitable HVM image in destination region\n"); 653 my $ami = $self->_find_hvm_image($ec2,$args{-root_device_name},$args{-architecture},$args{-platform}); 654 $ami or croak "Could not find suitable HVM image in region ",$ec2->region; 655 656 $self->info("...Found $ami (",$ami->name,")\n"); 657 658 # remove root device from the block device list 659 my $root = $args{-root_device_name}; 660 my @nonroot_devices = grep {!/^$root/} @{$args{-block_device_mapping}}; 661 my ($root_snapshot) = "@{$args{-block_device_mapping}}" =~ /$root=(snap-[0-9a-f]+)/; 662 663 my $instance_type = $args{-platform} eq 'windows' ? 'm1.small' : 'cc2.8xlarge'; 664 $self->info("Launching an HVM staging server in the target region. Heuristically choosing instance type of '$instance_type' for this type of HVM..\n"); 665 666 my $instance = $ec2->run_instances(-instance_type => $instance_type, 667 -image_id => $ami, 668 -block_devices => \@nonroot_devices) 669 or croak "Could not run HVM instance: ",$ec2->error_str; 670 $self->info("Waiting for instance to become ready.\n"); 671 $ec2->wait_for_instances($instance); 672 673 $self->info("Stopping instance temporarily to swap root volumes.\n"); 674 $instance->stop(1); 675 676 $self->info("Detaching original root volume...\n"); 677 my $a = $instance->detach_volume($root) or croak "Could not detach $root: ", $ec2->error_str; 678 $ec2->wait_for_attachments($a); 679 $a->current_status eq 'detached' or croak "Could not detach $root, status = ",$a->current_status; 680 $ec2->delete_volume($a->volumeId) or croak "Could not delete original root volume: ",$ec2->error_str; 681 682 $self->info("Creating and attaching new root volume..\n"); 683 my $vol = $ec2->create_volume(-availability_zone => $instance->placement, 684 -snapshot_id => $root_snapshot) 685 or croak "Could not create volume from root snapshot $root_snapshot: ",$ec2->error_str; 686 $ec2->wait_for_volumes($vol); 687 $vol->current_status eq 'available' or croak "Volume creation failed, status = ",$vol->current_status; 688 689 $a = $instance->attach_volume($vol,$root) or croak "Could not attach new root volume: ",$ec2->error_str; 690 $ec2->wait_for_attachments($a); 691 $a->current_status eq 'attached' or croak "Attach failed, status = ",$a->current_status; 692 $a->deleteOnTermination(1); 693 694 $self->info("Creating image in destination region...\n"); 695 my $img = $instance->create_image($args{-name},$args{-description}); 696 697 # get rid of the original copied snapshots - we no longer need them 698 foreach (@{$args{-block_device_mapping}}) { 699 my ($snapshot) = /(snap-[0-9a-f]+)/ or next; 700 $ec2->delete_snapshot($snapshot) 701 or $self->warn("Could not delete unneeded snapshot $snapshot; please delete manually: ",$ec2->error_str) 702 } 703 704 # terminate the staging server. 705 $self->info("Terminating the staging server\n"); 706 $instance->terminate; # this will delete the volume as well because of deleteOnTermination 707 708 return $img; 709} 710 711sub _find_hvm_image { 712 my $self = shift; 713 my ($ec2,$root_device_name,$architecture,$platform) = @_; 714 715 my $cache_key = join (';',@_); 716 return $self->{_hvm_image}{$cache_key} if exists $self->{_hvm_image}{$cache_key}; 717 718 my @i = $ec2->describe_images(-executable_by=> 'all', 719 -owner => 'amazon', 720 -filter => { 721 'virtualization-type' => 'hvm', 722 'root-device-type' => 'ebs', 723 'root-device-name' => $root_device_name, 724 'architecture' => $architecture, 725 }); 726 @i = grep {$_->platform eq $platform} @i; 727 return $self->{_hvm_image}{$cache_key} = $i[0]; 728} 729 730 731=head1 Instance Methods for Managing Staging Servers 732 733These methods allow you to create and interrogate staging 734servers. They each return one or more VM::EC2::Staging::Server 735objects. See L<VM::EC2::Staging::Server> for more information about 736what you can do with these servers once they are running. 737 738=head2 $server = $manager->provision_server(%options) 739 740Create a new VM::EC2::Staging::Server object according to the passed 741options, which override the default options provided by the Manager 742object. 743 744 -name Name for this server, which can be used to retrieve 745 it later with a call to get_server(). 746 747 -architecture Architecture for the newly-created server 748 instances (e.g. "i386"). If not specified, then defaults 749 to the default_architecture() value. If explicitly 750 specified as undef, then the architecture of the matching 751 image will be used. 752 753 -instance_type Type of the newly-created server (e.g. "m1.small"). 754 755 -root_type Root type for the server ("ebs" or "instance-store"). 756 757 -image_name Name or ami ID of the AMI to use for creating the 758 instance for the server. If the image name begins with 759 "ami-", then it is treated as an AMI ID. Otherwise it 760 is treated as a name pattern and will be used to 761 search the AMI name field using the wildcard search 762 "*$name*". Names work better than AMI ids here, 763 because the latter change from one region to 764 another. If multiple matching image candidates are 765 found, then an alpha sort on the name is used to find 766 the image with the highest alpha sort value, which 767 happens to work with Ubuntu images to find the latest 768 release. 769 770 -availability_zone Availability zone for the server, or undef to 771 choose an availability zone randomly. 772 773 -username Username to use for ssh connections. Defaults to 774 "ubuntu". Note that this user must be able to use 775 sudo on the instance without providing a password, 776 or functionality of this server will be limited. 777 778In addition, you may use any of the options recognized by 779VM::EC2->run_instances() (e.g. -block_devices). 780 781=cut 782 783sub provision_server { 784 my $self = shift; 785 my @args = @_; 786 787 # let subroutine arguments override manager's args 788 my %args = ($self->_run_instance_args,@args); 789 790 # fix possible gotcha -- instance store is not allowed for micro instances. 791 $args{-root_type} = 'ebs' if $args{-instance_type} eq 't1.micro'; 792 $args{-name} ||= $self->new_server_name; 793 794 my ($keyname,$keyfile) = $self->_security_key; 795 my $security_group = $self->_security_group; 796 my $image = $self->_search_for_image(%args) or croak "No suitable image found"; 797 $args{-architecture} = $image->architecture; 798 799 my ($instance) = $self->ec2->run_instances( 800 -image_id => $image, 801 -security_group_id => $security_group, 802 -key_name => $keyname, 803 %args, 804 ); 805 $instance or croak $self->ec2->error_str; 806 807 my $success; 808 while (!$success) { 809 # race condition... 810 $success = eval{ $instance->add_tags(StagingRole => 'StagingInstance', 811 Name => "Staging server $args{-name} created by ".__PACKAGE__, 812 StagingUsername => $self->username, 813 StagingName => $args{-name}); 814 } 815 } 816 817 my $class = $args{-server_class} || $self->server_class; 818 819 my $server = $class->new( 820 -keyfile => $keyfile, 821 -username => $self->username, 822 -instance => $instance, 823 -manager => $self, 824 -name => $args{-name}, 825 @args, 826 ); 827 eval { 828 local $SIG{ALRM} = sub {die 'timeout'}; 829 alarm(SERVER_STARTUP_TIMEOUT); 830 $self->wait_for_servers($server); 831 }; 832 alarm(0); 833 croak "server did not start after ",SERVER_STARTUP_TIMEOUT," seconds" 834 if $@ =~ /timeout/; 835 $self->register_server($server); 836 return $server; 837} 838 839sub _run_instance_args { 840 my $self = shift; 841 my @args; 842 for my $arg (qw(instance_type availability_zone architecture image_name root_type)) { 843 push @args,("-${arg}" => $self->$arg); 844 } 845 return @args; 846} 847 848=head2 $server = $manager->get_server(-name=>$name,%other_options) 849 850=head2 $server = $manager->get_server($name) 851 852Return an existing VM::EC2::Staging::Server object having the 853indicated symbolic name, or create a new server if one with this name 854does not already exist. The server's instance characteristics will be 855configured according to the options passed to the manager at create 856time (e.g. -availability_zone, -instance_type). These options can be 857overridden by %other_args. See provision_volume() for details. 858 859=cut 860 861sub get_server { 862 my $self = shift; 863 unshift @_,'-name' if @_ == 1; 864 865 my %args = @_; 866 $args{-name} ||= $self->new_server_name; 867 868 # find servers of same name 869 local $^W = 0; # prevent an uninitialized value warning 870 my %servers = map {$_->name => $_} $self->servers; 871 my $server = $servers{$args{-name}} || $self->provision_server(%args); 872 873 # this information needs to be renewed each time 874 $server->username($args{-username}) if $args{-username}; 875 bless $server,$args{-server_class} if $args{-server_class}; 876 877 $server->start unless $server->ping; 878 return $server; 879} 880 881=head2 $server = $manager->get_server_in_zone(-zone=>$availability_zone,%other_options) 882 883=head2 $server = $manager->get_server_in_zone($availability_zone) 884 885Return an existing VM::EC2::Staging::Server running in the indicated 886symbolic name, or create a new server if one with this name does not 887already exist. The server's instance characteristics will be 888configured according to the options passed to the manager at create 889time (e.g. -availability_zone, -instance_type). These options can be 890overridden by %other_args. See provision_server() for details. 891 892=cut 893 894sub get_server_in_zone { 895 my $self = shift; 896 unshift @_,'-availability_zone' if @_ == 1; 897 my %args = @_; 898 my $zone = $args{-availability_zone}; 899 if ($zone && (my $servers = $Zones{$zone}{Servers})) { 900 my $server = (values %{$servers})[0]; 901 $server->start unless $server->is_up; 902 return $server; 903 } 904 else { 905 return $self->provision_server(%args); 906 } 907} 908 909=head2 $server = $manager->find_server_by_instance($instance_id) 910 911Given an EC2 instanceId, return the corresponding 912VM::EC2::Staging::Server, if any. 913 914=cut 915 916sub find_server_by_instance { 917 my $self = shift; 918 my $server = shift; 919 return $Instances{$server}; 920} 921 922=head2 @servers $manager->servers 923 924Return all registered VM::EC2::Staging::Servers in the zone managed by 925the manager. 926 927=cut 928 929sub servers { 930 my $self = shift; 931 my $endpoint = $self->ec2->endpoint; 932 return $self->_servers($endpoint); 933} 934 935=head2 $manager->start_all_servers 936 937Start all VM::EC2::Staging::Servers that are currently in the "stop" 938state. 939 940=cut 941 942sub start_all_servers { 943 my $self = shift; 944 my @servers = $self->servers; 945 my @need_starting = grep {$_->current_status eq 'stopped'} @servers; 946 return unless @need_starting; 947 eval { 948 local $SIG{ALRM} = sub {die 'timeout'}; 949 alarm(SERVER_STARTUP_TIMEOUT); 950 $self->_start_instances(@need_starting); 951 }; 952 alarm(0); 953 croak "some servers did not start after ",SERVER_STARTUP_TIMEOUT," seconds" 954 if $@ =~ /timeout/; 955} 956 957=head2 $manager->stop_all_servers 958 959Stop all VM::EC2::Staging::Servers that are currently in the "running" 960state. 961 962=cut 963 964sub stop_all_servers { 965 my $self = shift; 966 my $ec2 = $self->ec2; 967 my @servers = grep {$_->ec2 eq $ec2} $self->servers; 968 @servers or return; 969 $self->info("Stopping servers @servers.\n"); 970 $self->ec2->stop_instances(@servers); 971 $self->ec2->wait_for_instances(@servers); 972} 973 974=head2 $manager->terminate_all_servers 975 976Terminate all VM::EC2::Staging::Servers and unregister them. 977 978=cut 979 980sub terminate_all_servers { 981 my $self = shift; 982 my $ec2 = $self->ec2 or return; 983 my @servers = $self->servers or return; 984 $self->_terminate_servers(@servers); 985} 986 987=head2 $manager->force_terminate_all_servers 988 989Force termination of all VM::EC2::Staging::Servers, even if the 990internal registration system indicates that some may be in use by 991other Manager instances. 992 993=cut 994 995sub force_terminate_all_servers { 996 my $self = shift; 997 my $ec2 = $self->ec2 or return; 998 my @servers = $self->servers or return; 999 $ec2->terminate_instances(@servers) or warn $self->ec2->error_str; 1000 $ec2->wait_for_instances(@servers); 1001} 1002 1003sub _terminate_servers { 1004 my $self = shift; 1005 my @servers = @_; 1006 my $ec2 = $self->ec2 or return; 1007 1008 my @terminate; 1009 foreach (@servers) { 1010 my $in_use = $self->unregister_server($_); 1011 if ($in_use) { 1012 $self->warn("$_ is still in use. Will not terminate.\n"); 1013 next; 1014 } 1015 push @terminate,$_; 1016 } 1017 1018 if (@terminate) { 1019 $self->info("Terminating servers @terminate.\n"); 1020 $ec2->terminate_instances(@terminate) or warn $self->ec2->error_str; 1021 $ec2->wait_for_instances(@terminate); 1022 } 1023 1024 unless ($self->reuse_key) { 1025 $ec2->delete_key_pair($_) foreach $ec2->describe_key_pairs(-filter=>{'key-name' => 'staging-key-*'}); 1026 } 1027} 1028 1029=head2 $manager->wait_for_servers(@servers) 1030 1031Wait until all the servers on the list @servers are up and able to 1032accept ssh commands. You may wish to wrap this in an eval{} and 1033timeout in order to avoid waiting indefinitely. 1034 1035=cut 1036 1037sub wait_for_servers { 1038 my $self = shift; 1039 my @instances = @_; 1040 my $status = $self->ec2->wait_for_instances(@instances); 1041 my %pending = map {$_=>$_} grep {$_->current_status eq 'running'} @instances; 1042 $self->info("Waiting for ssh daemon on @instances.\n") if %pending; 1043 while (%pending) { 1044 for my $s (values %pending) { 1045 unless ($s->ping) { 1046 sleep 5; 1047 next; 1048 } 1049 delete $pending{$s}; 1050 } 1051 } 1052 return $status; 1053} 1054 1055sub _start_instances { 1056 my $self = shift; 1057 my @need_starting = @_; 1058 $self->info("starting instances: @need_starting.\n"); 1059 $self->ec2->start_instances(@need_starting); 1060 $self->wait_for_servers(@need_starting); 1061} 1062 1063=head1 Instance Methods for Managing Staging Volumes 1064 1065These methods allow you to create and interrogate staging 1066volumes. They each return one or more VM::EC2::Staging::Volume 1067objects. See L<VM::EC2::Staging::Volume> for more information about 1068what you can do with these staging volume objects. 1069 1070=head2 $volume = $manager->provision_volume(%options) 1071 1072Create and register a new VM::EC2::Staging::Volume and mount it on a 1073staging server in the appropriate availability zone. A new staging 1074server will be created for this purpose if one does not already 1075exist. 1076 1077If you provide a symbolic name for the volume and the manager has 1078previously snapshotted a volume by the same name, then the snapshot 1079will be used to create the volume (this behavior can be suppressed by 1080passing -reuse=>0). This allows for the following pattern for 1081efficiently updating a snapshotted volume: 1082 1083 my $vol = $manager->provision_volume(-name=>'MyPictures', 1084 -size=>10); 1085 $vol->put('/usr/local/my_pictures/'); # will do an rsync from local directory 1086 $vol->create_snapshot; # write out to a snapshot 1087 $vol->delete; 1088 1089You may also explicitly specify a volumeId or snapshotId. The former 1090allows you to place an existing volume under management of 1091VM::EC2::Staging::Manager and returns a corresponding staging volume 1092object. The latter creates the staging volume from the indicated 1093snapshot, irregardless of whether the snapshot was created by the 1094staging manager at an earlier time. 1095 1096Newly-created staging volumes are automatically formatted as ext4 1097filesystems and mounted on the staging server under 1098/mnt/Staging/$name, where $name is the staging volume's symbolic 1099name. The filesystem type and the mountpoint can be modified with the 1100-fstype and -mount arguments, respectively. In addition, you may 1101specify an -fstype of "raw", in which case the volume will be attached 1102to a staging server (creating the server first if necessary) but not 1103formatted or mounted. This is useful when creating multi-volume RAID 1104or LVM setups. 1105 1106Options: 1107 1108 -name Name of the staging volume. A fatal error issues if a staging 1109 volume by this name already exists (use get_volume() to 1110 avoid this). If no name is provided, then a random 1111 unique one is chosen for you. 1112 1113 -availability_zone 1114 Availability zone in which to create this 1115 volume. If none is specified, then a zone is chosen that 1116 reuses an existing staging server, if any. 1117 1118 -size Size of the desired volume, in GB. 1119 1120 -fstype Filesystem type for the volume, ext4 by default. Supported 1121 types are ext2, ext3, ext4, xfs, reiserfs, jfs, hfs, 1122 ntfs, vfat, msdos, and raw. 1123 1124 -mount Mount point for this volume on the staging server (e.g. /opt/bin). 1125 Use with care, as there are no checks to prevent you from mounting 1126 two staging volumes on top of each other or mounting over essential 1127 operating system paths. 1128 1129 -label Volume label. Only applies to filesystems that support labels 1130 (all except hfs, vfat, msdos and raw). 1131 1132 -volume_id Create the staging volume from an existing EBS volume with 1133 the specified ID. Most other options are ignored in this 1134 case. 1135 1136 -snapshot_id 1137 Create the staging volume from an existing EBS 1138 snapshot. If a size is specified that is larger than the 1139 snapshot, then the volume and its filesystem will be 1140 automatically extended (this only works for ext volumes 1141 at the moment). Shrinking of volumes is not currently 1142 supported. 1143 1144 -reuse If true, then the most recent snapshot created from a staging 1145 volume of the same name is used to create the 1146 volume. This is the default. Pass 0 to disable this 1147 behavior. 1148 1149The B<-reuse> argument is intended to support the following use case 1150in which you wish to rsync a directory on a host system somewhere to 1151an EBS snapshot, without maintaining a live server and volume on EC2: 1152 1153 my $volume = $manager->provision_volume(-name=>'backup_1', 1154 -reuse => 1, 1155 -fstype => 'ext3', 1156 -size => 10); 1157 $volume->put('fred@gw.harvard.edu:my_music'); 1158 $volume->create_snapshot('Music Backup '.localtime); 1159 $volume->delete; 1160 1161The next time this script is run, the "backup_1" volume will be 1162recreated from the most recent snapshot, minimizing copying. A new 1163snapshot is created, and the staging volume is deleted. 1164 1165=cut 1166 1167sub provision_volume { 1168 my $self = shift; 1169 my %args = @_; 1170 1171 $args{-name} ||= $self->new_volume_name; 1172 $args{-size} ||= 1 unless $args{-snapshot_id} || $args{-volume_id}; 1173 $args{-volume_id} ||= undef; 1174 $args{-snapshot_id} ||= undef; 1175 $args{-reuse} = $self->reuse_volumes unless defined $args{-reuse}; 1176 $args{-mount} ||= '/mnt/Staging/'.$args{-name}; # BUG: "/mnt/Staging" is hardcoded in multiple places 1177 $args{-fstype} ||= 'ext4'; 1178 $args{-availability_zone} ||= $self->_select_used_zone; 1179 $args{-label} ||= $args{-name}; 1180 1181 $self->find_volume_by_name($args{-name}) && 1182 croak "There is already a volume named $args{-name} in this region"; 1183 1184 if ($args{-snapshot_id}) { 1185 $self->info("Provisioning volume from snapshot $args{-snapshot_id}.\n"); 1186 } elsif ($args{-volume_id}) { 1187 $self->info("Provisioning volume from volume $args{-volume_id}.\n"); 1188 my $v = $self->ec2->describe_volumes($args{-volume_id}); 1189 $args{-availability_zone} = $v->availabilityZone if $v; 1190 $args{-size} = $v->size if $v; 1191 } else { 1192 $self->info("Provisioning a new $args{-size} GB $args{-fstype} volume.\n"); 1193 } 1194 1195 $args{-availability_zone} ? $self->info("Obtaining a staging server in zone $args{-availability_zone}.\n") 1196 : $self->info("Obtaining a staging server.\n"); 1197 my $server = $self->get_server_in_zone($args{-availability_zone}); 1198 $server->start unless $server->ping; 1199 my $volume = $server->provision_volume(%args); 1200 $self->register_volume($volume); 1201 return $volume; 1202} 1203 1204=head2 $volume = $manager->get_volume(-name=>$name,%other_options) 1205 1206=head2 $volume = $manager->get_volume($name) 1207 1208Return an existing VM::EC2::Staging::Volume object with the indicated 1209symbolic name, or else create a new volume if one with this name does 1210not already exist. The volume's characteristics will be configured 1211according to the options in %other_args. See provision_volume() for 1212details. If called with no arguments, this method returns Volume 1213object with default characteristics and a randomly-assigned name. 1214 1215=cut 1216 1217sub get_volume { 1218 my $self = shift; 1219 1220 unshift @_,'-name' if @_ == 1; 1221 my %args = @_; 1222 $args{-name} ||= $self->new_volume_name; 1223 1224 # find volume of same name 1225 my %vols = map {$_->name => $_} $self->volumes; 1226 my $vol = $vols{$args{-name}} || $self->provision_volume(%args); 1227 return $vol; 1228} 1229 1230=head2 $result = $manager->rsync($src1,$src2,$src3...,$dest) 1231 1232This method provides remote synchronization (rsync) file-level copying 1233between one or more source locations and a destination location via an 1234ssh tunnel. Copying among arbitrary combinations of local and remote 1235filesystems is supported, with the caveat that the remote filesystems 1236must be contained on volumes and servers managed by this module (see 1237below for a workaround). 1238 1239You may provide two or more directory paths. The last path will be 1240treated as the copy destination, and the source paths will be treated 1241as copy sources. All copying is performed using the -avz options, 1242which activates recursive directory copying in which ownership, 1243modification times and permissions are preserved, and compresses the 1244data to reduce network usage. Verbosity is set so that the names of 1245copied files are printed to STDERR. If you do not wish this, then use 1246call the manager's quiet() method with a true value. 1247 1248Source paths can be formatted in one of several ways: 1249 1250 /absolute/path 1251 Copy the contents of the directory /absolute/path located on the 1252 local machine to the destination. This will create a 1253 subdirectory named "path" on the destination disk. Add a slash 1254 to the end of the path (i.e. "/absolute/path/") in order to 1255 avoid creating this subdirectory on the destination disk. 1256 1257 ./relative/path 1258 Relative paths work the way you expect, and depend on the current 1259 working directory. The terminating slash rule applies. 1260 1261 $staging_volume 1262 Pass a VM::EC2::Staging::Volume to copy the contents of the 1263 volume to the destination disk starting at the root of the 1264 volume. Note that you do *not* need to have any knowledge of the 1265 mount point for this volume in order to copy its contents. 1266 1267 $staging_volume:/absolute/path 1268 $staging_volume:absolute/path 1269 $staging_volume/absolute/path 1270 All these syntaxes accomplish the same thing, which is to 1271 copy a subdirectory of a staging volume to the destination disk. 1272 The root of the volume is its top level, regardless of where it 1273 is mounted on the staging server. Because of string 1274 interpolation magic, you can enclose staging volume object names 1275 in quotes in order to construct the path, as in 1276 "$picture_volume:/family/vacations/". As in local paths, a 1277 terminating slash indicates that the contents of the last 1278 directory in the path are to be copied without creating the 1279 enclosing directory on the desetination. Note that you do *not* 1280 need to have any knowledge of the mount point for this volume in 1281 order to copy its contents. 1282 1283 $staging_server:/absolute/path 1284 Pass a staging server object and absolute path to copy the contents 1285 of this path to the destination disk. Because of string interpolation 1286 you can include server objects in quotes: "$my_server:/opt" 1287 1288 $staging_server:relative/path 1289 This form will copy data from paths relative to the remote user's home 1290 directory on the staging server. Typically not very useful, but supported. 1291 1292The same syntax is supported for destination paths, except that it 1293makes no difference whether a path has a trailing slash or not. 1294 1295As with the rsync command, if you proceed a path with a single colon 1296(:/my/path), it is a short hand to use the previous server/volume/host 1297in the source list. 1298 1299When specifying multiple source directories, all source directories must 1300reside on the same local or remote machine. This is legal: 1301 1302 $manager->rsync("$picture_volume:/family/vacations", 1303 "$picture_volume:/family/picnics" 1304 => "$backup_volume:/recent_backups"); 1305 1306This is not: 1307 1308 $manager->rsync("$picture_volume:/family/vacations", 1309 "$audio_volume:/beethoven" 1310 => "$backup_volume:/recent_backups"); 1311 1312When specifying multiple sources, you may give the volume or server 1313once for the first source and then start additional source paths with 1314a ":" to indicate the same volume or server is to be used: 1315 1316 $manager->rsync("$picture_volume:/family/vacations", 1317 ":/family/picnics" 1318 => "$backup_volume:/recent_backups"); 1319 1320When copying to/from the local machine, the rsync process will run as 1321the user that the script was launched by. However, on remote servers 1322managed by the staging manager, the rsync process will run as 1323superuser. 1324 1325The rsync() method will also accept regular remote DNS names and IP 1326addresses, optionally preceded by a username: 1327 1328 $manager->rsync("$picture_volume:/family/vacations" => 'fred@gw.harvard.edu:/tmp') 1329 1330When called in this way, the method does what it can to avoid 1331prompting for a password or passphrase on the non-managed host 1332(gw.harvard.edu in the above example). This includes turning off 1333strict host checking and forwarding the user agent information from 1334the local machine. 1335 1336=head2 $result = $manager->rsync(\@options,$src1,$src2,$src3...,$dest) 1337 1338This is a variant of the rsync command in which extra options can be 1339passed to rsync by providing an array reference as the first argument. 1340For example: 1341 1342 $manager->rsync(['--exclude' => '*~'], 1343 '/usr/local/backups', 1344 "$my_server:/usr/local"); 1345 1346=cut 1347 1348# most general form 1349# 1350sub rsync { 1351 my $self = shift; 1352 croak "usage: VM::EC2::Staging::Manager->rsync(\$source_path1,\$source_path2\...,\$dest_path)" 1353 unless @_ >= 2; 1354 1355 my @p = @_; 1356 my @user_args = ($p[0] && ref($p[0]) eq 'ARRAY') 1357 ? @{shift @p} 1358 : (); 1359 1360 undef $LastHost; 1361 undef $LastMt; 1362 my @paths = map {$self->_resolve_path($_)} @p; 1363 1364 my $dest = pop @paths; 1365 my @source = @paths; 1366 1367 my %hosts; 1368 local $^W=0; # avoid uninit value errors 1369 foreach (@source) { 1370 $hosts{$_->[0]} = $_->[0]; 1371 } 1372 croak "More than one source host specified" if keys %hosts > 1; 1373 my ($source_host) = values %hosts; 1374 my $dest_host = $dest->[0]; 1375 1376 my @source_paths = map {$_->[1]} @source; 1377 my $dest_path = $dest->[1]; 1378 1379 my $rsync_args = $self->_rsync_args; 1380 my $dots; 1381 1382 if ($self->verbosity == VERBOSE_INFO) { 1383 $rsync_args .= 'v'; # print a line for each file 1384 $dots = '2>&1|/tmp/dots.pl t'; 1385 } 1386 $rsync_args .= ' '.join ' ', map {_quote_shell($_)} @user_args if @user_args; 1387 1388 my $src_is_server = $source_host && UNIVERSAL::isa($source_host,'VM::EC2::Staging::Server'); 1389 my $dest_is_server = $dest_host && UNIVERSAL::isa($dest_host,'VM::EC2::Staging::Server'); 1390 1391 # this is true when one of the paths contains a ":", indicating an rsync 1392 # path that contains a hostname, but not a managed server 1393 my $remote_path = "@source_paths $dest_path" =~ /:/; 1394 1395 # remote rsync on either src or dest server 1396 if ($remote_path && ($src_is_server || $dest_is_server)) { 1397 my $server = $source_host || $dest_host; 1398 $self->_upload_dots_script($server) if $dots; 1399 return $server->ssh(['-t','-A'],"sudo -E rsync -e 'ssh -o \"CheckHostIP no\" -o \"StrictHostKeyChecking no\"' $rsync_args @source_paths $dest_path $dots"); 1400 } 1401 1402 # localhost => localhost 1403 if (!($source_host || $dest_host)) { 1404 my $dots_cmd = $self->_dots_cmd; 1405 return system("rsync @source $dest $dots_cmd") == 0; 1406 } 1407 1408 # localhost => DataTransferServer 1409 if ($dest_is_server && !$src_is_server) { 1410 return $dest_host->_rsync_put($rsync_args,@source_paths,$dest_path); 1411 } 1412 1413 # DataTransferServer => localhost 1414 if ($src_is_server && !$dest_is_server) { 1415 return $source_host->_rsync_get($rsync_args,@source_paths,$dest_path); 1416 } 1417 1418 if ($source_host eq $dest_host) { 1419 $self->info("Beginning rsync @source_paths $dest_path...\n"); 1420 my $result = $source_host->ssh('sudo','rsync',$rsync_args,@source_paths,$dest_path); 1421 $self->info("...rsync done.\n"); 1422 return $result; 1423 } 1424 1425 # DataTransferServer1 => DataTransferServer2 1426 # this one is slightly more difficult because datatransferserver1 has to 1427 # ssh authenticate against datatransferserver2. 1428 my $keyname = $self->_authorize($source_host => $dest_host); 1429 1430 my $dest_ip = $dest_host->instance->dnsName; 1431 my $ssh_args = $source_host->_ssh_escaped_args; 1432 my $keyfile = $source_host->keyfile; 1433 $ssh_args =~ s/$keyfile/$keyname/; # because keyfile is embedded among args 1434 $self->info("Beginning rsync @source_paths $dest_ip:$dest_path...\n"); 1435 $self->_upload_dots_script($source_host) if $dots; 1436 my $result = $source_host->ssh('sudo','rsync',$rsync_args, 1437 '-e',"'ssh $ssh_args'", 1438 "--rsync-path='sudo rsync'", 1439 @source_paths,"$dest_ip:$dest_path",$dots); 1440 $self->info("...rsync done.\n"); 1441 return $result; 1442} 1443 1444sub _quote_shell { 1445 my $thing = shift; 1446 $thing =~ s/\s/\ /; 1447 $thing =~ s/(['"])/\\($1)/; 1448 $thing; 1449} 1450 1451=head2 $manager->dd($source_vol=>$dest_vol) 1452 1453This method performs block-level copying of the contents of 1454$source_vol to $dest_vol by using dd over an SSH tunnel, where both 1455source and destination volumes are VM::EC2::Staging::Volume 1456objects. The volumes must be attached to a server but not 1457mounted. Everything in the volume, including its partition table, is 1458copied, allowing you to make an exact image of a disk. 1459 1460The volumes do B<not> actually need to reside on this server, but can 1461be attached to any staging server in the zone. 1462 1463=cut 1464 1465# for this to work, we have to create the concept of a "raw" staging volume 1466# that is attached, but not mounted 1467sub dd { 1468 my $self = shift; 1469 1470 @_==2 or croak "usage: VM::EC2::Staging::Manager->dd(\$source_vol=>\$dest_vol)"; 1471 1472 my ($vol1,$vol2) = @_; 1473 my ($server1,$device1) = ($vol1->server,$vol1->mtdev); 1474 my ($server2,$device2) = ($vol2->server,$vol2->mtdev); 1475 my $hush = $self->verbosity < VERBOSE_INFO ? '2>/dev/null' : ''; 1476 my $use_pv = $self->verbosity >= VERBOSE_WARN; 1477 my $gigs = $vol1->size; 1478 1479 if ($use_pv) { 1480 $self->info("Configuring PV to show dd progress...\n"); 1481 $server1->ssh("if [ ! -e /usr/bin/pv ]; then sudo apt-get -qq update >/dev/null 2>&1; sudo apt-get -y -qq install pv >/dev/null 2>&1; fi"); 1482 } 1483 1484 if ($server1 eq $server2) { 1485 if ($use_pv) { 1486 print STDERR "\n"; 1487 $server1->ssh(['-t'], "sudo dd if=$device1 2>/dev/null | pv -f -s ${gigs}G -petr | sudo dd of=$device2 2>/dev/null"); 1488 } else { 1489 $server1->ssh("sudo dd if=$device1 of=$device2 $hush"); 1490 } 1491 } else { 1492 my $keyname = $self->_authorize($server1,$server2); 1493 my $dest_ip = $server2->instance->dnsName; 1494 my $ssh_args = $server1->_ssh_escaped_args; 1495 my $keyfile = $server1->keyfile; 1496 $ssh_args =~ s/$keyfile/$keyname/; # because keyfile is embedded among args 1497 my $pv = $use_pv ? "2>/dev/null | pv -s ${gigs}G -petr" : ''; 1498 $server1->ssh(['-t'], "sudo dd if=$device1 $hush $pv | gzip -1 - | ssh $ssh_args $dest_ip 'gunzip -1 - | sudo dd of=$device2'"); 1499 } 1500} 1501 1502# take real or symbolic name and turn it into a two element 1503# list consisting of server object and mount point 1504# possible forms: 1505# /local/path 1506# vol-12345/relative/path 1507# vol-12345:/relative/path 1508# vol-12345:relative/path 1509# $server:/absolute/path 1510# $server:relative/path 1511# 1512# treat path as symbolic if it does not start with a slash 1513# or dot characters 1514sub _resolve_path { 1515 my $self = shift; 1516 my $vpath = shift; 1517 1518 my ($servername,$pathname); 1519 if ($vpath =~ /^(vol-[0-9a-f]+):?(.*)/ && 1520 (my $vol = VM::EC2::Staging::Manager->find_volume_by_volid($1))) { 1521 my $path = $2 || '/'; 1522 $path = "/$path" if $path && $path !~ m!^/!; 1523 $vol->_spin_up; 1524 $servername = $LastHost = $vol->server; 1525 my $mtpt = $LastMt = $vol->mtpt; 1526 $pathname = $mtpt; 1527 $pathname .= $path if $path; 1528 } elsif ($vpath =~ /^(i-[0-9a-f]{8}):(.+)$/ && 1529 (my $server = VM::EC2::Staging::Manager->find_server_by_instance($1))) { 1530 $servername = $LastHost = $server; 1531 $pathname = $2; 1532 } elsif ($vpath =~ /^:(.+)$/) { 1533 $servername = $LastHost if $LastHost; 1534 $pathname = $LastHost && $LastMt ? "$LastMt/$2" : $2; 1535 } else { 1536 return [undef,$vpath]; # localhost 1537 } 1538 return [$servername,$pathname]; 1539} 1540 1541sub _rsync_args { 1542 my $self = shift; 1543 my $verbosity = $self->verbosity; 1544 return $verbosity < VERBOSE_WARN ? '-azq' 1545 :$verbosity < VERBOSE_INFO ? '-azh' 1546 :$verbosity < VERBOSE_DEBUG ? '-azh' 1547 : '-azhv' 1548} 1549 1550sub _authorize { 1551 my $self = shift; 1552 my ($source_host,$dest_host) = @_; 1553 my $keyname = "/tmp/${source_host}_to_${dest_host}"; 1554 unless ($source_host->has_key($keyname)) { 1555 $source_host->info("creating ssh key for server to server data transfer.\n"); 1556 $source_host->ssh("ssh-keygen -t dsa -q -f $keyname</dev/null 2>/dev/null"); 1557 $source_host->has_key($keyname=>1); 1558 } 1559 unless ($dest_host->accepts_key($keyname)) { 1560 my $key_stuff = $source_host->scmd("cat ${keyname}.pub"); 1561 chomp($key_stuff); 1562 $dest_host->ssh("mkdir -p .ssh; chmod 0700 .ssh; (echo '$key_stuff' && cat .ssh/authorized_keys) | sort | uniq > .ssh/authorized_keys.tmp; mv .ssh/authorized_keys.tmp .ssh/authorized_keys; chmod 0600 .ssh/authorized_keys"); 1563 $dest_host->accepts_key($keyname=>1); 1564 } 1565 1566 return $keyname; 1567} 1568 1569=head2 $volume = $manager->find_volume_by_volid($volume_id) 1570 1571Given an EC2 volumeId, return the corresponding 1572VM::EC2::Staging::Volume, if any. 1573 1574=cut 1575 1576sub find_volume_by_volid { 1577 my $self = shift; 1578 my $volid = shift; 1579 return $Volumes{$volid}; 1580} 1581 1582=head2 $volume = $manager->find_volume_by_name($name) 1583 1584Given a staging name (assigned at volume creation time), return the 1585corresponding VM::EC2::Staging::Volume, if any. 1586 1587=cut 1588 1589sub find_volume_by_name { 1590 my $self = shift; 1591 my $name = shift; 1592 my %volumes = map {$_->name => $_} $self->volumes; 1593 return $volumes{$name}; 1594} 1595 1596=head2 @volumes = $manager->volumes 1597 1598Return all VM::EC2::Staging::Volumes managed in this zone. 1599 1600=cut 1601 1602sub volumes { 1603 my $self = shift; 1604 return grep {$_->ec2->endpoint eq $self->ec2->endpoint} values %Volumes; 1605} 1606 1607=head1 Instance Methods for Accessing Configuration Options 1608 1609This section documents accessor methods that allow you to examine or 1610change configuration options that were set at create time. Called with 1611an argument, the accessor changes the option and returns the option's 1612previous value. Called without an argument, the accessor returns the 1613option's current value. 1614 1615=head2 $on_exit = $manager->on_exit([$new_behavior]) 1616 1617Get or set the "on_exit" option, which specifies what to do with 1618existing staging servers when the staging manager is destroyed. Valid 1619values are "terminate", "stop" and "run". 1620 1621=head2 $reuse_key = $manager->reuse_key([$boolean]) 1622 1623Get or set the "reuse_key" option, which if true uses the same 1624internally-generated ssh keypair for all running instances. If false, 1625then a new keypair will be created for each staging server. The 1626keypair will be destroyed automatically when the staging server 1627terminates (but only if the staging manager initiates the termination 1628itself). 1629 1630=head2 $username = $manager->username([$new_username]) 1631 1632Get or set the username used to log into staging servers. 1633 1634=head2 $architecture = $manager->architecture([$new_architecture]) 1635 1636Get or set the architecture (i386, x86_64) to use for launching 1637new staging servers. 1638 1639=head2 $root_type = $manager->root_type([$new_type]) 1640 1641Get or set the instance root type for new staging servers 1642("instance-store", "ebs"). 1643 1644=head2 $instance_type = $manager->instance_type([$new_type]) 1645 1646Get or set the instance type to use for new staging servers 1647(e.g. "t1.micro"). I recommend that you use "m1.small" (the default) 1648or larger instance types because of the extremely slow I/O of the 1649micro instance. In addition, micro instances running Ubuntu have a 1650known bug that prevents them from unmounting and remounting EBS 1651volumes repeatedly on the same block device. This can lead to hangs 1652when the staging manager tries to create volumes. 1653 1654=head2 $reuse_volumes = $manager->reuse_volumes([$new_boolean]) 1655 1656This gets or sets the "reuse_volumes" option, which if true causes the 1657provision_volumes() call to create staging volumes from existing EBS 1658volumes and snapshots that share the same staging manager symbolic 1659name. See the discussion under VM::EC2->staging_manager(), and 1660VM::EC2::Staging::Manager->provision_volume(). 1661 1662=head2 $name = $manager->image_name([$new_name]) 1663 1664This gets or sets the "image_name" option, which is the AMI ID or AMI 1665name to use when creating new staging servers. Names beginning with 1666"ami-" are treated as AMI IDs, and everything else is treated as a 1667pattern match on the AMI name. 1668 1669=head2 $zone = $manager->availability_zone([$new_zone]) 1670 1671Get or set the default availability zone to use when creating new 1672servers and volumes. An undef value allows the staging manager to 1673choose the zone in a way that minimizes resources. 1674 1675=head2 $class_name = $manager->volume_class([$new_class]) 1676 1677Get or set the name of the perl package that implements staging 1678volumes, VM::EC2::Staging::Volume by default. Staging volumes created 1679by the manager will have this class type. 1680 1681=head2 $class_name = $manager->server_class([$new_class]) 1682 1683Get or set the name of the perl package that implements staging 1684servers, VM::EC2::Staging::Server by default. Staging servers created 1685by the manager will have this class type. 1686 1687=head2 $boolean = $manager->scan([$boolean]) 1688 1689Get or set the "scan" flag, which if true will cause the zone to be 1690scanned quickly for existing managed servers and volumes when the 1691manager is first created. 1692 1693=head2 $path = $manager->dot_directory([$new_directory]) 1694 1695Get or set the dot directory which holds private key files. 1696 1697=cut 1698 1699sub dot_directory { 1700 my $self = shift; 1701 my $dir = $self->dotdir; 1702 unless (-e $dir && -d $dir) { 1703 mkdir $dir or croak "mkdir $dir: $!"; 1704 chmod 0700,$dir or croak "chmod 0700 $dir: $!"; 1705 } 1706 return $dir; 1707} 1708 1709=head1 Internal Methods 1710 1711This section documents internal methods that are not normally called 1712by end-user scripts but may be useful in subclasses. In addition, 1713there are a number of undocumented internal methods that begin with 1714the "_" character. Explore the source code to learn about these. 1715 1716=head2 $ok = $manager->environment_ok 1717 1718This performs a check on the environment in which the module is 1719running. For this module to work properly, the ssh, rsync and dd 1720programs must be found in the PATH. If all three programs are found, 1721then this method returns true. 1722 1723This method can be called as an instance method or class method. 1724 1725=cut 1726 1727sub environment_ok { 1728 my $self = shift; 1729 foreach (qw(dd ssh rsync)) { 1730 chomp (my $path = `which $_`); 1731 return unless $path; 1732 } 1733 return 1; 1734} 1735 1736=head2 $name = $manager->default_verbosity 1737 1738Returns the default verbosity level (2: warning+informational messages). This 1739is overridden using -verbose at create time. 1740 1741=cut 1742 1743sub default_verbosity { VERBOSE_INFO } 1744 1745=head2 $name = $manager->default_exit_behavior 1746 1747Return the default exit behavior ("stop") when the manager terminates. 1748Intended to be overridden in subclasses. 1749 1750=cut 1751 1752sub default_exit_behavior { 'stop' } 1753 1754=head2 $name = $manager->default_image_name 1755 1756Return the default image name ('ubuntu-precise-12.04') for use in 1757creating new instances. Intended to be overridden in subclasses. 1758 1759=cut 1760 1761sub default_image_name { 'ubuntu-precise-12.04' }; # launches faster than precise 1762 1763=head2 $name = $manager->default_user_name 1764 1765Return the default user name ('ubuntu') for use in creating new 1766instances. Intended to be overridden in subclasses. 1767 1768=cut 1769 1770sub default_user_name { 'ubuntu' } 1771 1772=head2 $name = $manager->default_architecture 1773 1774Return the default instance architecture ('i386') for use in creating 1775new instances. Intended to be overridden in subclasses. 1776 1777=cut 1778 1779sub default_architecture { 'i386' } 1780 1781=head2 $name = $manager->default_root_type 1782 1783Return the default instance root type ('instance-store') for use in 1784creating new instances. Intended to be overridden in subclasses. Note 1785that this value is ignored if the exit behavior is "stop", in which case an 1786ebs-backed instance will be used. Also, the m1.micro instance type 1787does not come in an instance-store form, so ebs will be used in this 1788case as well. 1789 1790=cut 1791 1792sub default_root_type { 'instance-store'} 1793 1794=head2 $name = $manager->default_instance_type 1795 1796Return the default instance type ('m1.small') for use in 1797creating new instances. Intended to be overridden in subclasses. We default 1798to m1.small rather than a micro instance because the I/O in m1.small 1799is far faster than in t1.micro. 1800 1801=cut 1802 1803sub default_instance_type { 'm1.small' } 1804 1805=head2 $name = $manager->default_reuse_keys 1806 1807Return the default value of the -reuse_keys argument ('true'). This 1808value allows the manager to create an ssh keypair once, and use the 1809same one for all servers it creates over time. If false, then a new 1810keypair is created for each server and then discarded when the server 1811terminates. 1812 1813=cut 1814 1815sub default_reuse_keys { 1 } 1816 1817=head2 $name = $manager->default_reuse_volumes 1818 1819Return the default value of the -reuse_volumes argument ('true'). This 1820value instructs the manager to use the symbolic name of the volume to 1821return an existing volume whenever a request is made to provision a 1822new one of the same name. 1823 1824=cut 1825 1826sub default_reuse_volumes { 1 } 1827 1828=head2 $path = $manager->default_dot_directory_path 1829 1830Return the default value of the -dotdir argument 1831("$ENV{HOME}/.vm-ec2-staging"). This value instructs the manager to 1832use the symbolic name of the volume to return an existing volume 1833whenever a request is made to provision a new one of the same name. 1834 1835=cut 1836 1837sub default_dot_directory_path { 1838 my $class = shift; 1839 my $dir = File::Spec->catfile($ENV{HOME},'.vm-ec2-staging'); 1840 return $dir; 1841} 1842 1843=head2 $class_name = $manager->default_volume_class 1844 1845Return the class name for staging volumes created by the manager, 1846VM::EC2::Staging::Volume by default. If you wish a subclass of 1847VM::EC2::Staging::Manager to create a different type of volume, 1848override this method. 1849 1850=cut 1851 1852sub default_volume_class { 1853 return 'VM::EC2::Staging::Volume'; 1854} 1855 1856=head2 $class_name = $manager->default_server_class 1857 1858Return the class name for staging servers created by the manager, 1859VM::EC2::Staging::Server by default. If you wish a subclass of 1860VM::EC2::Staging::Manager to create a different type of volume, 1861override this method. 1862 1863=cut 1864 1865sub default_server_class { 1866 return 'VM::EC2::Staging::Server'; 1867} 1868 1869=head2 $server = $manager->register_server($server) 1870 1871Register a VM::EC2::Staging::Server object. Usually called 1872internally. 1873 1874=cut 1875 1876sub register_server { 1877 my $self = shift; 1878 my $server = shift; 1879 sleep 1; # AWS lag bugs 1880 my $zone = $server->placement; 1881 $Zones{$zone}{Servers}{$server} = $server; 1882 $Instances{$server->instance} = $server; 1883 return $self->_increment_usage_count($server); 1884} 1885 1886=head2 $manager->unregister_server($server) 1887 1888Forget about the existence of VM::EC2::Staging::Server. Usually called 1889internally. 1890 1891=cut 1892 1893sub unregister_server { 1894 my $self = shift; 1895 my $server = shift; 1896 my $zone = eval{$server->placement} or return; # avoids problems at global destruction 1897 delete $Zones{$zone}{Servers}{$server}; 1898 delete $Instances{$server->instance}; 1899 return $self->_decrement_usage_count($server); 1900} 1901 1902=head2 $manager->register_volume($volume) 1903 1904Register a VM::EC2::Staging::Volume object. Usually called 1905internally. 1906 1907=cut 1908 1909sub register_volume { 1910 my $self = shift; 1911 my $vol = shift; 1912 $self->_increment_usage_count($vol); 1913 $Zones{$vol->availabilityZone}{Volumes}{$vol} = $vol; 1914 $Volumes{$vol->volumeId} = $vol; 1915} 1916 1917=head2 $manager->unregister_volume($volume) 1918 1919Forget about a VM::EC2::Staging::Volume object. Usually called 1920internally. 1921 1922=cut 1923 1924sub unregister_volume { 1925 my $self = shift; 1926 my $vol = shift; 1927 my $zone = $vol->availabilityZone; 1928 $self->_decrement_usage_count($vol); 1929 delete $Zones{$zone}{$vol}; 1930 delete $Volumes{$vol->volumeId}; 1931} 1932 1933=head2 $pid = $manager->pid([$new_pid]) 1934 1935Get or set the process ID of the script that is running the 1936manager. This is used internally to detect the case in which the 1937script has forked, in which case we do not want to invoke the manager 1938class's destructor in the child process (because it may stop or 1939terminate servers still in use by the parent process). 1940 1941=head2 $path = $manager->dotdir([$new_dotdir]) 1942 1943Low-level version of dot_directory(), differing only in the fact that 1944dot_directory will automatically create the path, including subdirectories. 1945 1946=cut 1947 1948=head2 $manager->scan_region 1949 1950Synchronize internal list of managed servers and volumes with the EC2 1951region. Called automatically during new() and needed only if servers & 1952volumes are changed from outside the module while it is running. 1953 1954=cut 1955 1956# scan for staging instances in current region and cache them 1957# into memory 1958# status should be... 1959# -on_exit => {'terminate','stop','run'} 1960sub scan_region { 1961 my $self = shift; 1962 my $ec2 = shift || $self->ec2; 1963 $self->_scan_instances($ec2); 1964 $self->_scan_volumes($ec2); 1965} 1966 1967sub _scan_instances { 1968 my $self = shift; 1969 my $ec2 = shift; 1970 my @instances = $ec2->describe_instances({'tag:StagingRole' => 'StagingInstance', 1971 'instance-state-name' => ['running','stopped']}); 1972 for my $instance (@instances) { 1973 my $keyname = $instance->keyName or next; 1974 my $keyfile = $self->_check_keyfile($keyname) or next; 1975 my $username = $instance->tags->{'StagingUsername'} or next; 1976 my $name = $instance->tags->{StagingName} || $self->new_server_name; 1977 my $server = $self->server_class()->new( 1978 -name => $name, 1979 -keyfile => $keyfile, 1980 -username => $username, 1981 -instance => $instance, 1982 -manager => $self, 1983 ); 1984 $self->register_server($server); 1985 } 1986} 1987 1988sub _scan_volumes { 1989 my $self = shift; 1990 my $ec2 = shift; 1991 1992 # now the volumes 1993 my @volumes = $ec2->describe_volumes(-filter=>{'tag:StagingRole' => 'StagingVolume', 1994 'status' => ['available','in-use']}); 1995 for my $volume (@volumes) { 1996 my $status = $volume->status; 1997 my $zone = $volume->availabilityZone; 1998 1999 my %args; 2000 $args{-endpoint} = $self->ec2->endpoint; 2001 $args{-volume} = $volume; 2002 $args{-name} = $volume->tags->{StagingName}; 2003 $args{-fstype} = $volume->tags->{StagingFsType}; 2004 $args{-mtpt} = $volume->tags->{StagingMtPt}; 2005 my $mounted; 2006 2007 if (my $attachment = $volume->attachment) { 2008 my $server = $self->find_server_by_instance($attachment->instance); 2009 $args{-server} = $server; 2010 ($args{-mtdev},$mounted) = $server->ping && 2011 $server->_find_mount($attachment->device); 2012 } 2013 2014 my $vol = $self->volume_class()->new(%args); 2015 $vol->mounted(1) if $mounted; 2016 $self->register_volume($vol); 2017 } 2018} 2019 2020=head2 $group = $manager->security_group 2021 2022Returns or creates a security group with the permissions needed used 2023to manage staging servers. Usually called internally. 2024 2025=cut 2026 2027sub security_group { 2028 my $self = shift; 2029 return $self->{security_group} ||= $self->_security_group(); 2030} 2031 2032=head2 $keypair = $manager->keypair 2033 2034Returns or creates the ssh keypair used internally by the manager to 2035to access staging servers. Usually called internally. 2036 2037=cut 2038 2039sub keypair { 2040 my $self = shift; 2041 return $self->{keypair} ||= $self->_new_keypair(); 2042} 2043 2044sub _security_key { 2045 my $self = shift; 2046 my $ec2 = $self->ec2; 2047 if ($self->reuse_key) { 2048 my @candidates = $ec2->describe_key_pairs(-filter=>{'key-name' => 'staging-key-*'}); 2049 for my $c (@candidates) { 2050 my $name = $c->keyName; 2051 my $keyfile = $self->_key_path($name); 2052 return ($c,$keyfile) if -e $keyfile; 2053 } 2054 } 2055 my $name = $self->_token('staging-key'); 2056 $self->info("Creating keypair $name.\n"); 2057 my $kp = $ec2->create_key_pair($name) or die $ec2->error_str; 2058 my $keyfile = $self->_key_path($name); 2059 my $private_key = $kp->privateKey; 2060 open my $k,'>',$keyfile or die "Couldn't create $keyfile: $!"; 2061 chmod 0600,$keyfile or die "Couldn't chmod $keyfile: $!"; 2062 print $k $private_key; 2063 close $k; 2064 return ($kp,$keyfile); 2065} 2066 2067sub _security_group { 2068 my $self = shift; 2069 my $ec2 = $self->ec2; 2070 my @groups = $ec2->describe_security_groups(-filter=>{'tag:StagingRole' => 'StagingGroup'}); 2071 return $groups[0] if @groups; 2072 my $name = $self->_token('ssh'); 2073 $self->info("Creating staging security group $name.\n"); 2074 my $sg = $ec2->create_security_group(-name => $name, 2075 -description => "SSH security group created by ".__PACKAGE__ 2076 ) or die $ec2->error_str; 2077 $sg->authorize_incoming(-protocol => 'tcp', 2078 -port => 'ssh'); 2079 $sg->update or die $ec2->error_str; 2080 $sg->add_tag(StagingRole => 'StagingGroup'); 2081 return $sg; 2082 2083} 2084 2085=head2 $name = $manager->new_volume_name 2086 2087Returns a new random name for volumes provisioned without a -name 2088argument. Currently names are in of the format "volume-12345678", 2089where the numeric part are 8 random hex digits. Although no attempt is 2090made to prevent naming collisions, the large number of possible names 2091makes this unlikely. 2092 2093=cut 2094 2095sub new_volume_name { 2096 return shift->_token('volume'); 2097} 2098 2099=head2 $name = $manager->new_server_name 2100 2101Returns a new random name for server provisioned without a -name 2102argument. Currently names are in of the format "server-12345678", 2103where the numeric part are 8 random hex digits. Although no attempt 2104is made to prevent naming collisions, the large number of possible 2105names makes this unlikely. 2106 2107=cut 2108 2109sub new_server_name { 2110 return shift->_token('server'); 2111} 2112 2113sub _token { 2114 my $self = shift; 2115 my $base = shift or croak "usage: _token(\$basename)"; 2116 return sprintf("$base-%08x",1+int(rand(0xFFFFFFFF))); 2117} 2118 2119=head2 $description = $manager->volume_description($volume) 2120 2121This method is called to assign a description to newly-created 2122volumes. The current format is "Staging volume for Foo created by 2123VM::EC2::Staging::Manager", where Foo is the volume's symbolic name. 2124 2125=cut 2126 2127sub volume_description { 2128 my $self = shift; 2129 my $vol = shift; 2130 my $name = ref $vol ? $vol->name : $vol; 2131 return "Staging volume for $name created by ".__PACKAGE__; 2132} 2133 2134=head2 $manager->debug("Debugging message\n") 2135 2136=head2 $manager->info("Informational message\n") 2137 2138=head2 $manager->warn("Warning message\n") 2139 2140Prints an informational message to standard error if current 2141verbosity() level allows. 2142 2143=cut 2144 2145sub info { 2146 my $self = shift; 2147 return if $self->verbosity < VERBOSE_INFO; 2148 my @lines = split "\n",longmess(); 2149 my $stack_count = grep /VM::EC2::Staging::Manager/,@lines; 2150 print STDERR '[info] ',' ' x (($stack_count-1)*3),@_; 2151} 2152 2153sub warn { 2154 my $self = shift; 2155 return if $self->verbosity < VERBOSE_WARN; 2156 my @lines = split "\n",longmess(); 2157 my $stack_count = grep /VM::EC2::Staging::Manager/,@lines; 2158 print STDERR '[warn] ',' ' x (($stack_count-1)*3),@_; 2159} 2160 2161sub debug { 2162 my $self = shift; 2163 return if $self->verbosity < VERBOSE_DEBUG; 2164 my @lines = split "\n",longmess(); 2165 my $stack_count = grep /VM::EC2::Staging::Manager/,@lines; 2166 print STDERR '[debug] ',' ' x (($stack_count-1)*3),@_; 2167} 2168 2169=head2 $verbosity = $manager->verbosity([$new_value]) 2170 2171The verbosity() method get/sets a flag that sets the level of 2172informational messages. 2173 2174=cut 2175 2176sub verbosity { 2177 my $self = shift; 2178 my $d = ref $self ? $self->verbose : $Verbose; 2179 if (@_) { 2180 $Verbose = shift; 2181 $self->verbose($Verbose) if ref $self; 2182 } 2183 return $d; 2184} 2185 2186 2187sub _search_for_image { 2188 my $self = shift; 2189 my %args = @_; 2190 my $name = $args{-image_name}; 2191 2192 $self->info("Searching for a staging image...\n"); 2193 2194 my $root_type = $self->on_exit eq 'stop' ? 'ebs' : $args{-root_type}; 2195 my @arch = $args{-architecture} ? ('architecture' => $args{-architecture}) : (); 2196 2197 my @candidates = $name =~ /^ami-[0-9a-f]+/ ? $self->ec2->describe_images($name) 2198 : $self->ec2->describe_images({'name' => "*$args{-image_name}*", 2199 'root-device-type' => $root_type, 2200 @arch}); 2201 return unless @candidates; 2202 # this assumes that the name has some sort of timestamp in it, which is true 2203 # of ubuntu images, but probably not others 2204 my ($most_recent) = sort {$b->name cmp $a->name} @candidates; 2205 $self->info("...found $most_recent: ",$most_recent->name,".\n"); 2206 return $most_recent; 2207} 2208 2209sub _gather_image_info { 2210 my $self = shift; 2211 my $image = shift; 2212 return { 2213 name => $image->name, 2214 description => $image->description, 2215 architecture => $image->architecture, 2216 kernel => $image->kernelId || undef, 2217 ramdisk => $image->ramdiskId || undef, 2218 root_device => $image->rootDeviceName, 2219 block_devices=> [$image->blockDeviceMapping], 2220 is_public => $image->isPublic, 2221 platform => $image->platform, 2222 virtualizationType => $image->virtualizationType, 2223 hypervisor => $image->hypervisor, 2224 authorized_users => [$image->authorized_users], 2225 }; 2226} 2227 2228sub _parse_destination { 2229 my $self = shift; 2230 my $destination = shift; 2231 2232 my $ec2 = $self->ec2; 2233 my $dest_manager; 2234 if (ref $destination && $destination->isa('VM::EC2::Staging::Manager')) { 2235 $dest_manager = $destination; 2236 } else { 2237 my $dest_region = ref $destination && $destination->isa('VM::EC2::Region') 2238 ? $destination 2239 : $ec2->describe_regions($destination); 2240 $dest_region 2241 or croak "Invalid EC2 Region '$dest_region'; usage VM::EC2::Staging::Manager->copy_image(\$image,\$dest_region)"; 2242 my $dest_endpoint = $dest_region->regionEndpoint; 2243 my $dest_ec2 = VM::EC2->new(-endpoint => $dest_endpoint, 2244 -access_key => $ec2->access_key, 2245 -secret_key => $ec2->secret) 2246 or croak "Could not create new VM::EC2 in $dest_region"; 2247 2248 $dest_manager = $self->new(-ec2 => $dest_ec2, 2249 -scan => $self->scan, 2250 -on_exit => 'destroy', 2251 -instance_type => $self->instance_type); 2252 } 2253 2254 return $dest_manager; 2255} 2256 2257sub match_kernel { 2258 my $self = shift; 2259 my ($src_kernel,$dest) = @_; 2260 my $dest_manager = $self->_parse_destination($dest) or croak "could not create destination manager for $dest"; 2261 return $self->_match_kernel($src_kernel,$dest_manager,'kernel'); 2262} 2263 2264sub _match_kernel { 2265 my $self = shift; 2266 my ($imageId,$dest_manager) = @_; 2267 my $home_ec2 = $self->ec2; 2268 my $dest_ec2 = $dest_manager->ec2; # different endpoints! 2269 my $image = $home_ec2->describe_images($imageId) or return; 2270 my $type = $image->imageType; 2271 my @candidates; 2272 2273 if (my $name = $image->name) { # will sometimes have a name 2274 @candidates = $dest_ec2->describe_images({'name' => $name, 2275 'image-type' => $type, 2276 }); 2277 } 2278 unless (@candidates) { 2279 my $location = $image->imageLocation; # will always have a location 2280 my @path = split '/',$location; 2281 $location = $path[-1]; 2282 @candidates = $dest_ec2->describe_images(-filter=>{'image-type'=>'kernel', 2283 'manifest-location'=>"*/$location"}, 2284 -executable_by=>['all','self']); 2285 } 2286 unless (@candidates) { # go to approximate match 2287 my $location = $image->imageLocation; 2288 my @path = split '/',$location; 2289 my @kernels = $dest_ec2->describe_images(-filter=>{'image-type'=>'kernel', 2290 'manifest-location'=>"*/*"}, 2291 -executable_by=>['all','self']); 2292 my %k = map {$_=>$_} @kernels; 2293 my %locations = map {my $l = $_->imageLocation; 2294 my @path = split '/',$l; 2295 $_ => \@path} @kernels; 2296 2297 my %level0 = map {$_ => abs(adistr($path[0],$locations{$_}[0]))} keys %locations; 2298 my %level1 = map {$_ => abs(adistr($path[1],$locations{$_}[1]))} keys %locations; 2299 @candidates = sort {$level0{$a}<=>$level0{$b} || $level1{$a}<=>$level1{$b}} keys %locations; 2300 @candidates = map {$k{$_}} @candidates; 2301 } 2302 return $candidates[0]; 2303} 2304 2305# find the most likely ramdisk for a kernel based on preponderant configuration of public images 2306sub _guess_ramdisk { 2307 my $self = shift; 2308 my $kernel = shift; 2309 my $ec2 = $self->ec2; 2310 my @images = $ec2->describe_images({'image-type' => 'machine', 2311 'kernel-id' => $kernel}); 2312 my %ramdisks; 2313 2314 foreach (@images) { 2315 $ramdisks{$_->ramdiskId}++; 2316 } 2317 2318 my ($highest) = sort {$ramdisks{$b}<=>$ramdisks{$a}} keys %ramdisks; 2319 return $highest; 2320} 2321 2322sub _check_keyfile { 2323 my $self = shift; 2324 my $keyname = shift; 2325 my $dotpath = $self->dot_directory; 2326 opendir my $d,$dotpath or die "Can't opendir $dotpath: $!"; 2327 while (my $file = readdir($d)) { 2328 if ($file =~ /^$keyname.pem/) { 2329 return $1,$self->_key_path($keyname,$1); 2330 } 2331 } 2332 closedir $d; 2333 return; 2334} 2335 2336sub _select_server_by_zone { 2337 my $self = shift; 2338 my $zone = shift; 2339 my @servers = values %{$Zones{$zone}{Servers}}; 2340 return $servers[0]; 2341} 2342 2343sub _select_used_zone { 2344 my $self = shift; 2345 if (my @servers = $self->servers) { 2346 my @up = grep {$_->ping} @servers; 2347 my $server = $up[0] || $servers[0]; 2348 return $server->placement; 2349 } elsif (my $zone = $self->availability_zone) { 2350 return $zone; 2351 } else { 2352 return; 2353 } 2354} 2355 2356sub _key_path { 2357 my $self = shift; 2358 my $keyname = shift; 2359 return File::Spec->catfile($self->dot_directory,"${keyname}.pem") 2360} 2361 2362# can be called as a class method 2363sub _find_server_in_zone { 2364 my $self = shift; 2365 my $zone = shift; 2366 my @servers = sort {$a->ping cmp $b->ping} values %{$Zones{$zone}{Servers}}; 2367 return unless @servers; 2368 return $servers[-1]; 2369} 2370 2371sub _servers { 2372 my $self = shift; 2373 my $endpoint = shift; # optional 2374 my @servers = values %Instances; 2375 return @servers unless $endpoint; 2376 return grep {$_->ec2->endpoint eq $endpoint} @servers; 2377} 2378 2379sub _lock { 2380 my $self = shift; 2381 my ($resource,$lock_type) = @_; 2382 $lock_type eq 'SHARED' || $lock_type eq 'EXCLUSIVE' 2383 or croak "Usage: _lock(\$resource,'SHARED'|'EXCLUSIVE')"; 2384 2385 $resource->refresh; 2386 my $tags = $resource->tags; 2387 if (my $value = $tags->{StagingLock}) { 2388 my ($type,$pid) = split /\s+/,$value; 2389 2390 if ($pid eq $$) { # we've already got lock 2391 $resource->add_tags(StagingLock=>"$lock_type $$") 2392 unless $type eq $lock_type; 2393 return 1; 2394 } 2395 2396 if ($lock_type eq 'SHARED' && $type eq 'SHARED') { 2397 return 1; 2398 } 2399 2400 # wait for lock 2401 eval { 2402 local $SIG{ALRM} = sub {die 'timeout'}; 2403 alarm(LOCK_TIMEOUT); # we get lock eventually one way or another 2404 while (1) { 2405 $resource->refresh; 2406 last unless $resource->tags->{StagingLock}; 2407 sleep 1; 2408 } 2409 }; 2410 alarm(0); 2411 } 2412 $resource->add_tags(StagingLock=>"$lock_type $$"); 2413 return 1; 2414} 2415 2416sub _unlock { 2417 my $self = shift; 2418 my $resource = shift; 2419 $resource->refresh; 2420 my $sl = $resource->tags->{StagingLock} or return; 2421 my ($type,$pid) = split /\s+/,$sl; 2422 return unless $pid eq $$; 2423 $resource->delete_tags('StagingLock'); 2424} 2425 2426sub _safe_update_tag { 2427 my $self = shift; 2428 my ($resource,$tag,$value) = @_; 2429 $self->_lock($resource,'EXCLUSIVE'); 2430 $resource->add_tag($tag => $value); 2431 $self->_unlock($resource); 2432} 2433 2434sub _safe_read_tag { 2435 my $self = shift; 2436 my ($resource,$tag) = @_; 2437 $self->_lock($resource,'SHARED'); 2438 my $value = $resource->tags->{$tag}; 2439 $self->_unlock($resource); 2440 return $value; 2441} 2442 2443 2444sub _increment_usage_count { 2445 my $self = shift; 2446 my $resource = shift; 2447 $self->_lock($resource,'EXCLUSIVE'); 2448 my $in_use = $resource->tags->{'StagingInUse'} || 0; 2449 $resource->add_tags(StagingInUse=>$in_use+1); 2450 $self->_unlock($resource); 2451 $in_use+1; 2452} 2453 2454sub _decrement_usage_count { 2455 my $self = shift; 2456 my $resource = shift; 2457 2458 $self->_lock($resource,'EXCLUSIVE'); 2459 my $in_use = $resource->tags->{'StagingInUse'} || 0; 2460 $in_use--; 2461 if ($in_use > 0) { 2462 $resource->add_tags(StagingInUse=>$in_use); 2463 } else { 2464 $resource->delete_tags('StagingInUse'); 2465 $in_use = 0; 2466 } 2467 $self->_unlock($resource); 2468 return $in_use; 2469} 2470 2471sub _dots_cmd { 2472 my $self = shift; 2473 return '' unless $self->verbosity == VERBOSE_INFO; 2474 my ($fh,$dots_script) = tempfile('dots_XXXXXXX',SUFFIX=>'.pl',UNLINK=>1,TMPDIR=>1); 2475 print $fh $self->_dots_script; 2476 close $fh; 2477 chmod 0755,$dots_script; 2478 return "2>&1|$dots_script t"; 2479} 2480 2481sub _upload_dots_script { 2482 my $self = shift; 2483 my $server = shift; 2484 my $fh = $server->scmd_write('cat >/tmp/dots.pl'); 2485 print $fh $self->_dots_script; 2486 close $fh; 2487 $server->ssh('chmod +x /tmp/dots.pl'); 2488} 2489 2490sub _dots_script { 2491 my $self = shift; 2492 my @lines = split "\n",longmess(); 2493 my $stack_count = grep /VM::EC2::Staging::Manager/,@lines; 2494 my $spaces = ' ' x (($stack_count-1)*3); 2495 return <<END; 2496#!/usr/bin/perl 2497my \$mode = shift || 'b'; 2498print STDERR "[info] ${spaces}One dot equals ",(\$mode eq 'b'?'100 Mb':'100 files'),': '; 2499my \$b; 2500 READ: 2501 while (1) { 2502 do {read(STDIN,\$b,1e5) || last READ for 1..1000} if \$mode eq 'b'; 2503 do {<> || last READ for 1.. 100} if \$mode eq 't'; 2504 print STDERR '.'; 2505} 2506print STDERR ".\n"; 2507END 2508} 2509 2510sub DESTROY { 2511 my $self = shift; 2512 if ($$ == $self->pid) { 2513 my $action = $self->on_exit; 2514 $self->terminate_all_servers if $action eq 'terminate'; 2515 $self->stop_all_servers if $action eq 'stop'; 2516 } 2517 delete $Managers{$self->ec2->endpoint}; 2518} 2519 2520 2521 25221; 2523 2524 2525=head1 SEE ALSO 2526 2527L<VM::EC2> 2528L<VM::EC2::Staging::Server> 2529L<VM::EC2::Staging::Volume> 2530L<migrate-ebs-image.pl> 2531 2532=head1 AUTHOR 2533 2534Lincoln Stein E<lt>lincoln.stein@gmail.comE<gt>. 2535 2536Copyright (c) 2012 Ontario Institute for Cancer Research 2537 2538This package and its accompanying libraries is free software; you can 2539redistribute it and/or modify it under the terms of the GPL (either 2540version 1, or at your option, any later version) or the Artistic 2541License 2.0. Refer to LICENSE for the full license text. In addition, 2542please see DISCLAIMER.txt for disclaimers of warranty. 2543 2544=cut 2545 2546