1package VM::EC2::Staging::Server; 2 3# high level interface for transferring data, and managing data snapshots 4# via a series of Staging VMs. 5 6=head1 NAME 7 8VM::EC2::Staging::Server - High level interface to EC2-based servers 9 10=head1 SYNOPSIS 11 12 use VM::EC2::Staging::Manager; 13 14 # get a new staging manager 15 my $ec2 = VM::EC2->new; 16 my $staging = $ec2->staging_manager(); ); 17 18 # Fetch a server named 'my_server'. Create it if it does not already exist. 19 my $server1 = $staging->get_server(-name => 'my_server', 20 -availability_zone => 'us-east-1a', 21 -architecture => 'i386', 22 -instance_type => 't1.micro'); 23 24 # As above, but force a new server to be provisioned. 25 my $server2 = $staging->provision_server(-name => 'my_server', 26 -availability_zone => 'us-east-1a', 27 -architecture => 'i386', 28 -instance_type => 't1.micro'); 29 30 # open up a terminal emulator in a separate window 31 $server1->shell; 32 33 # Run a command over ssh on the server. Standard in and out will be connected to 34 # STDIN/OUT 35 $server1->ssh('whoami'); 36 37 # run a command over ssh on the server, returning standard output as an array of lines or a 38 # scalar string, similar to backticks (``) 39 my @password_lines = $server1->scmd('cat /etc/passwd'); 40 41 # run a command on the server and read from it using a filehandle 42 my $fh = $server1->scmd_read('ls -R /usr/lib'); 43 while (<$fh>) { # do something } 44 45 # run a command on the server and write to it using a filehandle 46 my $fh = $server1->scmd_write('sudo -s "cat >>/etc/fstab"'); 47 print $fh "/dev/sdf3 /mnt/demo ext3 0 2\n"; 48 close $fh; 49 50 # provision and mount a 5 gig ext3 volume mounted on /opt, returning 51 # VM::EC2::Staging::Volume object 52 my $opt = $server1->provision_volume(-mtpt => '/opt', 53 -fstype => 'ext3', 54 -size => 5); 55 56 # copy some data from the local filesystem onto the opt volume 57 $server1->rsync("$ENV{HOME}/local_staging_volume/" => $opt); 58 59 # same thing, but using server path name 60 $server1->put("$ENV{HOME}/local_staging_volume/" => '/opt'); 61 62 # provision a volume attached to another server, and let the 63 # system choose the filesystem and mount point for us 64 my $backups = $server2->provision_volume(-name => 'Backup', 65 -size => 10); 66 67 # copy some data from opt to the new volume using rsync 68 $server1->rsync($opt => "$backups/opt"); 69 70 # Do a block-level copy between disks - warning, the filesystem must be unmounted 71 # before you attempt this. 72 $backups->unmount; 73 $server1->dd($opt => $backups); 74 75=head1 DESCRIPTION 76 77VM::EC2::Staging::Server objects are an extension of VM::EC2::Instance 78to allow for higher-level access, including easy management of ssh 79keys, remote copying of data from one server to another, and executing 80of remote commands on the server from within Perl. See 81L<VM::EC2::Staging::Manager> for an overview of staging servers and 82volumes. 83 84Note that proper functioning of this module is heavily dependent on 85running on a host system that has access to ssh, rsync and terminal 86emulator command-line tools. It will most likely fail when run on a 87Windows host. 88 89=cut 90 91use strict; 92use VM::EC2; 93use Carp 'croak'; 94use Scalar::Util 'weaken'; 95use File::Spec; 96use File::Path 'make_path','remove_tree'; 97use File::Basename 'dirname'; 98use POSIX 'setsid'; 99use overload 100 '""' => sub {my $self = shift; 101 return $self->short_name; # "inherited" from VM::EC2::Server 102}, 103 fallback => 1; 104 105use constant GB => 1_073_741_824; 106 107our $AUTOLOAD; 108sub AUTOLOAD { 109 my $self = shift; 110 my ($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/; 111 return if $func_name eq 'DESTROY'; 112 my $inst = eval {$self->instance} or croak "Can't locate object method \"$func_name\" via package \"$pack\"";; 113 return $inst->$func_name(@_); 114} 115 116sub can { 117 my $self = shift; 118 my $method = shift; 119 120 my $can = $self->SUPER::can($method); 121 return $can if $can; 122 123 my $inst = $self->instance or return; 124 return $inst->can($method); 125} 126 127=head1 Staging Server Creation 128 129Staging servers are usually created via a staging manager's 130get_server() or provision_server() methods. See L<VM::EC2::Staging::Manager>. 131 132There is also a new() class method that is intended to be used 133internally in most cases. It is called like this: 134 135=head2 $server = VM::EC2::Staging::Server->new(%args) 136 137With the arguments: 138 139 -keyfile path to the ssh public/private keyfile for this instance 140 -username username for remote login on this instance 141 -instance VM::EC2::Instance to attach this server to 142 -manager VM::EC2::Staging::Manager in same zone as the instance 143 144Note that you will have to launch a staging manager, start an 145instance, and appropriate provision the SSH credentials for that 146instance before invoking new() directly. 147 148=cut 149 150sub new { 151 my $class = shift; 152 my %args = @_; 153 $args{-keyfile} or croak 'need -keyfile path'; 154 $args{-username} or croak 'need -username'; 155 $args{-instance} or croak 'need a -instance VM::EC2::Instance argument'; 156 $args{-manager} or croak 'need a -manager argument'; 157 158 my $endpoint = $args{-manager}->ec2->endpoint; 159 my $self = bless { 160 endpoint => $endpoint, 161 instance => $args{-instance}, 162 username => $args{-username}, 163 keyfile => $args{-keyfile}, 164 name => $args{-name} || undef, 165 },ref $class || $class; 166 return $self; 167} 168 169=head1 Information about the Server 170 171VM::EC2::Staging::Server objects have all the methods of 172VM::EC2::Instance, such as dnsName(), but add several new methods. The 173new methods involving getting basic information about the server are 174listed in this section. 175 176=head2 $name = $server->name 177 178This method returns the server's symbolic name, if any. 179 180Servers can optionally be assigned a symbolic name at the time they 181are created by the manager's get_server() or provision_server() 182methods. The name persists as long as the underlying instance exists 183(including in stopped state for EBS-backed instances). Calling 184$manager->get_server() with this name returns the server object. 185 186=cut 187 188sub name { shift->{name} } 189 190=head2 $ec2 = $server->ec2 191 192Return the VM::EC2 object associated with the server. 193 194=cut 195 196sub ec2 { shift->manager->ec2 } 197 198=head2 $ec2 = $server->endpoint 199 200Return the endpoint URL associated with this server. 201 202=cut 203 204sub endpoint { shift->{endpoint} } 205 206=head2 $instance = $server->instance 207 208Return the VM::EC2::Instance associated with this server. 209 210=cut 211 212sub instance { shift->{instance} } 213 214=head2 $file = $server->keyfile 215 216Return the full path to the SSH PEM keyfile used to log into this 217server. 218 219=cut 220 221sub keyfile { shift->{keyfile} } 222 223=head2 $user = $server->username 224 225Return the name of the user (e.g. 'ubuntu') used to ssh into this 226server. 227 228=cut 229 230sub username { 231 my $self = shift; 232 my $d = $self->{username}; 233 $self->{username} = shift if @_; 234 $d; 235} 236 237=head2 $manager = $server->manager 238 239Returns the VM::EC2::Staging::Manager that manages this server. 240 241=cut 242 243sub manager { 244 my $self = shift; 245 my $ep = $self->endpoint; 246 return VM::EC2::Staging::Manager->find_manager($ep); 247} 248 249=head1 Lifecycle Methods 250 251The methods in this section manage the lifecycle of a server. 252 253=head2 $flag = $server->ping 254 255The ping() method returns true if the server is running and is 256reachable via ssh. It is different from checking that the underlying 257instance is "running" via a call to current_status, because it also 258checks the usability of the ssh daemon, the provided ssh key and 259username, firewall rules, and the network connectivity. 260 261The result of ping is cached so that subsequent invocations return 262quickly. 263 264=cut 265 266sub ping { 267 my $self = shift; 268 return unless $self->instance->status eq 'running'; 269 return 1 if $self->is_up; 270 return unless $self->ssh('pwd >/dev/null 2>&1'); 271 $self->is_up(1); 272 return 1; 273} 274 275=head2 $result = $server->start 276 277Attempt to start a stopped server. The method will wait until a ping() 278is successful, or until a timeout of 120 seconds. The result code will 279be true if the server was successfully started and is reachable. 280 281If you wish to start a set of servers without waiting for each one 282individually, then you may call the underling instance's start() 283method: 284 285 $server->instance->start; 286 287You may then wish to call the staging manager's wait_for_instances() 288method to wait on all of the servers to start: 289 290 $manager->wait_for_servers(@servers); 291 292Also check out $manager->start_all_servers(). 293 294=cut 295 296 297sub start { 298 my $self = shift; 299 return if $self->is_up; 300 $self->manager->info("Starting staging server\n"); 301 eval { 302 local $SIG{ALRM} = sub {die 'timeout'}; 303 alarm(VM::EC2::Staging::Manager::SERVER_STARTUP_TIMEOUT()); 304 $self->ec2->start_instances($self); 305 $self->manager->wait_for_servers($self); 306 }; 307 alarm(0); 308 if ($@) { 309 $self->manager->warn("could not start $self\n"); 310 return; 311 } 312 $self->is_up(1); 313 1; 314} 315 316=head2 $result = $server->stop 317 318Attempt to stop a running server. The method will wait until the 319server has entered the "stopped" state before returning. It will 320return a true result if the underlying instance stopped successfully. 321 322If you wish to stop a set of servers without waiting for each one 323individually, then you may call the underling instance's start() 324method: 325 326 $server->instance->stop; 327 328You may then wish to call the staging manager's wait_for_instances() 329method to wait on all of the servers to start: 330 331 $status = $manager->wait_for_servers(@servers); 332 333Also check out $manager->stop_all_servers(). 334 335=cut 336 337sub stop { 338 my $self = shift; 339 return unless $self->instance->status eq 'running'; 340 $self->instance->stop; 341 $self->is_up(0); 342 my $status = $self->manager->wait_for_instances($self); 343 return $status->{$self->instance} eq 'stopped'; 344} 345 346=head2 $result = $server->terminate 347 348Terminate a server and unregister it from the manager. This method 349will stop and wait until the server is terminated. 350 351If you wish to stop a set of servers without waiting for each one 352individually, then you may call the underling instance's start() 353method: 354 355 $server->instance->terminate; 356 357=cut 358 359sub terminate { 360 my $self = shift; 361 $self->manager->_terminate_servers($self); 362 $self->is_up(0); 363 1; 364} 365 366=head1 Remote Shell Methods 367 368The methods in this section allow you to run remote commands on the 369staging server and interrogate the results. Since the staging manager 370handles the creation of SSH keys internally, you do not need to worry 371about finding the right public/private keypair. 372 373=head2 $result = $server->ssh(@command) 374 375The ssh() method invokes a command on the remote server. You may 376provide the command line as a single string, or broken up by argument: 377 378 $server->ssh('ls -lR /var/log'); 379 $server->ssh('ls','-lR','/var/log'); 380 381The output of the command will appear on STDOUT and STDERR of the perl 382process. Input, if needed, will be read from STDIN. If no command is 383provided, then an interactive ssh session will be started on the 384remote server and the script will wait until you have logged out. 385 386If the remote command was successful, the method result will be true. 387 388=cut 389 390sub ssh { 391 my $self = shift; 392 393 my @extra_args; 394 if (ref($_[0]) && ref($_[0]) eq 'ARRAY') { 395 my $extra = shift; 396 @extra_args = @$extra; 397 } 398 my @cmd = @_; 399 my $Instance = $self->instance or die "Remote instance not set up correctly"; 400 my $host = $Instance->dnsName; 401 system('ssh',$self->_ssh_args,@extra_args,$host,@cmd)==0; 402} 403 404=head2 $output = $server->scmd(@command) 405 406This is similar to ssh(), except that the standard output of the 407remote command will be captured and returned as the function result, 408similar to the way backticks work in perl: 409 410 my $output = $server->scmd('date'); 411 print "The localtime for the server is $output"; 412 413=cut 414 415sub scmd { 416 my $self = shift; 417 my @extra_args; 418 if (ref($_[0]) && ref($_[0]) eq 'ARRAY') { 419 my $extra = shift; 420 @extra_args = @$extra; 421 } 422 my @cmd = @_; 423 424 my $Instance = $self->instance or die "Remote instance not set up correctly"; 425 my $host = $Instance->dnsName; 426 427 my $pid = open my $kid,"-|"; #this does a fork 428 die "Couldn't fork: $!" unless defined $pid; 429 if ($pid) { 430 my @results; 431 while (<$kid>) { 432 push @results,$_; 433 } 434 close $kid; 435 if (wantarray) { 436 chomp(@results); 437 return @results; 438 } else { 439 return join '',@results; 440 } 441 } 442 443 # in child 444 exec 'ssh',$self->_ssh_args,@extra_args,$host,@cmd; 445} 446 447=head2 $fh = $server->scmd_write(@command) 448 449This method executes @command on the remote server, and returns a 450filehandle that is attached to the standard input of the command. Here 451is a slightly dangerous example that appends a line to /etc/passwd: 452 453 my $fh = $server->scmd_write('sudo -s "cat >>/etc/passwd"'); 454 print $fh "whoopsie:x:119:130::/nonexistent:/bin/false\n"; 455 close $fh; 456 457=cut 458 459# return a filehandle that you can write to: 460# e.g. 461# my $fh = $server->scmd_write('cat >/tmp/foobar'); 462# print $fh, "testing\n"; 463# close $fh; 464sub scmd_write { 465 my $self = shift; 466 return $self->_scmd_pipe('write',@_); 467} 468 469=head2 $fh = $server->scmd_read(@command) 470 471This method executes @command on the remote server, and returns a 472filehandle that is attached to the standard output of the command. Here 473is an example of reading syslog: 474 475 my $fh = $server->scmd_read('sudo cat /var/log/syslog'); 476 while (<$fh>) { 477 next unless /kernel/; 478 print $_; 479 } 480 close $fh; 481 482=cut 483 484# same thing, but you read from it: 485# my $fh = $server->scmd_read('cat /tmp/foobar'); 486# while (<$fh>) { 487# print $_; 488#} 489sub scmd_read { 490 my $self = shift; 491 return $self->_scmd_pipe('read',@_); 492} 493 494=head2 $server->shell() 495 496This method works in an X Windowing environment by launching a new 497terminal window and running an interactive ssh session on the server 498host. The terminal window is executed in a fork()ed session, so that 499the rest of the script continues running. If X Windows is not 500running, then the method behaves the same as calling ssh() with no 501arguments. 502 503The terminal emulator to run is determined by calling the method get_xterm(). 504 505=cut 506 507sub shell { 508 my $self = shift; 509 return $self->ssh() unless $ENV{DISPLAY}; 510 511 fork() && return; 512 setsid(); # so that we are independent of parent signals 513 my $host = $self->instance->dnsName; 514 my $ssh_args = $self->_ssh_escaped_args; 515 my $emulator = $self->get_xterm; 516 exec $emulator,'-e',"ssh $ssh_args $host" or die "$emulator: $!"; 517} 518 519sub get_xterm { 520 my $self = shift; 521 return 'xterm'; 522} 523 524sub _ssh_args { 525 my $self = shift; 526 return ( 527 '-o','CheckHostIP no', 528 '-o','StrictHostKeyChecking no', 529 '-o','UserKnownHostsFile /dev/null', 530 '-o','LogLevel QUIET', 531 '-i',$self->keyfile, 532 '-l',$self->username, 533 ); 534} 535 536sub _ssh_escaped_args { 537 my $self = shift; 538 my @args = $self->_ssh_args; 539 for (my $i=1;$i<@args;$i+=2) { 540 $args[$i] = qq("$args[$i]") if $args[$i]; 541 } 542 my $args = join ' ',@args; 543 return $args; 544} 545 546sub _scmd_pipe { 547 my $self = shift; 548 my ($op,@cmd) = @_; 549 my @extra_args; 550 if (ref($cmd[0]) && ref($cmd[0]) eq 'ARRAY') { 551 my $extra = shift @cmd; 552 @extra_args = @$extra; 553 } 554 my $operation = $op eq 'write' ? '|-' : '-|'; 555 556 my $host = $self->dnsName; 557 my $pid = open(my $fh,$operation); # this does a fork 558 defined $pid or croak "piped open failed: $!" ; 559 return $fh if $pid; # writing to the filehandle writes to an ssh session 560 exec 'ssh',$self->_ssh_args,@extra_args,$host,@cmd; 561 exit 0; 562} 563 564=head1 Volume Management Methods 565 566The methods in this section allow you to create and manage volumes 567attached to the server. These supplement the EC2 facilities for 568creating and attaching EBS volumes with the ability to format the 569volumes with a variety of filesystems, and mount them at a desired 570location. 571 572=head2 $volume = $server->provision_volume(%args) 573 574Provision and mount a new volume. If successful, the volume is 575returned as a VM::EC2::Staging::Volume object. 576 577Arguments (default): 578 579 -name Symbolic name for the desired volume (autogenerated) 580 -fstype Filesystem type for desired volume (ext4) 581 -size Size for the desired volume in GB (1) 582 -mtpt Mountpoint for this volume (/mnt/Staging/$name) 583 -mount Alias for -mtpt 584 -volume_id ID of existing volume to attach & mount (none) 585 -snapshot_id ID of existing snapshot to use to create this volume (none) 586 -reuse Reuse an existing managed volume of same name (false) 587 -label Disk label to assign during formatting ($name) 588 -uuid UUID to assign during formatting (none) 589 590None of the arguments are required, and reasonable defaults will be 591chosen if they are missing. 592 593The B<-name> argument specifies the symbolic name to be assigned to 594the newly-created staging volume. The name allows the staging manager 595to retrieve this volume at a later date if it is detached from the 596server and returned to the available pool. If no name is provided, 597then an arbitrary one will be autogenerated. 598 599The B<-fstype> argument specifies the filesystem to be generated on 600the volume, ext4 by default. The following filesystems are currently 601supported: ext2, ext3, ext4, xfs, reiserfs, jfs, ntfs, nfs, vfat, 602msdos. In addition, you can specify a filesystem of "raw", which means 603to provision and attach the volume to the server, but not to format 604it. This can be used to set up LVM and RAID devices. Note that if the 605server does not currently have the package needed to manage the 606desired filesystem, it will use "apt-get" to install it. 607 608The B<-mtpt> and B<-mount> arguments (they are equivalent) specify the 609mount point for the volume on the server filesystem. The default is 610"/mnt/Staging/$name", where $name is the symbolic name provided by 611-name or autogenerated. No checking is done on the sensibility of the 612mount point, so try to avoid mounting disks over essential parts of 613the system. 614 615B<-volume_id> and B<-snapshot_id> instruct the method to construct the 616staging volume from an existing EBS volume or snapshot. -volume_id is 617an EBS volume ID. If provided, the volume must be located in the 618server's availability zone and be in the "available" 619state. -snapshot_id is an EBS snapshot ID in the server's region. In 620no case will provision_volume() attempt to reformat the resulting 621volume, even if the -fstype argument is provided. However, in the case 622of a volume created from a snapshot, you may specify a -size argument 623larger than the snapshot and the filesystem will be dynamically 624resized to fill the requested space. This currently only works with 625ext2, ext3 and ext4 volumes, and cannot be used to make filesystems 626smaller. 627 628If the B<-reuse> argument is true, and a symbolic name is provided in 629B<-name>, then the method will look for an available staging volume of 630the same name and mount this at the specified location. If no suitable 631staging volume is found, then the method will look for a snapshot 632created earlier from a staging volume of the same name. If neither a 633suitable volume nor a snapshot is available, then a new volume is 634provisioned. This is intended to support the following use case of 635synchronizing a filesystem somewhere to an EBS snapshot: 636 637 my $server = $staging_manager->get_server('my_server'); 638 my $volume = $server->provision_volume(-name=>'backup_1', 639 -reuse => 1, 640 -fstype => 'ext3', 641 -size => 10); 642 $volume->put('fred@gw.harvard.edu:my_music'); 643 $volume->create_snapshot('music_backups'); 644 $volume->delete; 645 646The B<-label> and B<-uuid> arguments are used to set the volume label 647and UUID during formatting of new filesystems. The default behavior is 648to create no label and to allow the server to choose an arbitrary 649UUID. 650 651=cut 652 653sub provision_volume { 654 my $self = shift; 655 my %args = @_; 656 657 my $name = $args{-name} ||= VM::EC2::Staging::Manager->new_volume_name; 658 my $size = $args{-size}; 659 my $volid = $args{-volume_id}; 660 my $snapid = $args{-snapshot_id}; 661 my $reuse = $args{-reuse}; 662 my $label = $args{-label}; 663 my $uuid = $args{-uuid}; 664 665 $self->manager->find_volume_by_name($args{-name}) && 666 croak "There is already a volume named $args{-name} in this region"; 667 668 if ($volid || $snapid) { 669 $name ||= $volid || $snapid; 670 $size ||= -1; 671 } else { 672 $name =~ /^[a-zA-Z0-9_.,&-]+$/ 673 or croak "Volume name must contain only characters [a-zA-Z0-9_.,&-]; you asked for '$name'"; 674 } 675 676 my $ec2 = $self->ec2; 677 my $fstype = $args{-fstype} || 'ext4'; 678 my $mtpt = $fstype eq 'raw' ? 'none' : ($args{-mount} || $args{-mtpt} || $self->default_mtpt($name)); 679 my $username = $self->username; 680 681 $size = int($size) < $size ? int($size)+1 : $size; # dirty ceil() function 682 683 my $instance = $self->instance; 684 my $zone = $instance->placement; 685 my ($vol,$needs_mkfs,$needs_resize) = $self->_create_volume($name,$size,$zone,$volid,$snapid,$reuse); 686 687 $vol->add_tag(Name => $self->volume_description($name)) unless exists $vol->tags->{Name}; 688 $vol->add_tags(StagingName => $name, 689 StagingMtPt => $mtpt, 690 StagingFsType => $fstype, 691 StagingRole => 'StagingVolume'); 692 693 my ($ebs_device,$mt_device) = eval{$self->unused_block_device()} 694 or die "Couldn't find suitable device to attach this volume to"; 695 my $s = $instance->attach_volume($vol=>$ebs_device) 696 or die "Couldn't attach $vol to $instance via $ebs_device: ",$ec2->error_str; 697 $ec2->wait_for_attachments($s) or croak "Couldn't attach $vol to $instance via $ebs_device"; 698 $s->current_status eq 'attached' or croak "Couldn't attach $vol to $instance via $ebs_device"; 699 700 if ($needs_resize) { 701 $self->scmd("sudo blkid -p $mt_device") =~ /"ext\d"/ or croak "Sorry, but can only resize ext volumes "; 702 $self->info("Checking filesystem...\n"); 703 $self->ssh("sudo /sbin/e2fsck -fy $mt_device") or croak "Couldn't check $mt_device"; 704 $self->info("Resizing previously-used volume to $size GB...\n"); 705 $self->ssh("sudo /sbin/resize2fs $mt_device ${size}G") or croak "Couldn't resize $mt_device"; 706 } elsif ($needs_mkfs && $fstype ne 'raw') { 707 local $_ = $fstype; 708 my $label_cmd =!$label ? '' 709 :/^ext/ ? "-L '$label'" 710 :/^xfs/ ? "-L '$label'" 711 :/^reiser/ ? "-l '$label'" 712 :/^jfs/ ? "-L '$label'" 713 :/^vfat/ ? "-n '$label'" 714 :/^msdos/ ? "-n '$label'" 715 :/^ntfs/ ? "-L '$label'" 716 :/^hfs/ ? "-v '$label'" 717 :''; 718 my $uu = $uuid ? ( /^ext/ ? "-U $uuid" 719 :/^xfs/ ? '' 720 :/^reiser/ ? "-u $uuid" 721 :/^jfs/ ? '' 722 :/^vfat/ ? '' 723 :/^msdos/ ? '' 724 :/^ntfs/ ? "-U $uuid" 725 :/^hfs/ ? '' 726 :'') 727 : ''; 728 my $quiet = $self->manager->verbosity < 3 && !/msdos|vfat|hfs/ ? "-q" : ''; 729 730 my $apt_packages = $self->_mkfs_packages(); 731 if (my $package = $apt_packages->{$fstype}) { 732 $self->info("checking for /sbin/mkfs.$fstype\n"); 733 $self->ssh("if [ ! -e /sbin/mkfs.$fstype ]; then sudo apt-get -q update; sudo apt-get -q -y install $package; fi"); 734 } 735 $self->info("Making $fstype filesystem on staging volume...\n"); 736 $self->ssh("sudo /sbin/mkfs.$fstype $quiet $label_cmd $uu $mt_device") or croak "Couldn't make filesystem on $mt_device"; 737 738 if ($uuid && !$uu) { 739 $self->info("Setting the UUID for the volume\n"); 740 $self->ssh("sudo xfs_admin -U $uuid $mt_device") if $fstype =~ /^xfs/; 741 $self->ssh("sudo jfs_tune -U $uuid $mt_device") if $fstype =~ /^jfs/; 742 # as far as I know you cannot set a uuid for FAT and VFAT volumes 743 } 744 } 745 746 my $volobj = $self->manager->volume_class->new({ 747 -volume => $vol, 748 -mtdev => $mt_device, 749 -mtpt => $mtpt, 750 -server => $self, 751 -name => $name}); 752 753 # make sure the guy is mountable before trying it 754 if ($volid || $snapid) { 755 my $isfs = $self->scmd("sudo blkid -p $mt_device") =~ /filesystem/i; 756 $self->mount_volume($volobj) if $isfs; 757 $volobj->mtpt('none') unless $isfs; 758 $fstype = $volobj->get_fstype; 759 $volobj->fstype($fstype); 760 } else { 761 $volobj->fstype($fstype); 762 $self->mount_volume($volobj); 763 } 764 765 $self->manager->register_volume($volobj); 766 return $volobj; 767} 768 769=head2 $volume = $server->add_volume(%args) 770 771This is the same as provision_volume(). 772 773=cut 774 775sub add_volume { 776 shift->provision_volume(@_) 777} 778 779=head2 @volumes = $server->volumes() 780 781Return a list of all the staging volumes attached to this 782server. Unmanaged volumes, such as the root volume, are not included 783in the list. 784 785=cut 786 787sub volumes { 788 my $self = shift; 789 $self->refresh; 790 my @volIds = map {$_->volumeId} $self->blockDeviceMapping; 791 my @volumes = map {$self->manager->find_volume_by_volid($_)} @volIds; 792 return grep {defined $_} @volumes; 793} 794 795=head2 $server->unmount_volume($volume) 796 797Unmount the volume $volume. The volume will remain attached to the 798server. This method will die with a fatal error if the operation 799fails. 800 801See VM::EC2::Staging::Volume->detach() for the recommended way to 802unmount and detach the volume. 803 804=cut 805 806sub unmount_volume { 807 my $self = shift; 808 my $vol = shift; 809 my $mtpt = $vol->mtpt; 810 return unless $mtpt; 811 return if $mtpt eq 'none'; 812 return unless $vol->mounted; 813 $self->info("unmounting $vol...\n"); 814 $self->ssh('sudo','umount',$mtpt) or croak "Could not umount $mtpt"; 815 $vol->delete_tags('StagingMtPt'); 816 $vol->mounted(0); 817} 818 819=head2 $server->detach_volume($volume) 820 821Unmount and detach the volume from the server, waiting until EC2 822reports that the detachment completed. A fatal error will occur if the 823operation fails. 824 825=cut 826 827sub detach_volume { 828 my $self = shift; 829 my $vol = shift; 830 return unless $vol->server; 831 return unless $vol->current_status eq 'in-use'; 832 $vol->server eq $self or croak "Volume is not attached to this server"; 833 my $status = $vol->detach(); 834 $self->ec2->wait_for_attachments($status); 835 $vol->refresh; 836} 837 838=head2 $server->mount_volume($volume [,$mountpt]) 839 840Mount the volume $volume using the mount information recorded inside 841the VM::EC2::Staging::Volume object (returned by its mtpt() and 842mtdev() methods). If the volume has not previously been mounted on 843this server, then it will be attached to the server and a new 844mountpoint will be allocated automatically. You can change the mount 845point by specifying it explicitly in the second argument. 846 847Here is the recommended way to detach a staging volume from one server 848and attach it to another: 849 850 $server1->detach_volume($volume); 851 $server2->mount_volume($volume); 852 853This method will die in case of error. 854 855=cut 856 857sub mount_volume { 858 my $self = shift; 859 my ($vol,$mtpt) = @_; 860 $vol->mounted and return; 861 if ($vol->mtdev && $vol->mtpt) { 862 return if $vol->mtpt eq 'none'; 863 $self->_mount($vol->mtdev,$vol->mtpt); 864 } else { 865 $self->_find_or_create_mount($vol,$mtpt); 866 } 867 $vol->add_tags(StagingMtPt => $vol->mtpt); 868 $vol->server($self); 869 $vol->mounted(1); 870} 871 872=head2 $server->remount_volume($volume) 873 874This is similar to mount_volume(), except that it will fail with a 875fatal error if the volume was not previously mounted on this server. 876This is to be used when temporarily unmounting and remounting a volume 877on the same server: 878 879 $server->unmount_volume($volume); 880 # do some work on the volume 881 $server->remount_volume($volume) 882 883=cut 884 885sub remount_volume { 886 my $self = shift; 887 my $vol = shift; 888 my $mtpt = $vol->mtpt; 889 return if $mtpt eq 'none'; 890 my $device = $vol->mtdev; 891 my $server = $vol->server; 892 ($mtpt && $device && $server eq $self) 893 or croak "attempt to remount a volume that was not previously mounted on this server"; 894 $self->info("remounting $vol\n"); 895 $self->ssh('sudo','mount',$device,$mtpt) or croak "Could not remount $mtpt"; 896 $vol->mounted(1); 897} 898 899=head2 $server->delete_volume($volume) 900 901Unmount, detach, and then delete the indicated volume entirely. 902 903=cut 904 905sub delete_volume { 906 my $self = shift; 907 my $vol = shift; 908 my $ec2 = $self->ec2; 909 $self->manager->unregister_volume($vol); 910 $self->unmount_volume($vol); 911 # call underlying EBS function to avoid the volume trying to spin up the 912 # server just to unmount itself. 913 $ec2->wait_for_attachments( $vol->ebs->detach() ); 914 $self->info("deleting $vol...\n"); 915 $ec2->delete_volume($vol->volumeId); 916 $vol->mounted(0); 917} 918 919=head2 $snap = $server->create_snapshot($volume,$description) 920 921Unmount the volume, snapshot it using the provided description, and 922then remount the volume. If successful, returns the snapshot. 923 924The snapshot is tagged with the identifying information needed to 925associate the snapshot with the staging volume. This information then 926used when creating new volumes from the snapshot with 927$server->provision_volume(-reuse=>1). 928 929=cut 930 931sub create_snapshot { 932 my $self = shift; 933 my ($vol,$description) = @_; 934 935 my $was_mounted = $vol->mounted; 936 $self->unmount_volume($vol) if $was_mounted; 937 938 $self->info("snapshotting $vol\n"); 939 my $volume = $vol->ebs; 940 my $snap = $volume->create_snapshot($description) or croak "Could not snapshot $vol: ",$vol->ec2->error_str; 941 942 $snap->add_tag(StagingName => $vol->name ); 943 $snap->add_tag(Name => "Staging volume ".$vol->name); 944 945 $self->remount_volume($vol) if $was_mounted; 946 return $snap; 947} 948 949sub _create_volume { 950 my $self = shift; 951 my ($name,$size,$zone,$volid,$snapid,$reuse_staging_volume) = @_; 952 my $ec2 = $self->ec2; 953 954 my (@vols,@snaps); 955 956 if ($volid) { 957 my $vol = $ec2->describe_volumes($volid) or croak "Unknown volume $volid"; 958 croak "$volid is not in server availability zone $zone." 959 unless $vol->availabilityZone eq $zone; 960 croak "$vol is unavailable for use, status ",$vol->status 961 unless $vol->status eq 'available'; 962 @vols = $vol; 963 } 964 965 elsif ($snapid) { 966 my $snap = $ec2->describe_snapshots($snapid) or croak "Unknown snapshot $snapid"; 967 @snaps = $snap; 968 } 969 970 elsif ($reuse_staging_volume) { 971 @vols = sort {$b->createTime cmp $a->createTime} $ec2->describe_volumes({status => 'available', 972 'availability-zone' => $zone, 973 'tag:StagingName' => $name}); 974 @snaps = sort {$b->startTime cmp $a->startTime} $ec2->describe_snapshots(-owner => $ec2->account_id, 975 -filter => {'tag:StagingName' => $name}) 976 unless @vols; 977 } 978 979 my ($vol,$needs_mkfs,$needs_resize); 980 981 if (@vols) { 982 $vol = $vols[0]; 983 $size = $vol->size unless $size > 0; 984 $self->info("Using volume $vol...\n"); 985 $vol->size == $size or croak "Cannot (yet) resize live volumes. Please snapshot first and restore from the snapshot" 986 } 987 988 elsif (@snaps) { 989 my $snap = $snaps[0]; 990 $size = $snap->volumeSize unless $size > 0; 991 $self->info("Using snapshot $snap...\n"); 992 $snap->volumeSize <= $size or croak "Cannot (yet) shrink volumes derived from snapshots. Please choose a size >= snapshot size"; 993 $vol = $snap->create_volume(-availability_zone=>$zone, 994 -size => $size); 995 $needs_resize = $snap->volumeSize < $size; 996 } 997 998 else { 999 unless ($size > 0) { 1000 $self->info("No size provided. Defaulting to 10 GB.\n"); 1001 $size = 10; 1002 } 1003 $self->info("Provisioning a new $size GB volume...\n"); 1004 $vol = $ec2->create_volume(-availability_zone=>$zone, 1005 -size =>$size); 1006 $needs_mkfs++; 1007 } 1008 1009 return unless $vol; 1010 1011 return ($vol,$needs_mkfs,$needs_resize); 1012} 1013 1014sub _mount { 1015 my $self = shift; 1016 my ($mt_device,$mtpt) = @_; 1017 $self->info("Mounting staging volume at $mt_device on $mtpt.\n"); 1018 $self->ssh("sudo mkdir -p $mtpt; sudo mount $mt_device $mtpt") or croak "mount failed"; 1019} 1020 1021sub _mkfs_packages { 1022 my $self = shift; 1023 return { 1024 xfs => 'xfsprogs', 1025 reiserfs => 'reiserfsprogs', 1026 jfs => 'jfsutils', 1027 ntfs => 'ntfsprogs', 1028 hfs => 'hfsprogs', 1029 } 1030} 1031 1032sub _find_or_create_mount { 1033 my $self = shift; 1034 my ($vol,$mtpt) = @_; 1035 1036 $vol->refresh; 1037 my ($ebs_device,$mt_device,$old_mtpt); 1038 1039 # handle the case of the volme already being attached 1040 if (my $attachment = $vol->attachment) { 1041 1042 if ($attachment->status eq 'attached') { 1043 1044 $attachment->instanceId eq $self->instanceId or 1045 die "$vol is attached to wrong server"; 1046 ($mt_device,$old_mtpt) = $self->_find_mount($attachment->device); 1047 $mtpt ||= $old_mtpt || $vol->tags->{StagingMtPt} || $self->default_mtpt($vol); 1048 $self->_mount($mt_device,$mtpt); 1049 1050 #oops, device is in a semi-attached state. Let it settle then reattach. 1051 } else { 1052 $self->info("$vol was recently used. Waiting for attachment state to settle...\n"); 1053 $self->ec2->wait_for_attachments($attachment); 1054 } 1055 } 1056 1057 unless ($mt_device && $mtpt) { 1058 ($ebs_device,$mt_device) = $self->unused_block_device; 1059 $self->info("attaching $vol to $self via $ebs_device\n"); 1060 my $s = $vol->attach($self->instanceId,$ebs_device) 1061 or croak "Can't attach $vol to $self: ",$self->ec2->error_str; 1062 $self->ec2->wait_for_attachments($s); 1063 $s->current_status eq 'attached' or croak "Can't attach $vol to $self"; 1064 $mtpt ||= $vol->tags->{StagingMtPt} || $self->default_mtpt($vol); 1065 $self->_mount($mt_device,$mtpt); 1066 } 1067 1068 $vol->mtpt($mtpt); 1069 $vol->mtdev($mt_device); 1070} 1071 1072# this gets called to find a device that is already mounted 1073sub _find_mount { 1074 my $self = shift; 1075 my $device = shift; 1076 my @mounts = $self->scmd('cat /proc/mounts'); 1077 my (%mounts,$xvd); 1078 for my $m (@mounts) { 1079 my ($dev,$mtpt) = split /\s+/,$m; 1080 $xvd++ if $dev =~ m!^/dev/xvd!; 1081 $mounts{$dev} = $mtpt; 1082 } 1083 $device =~ s!^/dev/sd!/dev/xvd! if $xvd; 1084 return ($device,$mounts{$device}); 1085} 1086 1087=head1 Data Copying Methods 1088 1089The methods in this section are used to copy data from one staging server to another, and to 1090copy data from a local file system to a staging server. 1091 1092=head2 $result = $server->rsync($src1,$src2,$src3...,$dest) 1093 1094This method is a passthrough to VM::EC2::Staging::Manager->rsync(), 1095and provides efficient file-level synchronization (rsync) file-level 1096copying between one or more source locations and a destination 1097location via an ssh tunnel. Copying among arbitrary combinations of 1098local and remote filesystems is supported, with the caveat that the 1099remote filesystems must be contained on volumes and servers managed by 1100this module (see below for a workaround). 1101 1102You may provide two or more directory paths. The last path will be 1103treated as the copy destination, and the source paths will be treated 1104as copy sources. All copying is performed using the -avz options, which 1105activates recursive directory copying in which ownership, modification 1106times and permissions are preserved, and compresses the data to reduce 1107network usage. 1108 1109Source paths can be formatted in one of several ways: 1110 1111 /absolute/path 1112 Copy the contents of the directory /absolute/path located on the 1113 local machine to the destination. This will create a 1114 subdirectory named "path" on the destination disk. Add a slash 1115 to the end of the path (i.e. "/absolute/path/") in order to 1116 avoid creating this subdirectory on the destination disk. 1117 1118 ./relative/path 1119 Relative paths work the way you expect, and depend on the current 1120 working directory. The terminating slash rule applies. 1121 1122 $staging_server:/absolute/path 1123 Pass a staging server object and absolute path to copy the contents 1124 of this path to the destination disk. Because of string interpolation 1125 you can include server objects in quotes: "$my_server:/opt" 1126 1127 $staging_server:relative/path 1128 This form will copy data from paths relative to the remote user's home 1129 directory on the staging server. Typically not very useful, but supported. 1130 1131 $staging_volume 1132 Pass a VM::EC2::Staging::Volume to copy the contents of the 1133 volume to the destination disk starting at the root of the 1134 volume. Note that you do *not* need to have any knowledge of the 1135 mount point for this volume in order to copy its contents. 1136 1137 $staging_volume:/absolute/path 1138 Copy a subdirectory of a staging volume to the destination disk. 1139 The root of the volume is its top level, regardless of where it 1140 is mounted on the staging server. Because of string 1141 interpolation magic, you can enclose staging volume object names 1142 in quotes in order to construct the path, as in 1143 "$picture_volume:/family/vacations/". As in local paths, a 1144 terminating slash indicates that the contents of the last 1145 directory in the path are to be copied without creating the 1146 enclosing directory on the desetination. Note that you do *not* 1147 need to have any knowledge of the mount point for this volume in 1148 order to copy its contents. 1149 1150 $staging_volume:absolute/path 1151 $staging_volume/absolute/path 1152 These are alternatives to the previous syntax, and all have the 1153 same effect as $staging_volume:relative/path. There is no 1154 1155The same syntax is supported for destination paths, except that it 1156makes no difference whether a path has a trailing slash or not. 1157 1158Note that neither the source nor destination paths need to reside on 1159this server. 1160 1161See VM::EC2::Staging::Manager->rsync() for examples and more details. 1162 1163=cut 1164 1165sub rsync { 1166 shift->manager->rsync(@_); 1167} 1168 1169=head2 $server->dd($source_vol=>$dest_vol) 1170 1171This method is a passthrough to VM::EC2::Staging::Manager->dd(), and 1172performs block-level copying of the contents of $source_vol to 1173$dest_vol by using dd over an SSH tunnel, where both source and 1174destination volumes are VM::EC2::Staging::Volume objects. The volumes 1175must be attached to a server but not mounted. Everything in the 1176volume, including its partition table, is copied, allowing you to make 1177an exact image of a disk. 1178 1179The volumes do B<not> actually need to reside on this server, but can 1180be attached to any staging server in the zone. 1181 1182=cut 1183 1184sub dd { 1185 shift->manager->dd(@_); 1186} 1187 1188=head2 $server->put($source1,$source2,$source3,...,$dest) 1189 1190Use rsync to copy the indicated source directories into the 1191destination path indicated by $dest. The destination is either a path 1192on the server machine, or a staging volume object mounted on the 1193server (string interpolation is accepted). The sources can be local 1194paths on the machine the perl script is running on, or any of the 1195formats described for rsync(). 1196 1197Examples: 1198 1199 $server1->put("$ENV{HOME}/my_pictures" => '/var/media'); 1200 $server1->put("$ENV{HOME}/my_pictures","$ENV{HOME}/my_audio" => '/var/media'); 1201 $server1->put("$ENV{HOME}/my_pictures" => "$backup_volume/home_media"); 1202 $server1->put("fred@gw.harvard.edu:media/" => "$backup_volume/home_media"); 1203 1204=cut 1205 1206# last argument is implied on this server 1207sub put { 1208 my $self = shift; 1209 my @paths = @_; 1210 @paths >= 2 or croak "usage: VM::EC2::Staging::Server->put(\$source1,\$source2...,\$dest)"; 1211 $paths[-1] =~ m/:/ && croak "invalid pathname; must not contain a hostname"; 1212 $paths[-1] = "$self:$paths[-1]" unless $paths[-1] =~ /^vol-[0-9a-f]{8}/; 1213 $self->manager->rsync(@paths); 1214} 1215 1216=head2 $server->get($source1,$source2,$source3,...,$dest) 1217 1218Use rsync to copy the indicated source directories into the 1219destination path indicated by $dest. The source directories are either 1220paths on the server, or staging volume(s) mounted on the server 1221(string interpolation to indicate subdirectories on the staging volume 1222also works). The destination can be any of the path formats described 1223for rsync(), including unmanaged hosts that accept ssh login. 1224 1225Examples: 1226 1227 $server1->get('/var/media' =>"$ENV{HOME}/my_pictures"); 1228 $server1->get('/var/media','/usr/bin' => "$ENV{HOME}/test"); 1229 $server1->get("$backup_volume/home_media" => "$ENV{HOME}/my_pictures"); 1230 $server1->get("$backup_volume/home_media" => "fred@gw.harvard.edu:media/"); 1231 1232=cut 1233 1234# source arguments are implied on this server+ 1235sub get { 1236 my $self = shift; 1237 my @paths = @_; 1238 @paths >= 2 or croak "usage: VM::EC2::Staging::Server->get(\$source1,\$source2...,\$dest)"; 1239 my $dest = pop @paths; 1240 foreach (@paths) { 1241 m/:/ && croak "invalid pathname; must not contain a hostname"; 1242 $_ = "$self:$_" unless /^vol-[0-9a-f]{8}/; 1243 } 1244 $self->manager->rsync(@paths,$dest); 1245} 1246 1247 1248sub _rsync_put { 1249 my $self = shift; 1250 my $rsync_args = shift; 1251 my @source = @_; 1252 my $dest = pop @source; 1253 1254 # resolve symbolic name of $dest 1255 $dest =~ s/^.+://; # get rid of hostname, if it is there 1256 my $host = $self->instance->dnsName; 1257 my $ssh_args = $self->_ssh_escaped_args; 1258 $rsync_args ||= $self->manager->_rsync_args; 1259 $self->info("Beginning rsync @source $host:$dest ...\n"); 1260 1261 my $dots = $self->manager->_dots_cmd; 1262 my $status = system("rsync $rsync_args -e'ssh $ssh_args' --rsync-path='sudo rsync' @source $host:$dest $dots") == 0; 1263 $self->info("...rsync done\n"); 1264 return $status; 1265} 1266 1267sub _rsync_get { 1268 my $self = shift; 1269 my $rsync_args = shift; 1270 my @source = @_; 1271 my $dest = pop @source; 1272 1273 # resolve symbolic names of src 1274 my $host = $self->instance->dnsName; 1275 foreach (@source) { 1276 (my $path = $_) =~ s/^.+://; # get rid of host part, if it is there 1277 $_ = "$host:$path"; 1278 } 1279 my $ssh_args = $self->_ssh_escaped_args; 1280 $rsync_args ||= $self->manager->_rsync_args; 1281 1282 $self->info("Beginning rsync @source $host:$dest ...\n"); 1283 my $dots = $self->manager->_dots_cmd; 1284 my $status = system("rsync $rsync_args -e'ssh $ssh_args' --rsync-path='sudo rsync' @source $dest $dots")==0; 1285 $self->info("...rsync done\n"); 1286 return $status; 1287} 1288 1289=head1 Internal Methods 1290 1291This section documents internal methods. They are not intended for use 1292by end-user scripts but may be useful to know about during 1293subclassing. There are also additional undocumented methods that begin 1294with a "_" character which you can explore in the source code. 1295 1296=head2 $description = $server->volume_description($vol) 1297 1298This method is called to get the value of the Name tag assigned to new 1299staging volume objects. The current value is "Staging volume for $name 1300created by VM::EC2::Staging::Server." 1301 1302You will see these names associated with EBS volumes in the AWS console. 1303 1304=cut 1305 1306sub volume_description { 1307 my $self = shift; 1308 my $vol = shift; 1309 my $name = ref $vol ? $vol->name : $vol; 1310 return "Staging volume for $name created by ".__PACKAGE__; 1311} 1312 1313=head2 ($ebs_device,$local_device) = $server->unused_block_device([$major_start]) 1314 1315This method returns an unused block device path. It is invoked when 1316provisioning and mounting new volumes. The behavior is to take the 1317following search path: 1318 1319 /dev/sdf1 1320 /dev/sdf2 1321 ... 1322 /dev/sdf15 1323 /dev/sdfg1 1324 ... 1325 /dev/sdp15 1326 1327You can modify the search path slightly by providing a single 1328character major start. For example, to leave all the sdf's free and to 1329start the search at /dev/sdg: 1330 1331 ($ebs_device,$local_device) = $server->unused_block_device('g'); 1332 1333The result is a two element list consisting of the unused device name 1334from the perspective of EC2 and the server respectively. The issue 1335here is that on some recent Linux kernels, the EC2 device /dev/sdf1 is 1336known to the server as /dev/xvdf1. This module understands that 1337complication and uses the EC2 block device name when managing EBS 1338volumes, and the kernel block device name when communicating with the 1339server. 1340 1341=cut 1342 1343# find an unused block device 1344sub unused_block_device { 1345 my $self = shift; 1346 my $major_start = shift || 'f'; 1347 1348 my @devices = $self->scmd('ls -1 /dev/sd?* /dev/xvd?* 2>/dev/null'); 1349 return unless @devices; 1350 my %used = map {$_ => 1} @devices; 1351 1352 my $base = $used{'/dev/sda1'} ? "/dev/sd" 1353 : $used{'/dev/xvda1'} ? "/dev/xvd" 1354 : ''; 1355 die "Device list contains neither /dev/sda1 nor /dev/xvda1; don't know how blocks are named on this system" 1356 unless $base; 1357 1358 my $ebs = '/dev/sd'; 1359 for my $major ($major_start..'p') { 1360 for my $minor (1..15) { 1361 my $local_device = "${base}${major}${minor}"; 1362 next if $used{$local_device}++; 1363 my $ebs_device = "/dev/sd${major}${minor}"; 1364 return ($ebs_device,$local_device); 1365 } 1366 } 1367 return; 1368} 1369 1370=head2 $flag = $server->has_key($keyname) 1371 1372Returns true if the server has a copy of the private key corresponding 1373to $keyname. This is used by the rsync() method to enable server to 1374server data transfers. 1375 1376=cut 1377 1378sub has_key { 1379 my $self = shift; 1380 my $keyname = shift; 1381 $self->{_has_key}{$keyname} = shift if @_; 1382 return $self->{_has_key}{$keyname} if exists $self->{_has_key}{$keyname}; 1383 return $self->{_has_key}{$keyname} = $self->scmd("if [ -e $keyname ]; then echo 1; fi"); 1384} 1385 1386=head2 $flag = $server->accepts_key($keyname) 1387 1388Returns true if the server has a copy of the public key part of 1389$keyname in its .ssh/authorized_keys file. This is used by the rsync() 1390method to enable server to server data transfers. 1391 1392=cut 1393 1394sub accepts_key { 1395 my $self = shift; 1396 my $keyname = shift; 1397 $self->{_accepts_key}{$keyname} = shift if @_; 1398 return $self->{_accepts_key}{$keyname}; 1399} 1400 1401=head2 $up = $server->is_up([$new_value]) 1402 1403Get/set the internal is_up() flag, which indicates whether the server 1404is up and running. This is used to cache the results of the ping() method. 1405 1406=cut 1407 1408sub is_up { 1409 my $self = shift; 1410 my $d = $self->{_is_up}; 1411 $self->{_is_up} = shift if @_; 1412 $d; 1413} 1414 1415=head2 $path = $server->default_mtpt($volume) 1416 1417Given a staging volume, return its default mount point on the server 1418('/mnt/Staging/'.$volume->name). Can also pass a string corresponding 1419to the volume's name. 1420 1421=cut 1422 1423sub default_mtpt { 1424 my $self = shift; 1425 my $vol = shift; 1426 my $name = ref $vol ? $vol->name : $vol; 1427 return "/mnt/Staging/$name"; 1428} 1429 1430=head2 $server->info(@message) 1431 1432Log a message to standard output, respecting the staging manager's 1433verbosity() setting. 1434 1435=cut 1436 1437sub info { 1438 my $self = shift; 1439 $self->manager->info(@_); 1440} 1441 1442=head1 Subclassing 1443 1444For reasons having to do with the order in which objects are created, 1445VM::EC2::Staging::Server is a wrapper around VM::EC2::Instance rather 1446than a subclass of it. To access the VM::EC2::Instance object, you 1447call the server object's instance() method. In practice this means 1448that to invoke the underlying instance's method for, say, start() you 1449will need to do this: 1450 1451 $server->instance->start(); 1452 1453rather than this: 1454 1455 $server->SUPER::start(); 1456 1457You may subclass VM::EC2::Staging::Server in the usual way. 1458 1459=head1 SEE ALSO 1460 1461L<VM::EC2> 1462L<VM::EC2::Instance> 1463L<VM::EC2::Volume> 1464L<VM::EC2::Snapshot> 1465 1466=head1 AUTHOR 1467 1468Lincoln Stein E<lt>lincoln.stein@gmail.comE<gt>. 1469 1470Copyright (c) 2011 Ontario Institute for Cancer Research 1471 1472This package and its accompanying libraries is free software; you can 1473redistribute it and/or modify it under the terms of the GPL (either 1474version 1, or at your option, any later version) or the Artistic 1475License 2.0. Refer to LICENSE for the full license text. In addition, 1476please see DISCLAIMER.txt for disclaimers of warranty. 1477 1478=cut 1479 14801; 1481 1482