/usr/share/perl5/VM/EC2/Staging/Volume.pm is in libvm-ec2-perl 1.28-2build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 | package VM::EC2::Staging::Volume;
=head1 NAME
VM::EC2::Staging::Volume - High level functions for provisioning and populating EC2 volumes
=head1 SYNOPSIS
use VM::EC2::Staging::manager;
# get a new staging manager
my $ec2 = VM::EC2->new;
my $staging = $ec2->staging_manager(); );
my $vol1 = $staging->get_volume(-name => 'Backup',
-fstype => 'ext4',
-size => 11,
-zone => 'us-east-1a');
# make a couple of directories in new volume
$vol1->mkdir('pictures');
$vol1->mkdir('videos');
# use rsync to copy local files onto a subdirectory of this volume
$vol1->put('/usr/local/my_pictures/' =>'pictures');
$vol1->put('/usr/local/my_videos/' =>'videos');
# use rsync to to copy a set of files on the volume to a local directory
mkdir('/tmp/jpegs');
$vol1->get('pictures/*.jpg','/tmp/jpegs');
# note that these commands are executed on the remote server as root!
@listing = $vol1->ls('-r','pictures');
$vol1->chown('fred','pictures');
$vol1->chgrp('nobody','pictures');
$vol1->chmod('0700','pictures');
$vol1->rm('-rf','pictures/*');
$vol1->rmdir('pictures');
# get some information about the volume
my $mtpt = $vol->mtpt;
my $mtdev = $vol->mtdev;
my $mounted = $vol->mounted;
my $server = $vol->server;
# detach the volume
$vol->detach;
# delete the volume entirely
$vol->delete;
=head1 DESCRIPTION
This is a high-level interface to EBS volumes which is used in
conjunction with VM::EC2::Staging::Manager and
VM::EC2::Staging::Server. It is intended to ease the process of
allocating and managing EBS volumes, and provides for completely
automated filesystem creation, directory management, and data transfer
to and from the volume.
You can use staging volumes without having to manually create and
manage the instances needed to manipulate the volumes. As needed, the
staging manager will create the server(s) needed to execute the
desired actions on the volumes.
Staging volumes are wrappers around VM::EC2::Volume, and have all the
methods associated with those objects. In addition to the standard EC2
volume characteristics, each staging volume in an EC2 region has a
symbolic name, which can be used to retrieve previously-created
volumes without remembering their volume ID. This symbolic name is
stored in the tag StagingName. Volumes also have a filesystem type
(stored in the tag StagingFsType). When a volume is mounted on a
staging server, it will also have a mount point on the file system,
and a mounting device (e.g. /dev/sdf1).
=cut
use strict;
use VM::EC2;
use Carp 'croak';
use File::Spec;
use overload
'""' => sub {my $self = shift;
return $self->short_name; # "inherited" from VM::EC2::Volume
},
fallback => 1;
my $Volume = 1; # for anonymously-named volumes
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
my ($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/;
return if $func_name eq 'DESTROY';
my $vol = eval {$self->ebs} or croak overload::StrVal($self)," no longer connected to an Amazon EBS object, so can't execute $func_name()";
return $vol->$func_name(@_);
}
sub can {
my $self = shift;
my $method = shift;
my $can = $self->SUPER::can($method);
return $can if $can;
my $ebs = $self->ebs or return;
return $ebs->can($method);
}
=head1 Staging Volume Creation
Staging volumes are created via a staging manager's get_volume() or
provision_volume() methods. See L<VM::EC2::Staging::Manager>. One
typical invocation is:
my $ec2 = VM::EC2->new;
my $manager = $ec2->staging_manager(); );
my $vol = $manager->get_volume(-name => 'Backup',
-fstype => 'ext4',
-size => 5,
-zone => 'us-east-1a');
This will either retrieve an existing volume named "Backup", or, if
none exists, create a new one using the provided specification. Behind
the scenes, a staging server will be allocated to mount the
volume. The manager tries to conserve resources, and so will reuse a
suitable running staging server if one is available.
The other typical invocation is:
my $vol = $manager->provision_volume(-name => 'Backup',
-fstype => 'ext4',
-size => 5,
-zone => 'us-east-1a');
This forces creation of a new volume with the indicated
characteristics. If a volume of the same name already exists, this
method will die with a fatal error (to avoid this, either wrap in an
eval, or leave off the -name argument and let the manager pick a
unique name for you).
=cut
=head1 Volume Information
The methods in this section return status information about the staging volume.
=head2 $name = $vol->name([$newname])
Get/set the symbolic name associated with this volume.
=head2 $mounted = $vol->mounted
Returns true if the volume is currently mounted on a server.
=cut
sub mounted {
my $self = shift;
my $m = $self->{mounted};
$self->{mounted} = shift if @_;
return $m;
}
=head2 $type = $vol->fstype
Return the filesystem type requested at volume creation time.
=head2 $server = $vol->server
Get the server associated with this volume, if any.
=head2 $device = $vol->mtdev
Get the device that the volume is attached to, e.g. /dev/sdf1. If the
volume is not attached to a server, returns undef.
=head2 $device = $vol->mtpt
Get the mount point for this volume on the attached server. If the
volume is not mounted, returns undef.
=head2 $ebs_vol = $vol->ebs
Get the underlying EBS volume associated with the staging volume object.
=head2 $manager = $vol->manager
Return the VM::EC2::Staging::Manager which manages this volume.
=cut
=head2 $string = $vol->fstab_line();
This method returns the line in /etc/fstab that would be necessary to
mount this volume on the server to which it is currently attached at
boot time. For example:
/dev/sdf1 /mnt/staging/Backups ext4 defaults,nobootwait 0 2
You can add this to the current server's fstab using the following
code fragment:
my $server = $vol->server;
my $fh = $server->scmd_write('sudo -s "cat >>/etc/fstab"');
print $fh $vol->fstab,"\n";
close $fh;
=cut
sub fstab_line {
my $self = shift;
return join "\t",$self->mtdev,$self->mtpt,$self->fstype,'defaults,nobootwait',0,2;
}
# $stagingvolume->new({-server => $server, -volume => $volume,
# -mtdev => $device, -mtpt => $mtpt,
# -name => $name, -fstype => $fstype})
#
sub new {
my $self = shift;
my $args;
if (ref $_[0]) {
$args = shift;
} else {
my %args = @_;
$args = \%args;
}
return bless $args,ref $self || $self;
}
# accessors:
# sub volume
# sub mtpt
# sub name
# sub manager
foreach (qw(-server -volume -name -endpoint -mtpt -mtdev -fstype)) {
(my $function = $_) =~ s/^-//;
eval <<END;
sub $function {
my \$self = shift;
my \$d = \$self->{$_};
\$self->{$_} = shift if \@_;
return \$d;
}
END
}
sub ebs {shift->volume(@_)}
sub manager {
my $self = shift;
my $ep = $self->endpoint;
return VM::EC2::Staging::Manager->find_manager($ep);
}
=head2 $type = $vol->get_fstype
Return the volume's actual filesystem type. This can be different from
the requested type if it was later altered by running mkfs on the
volume, or the contents of the disk were overwritten by a block-level
dd command. As a side effect, this method sets fstype() to the current
correct value.
=cut
# look up our filesystem type
sub get_fstype {
my $self = shift;
return $self->fstype if $self->fstype;
return 'raw' if $self->mtpt eq 'none';
$self->_spin_up;
my $dev = $self->mtdev;
my $blkid = $self->server->scmd("sudo blkid -p $dev");
my ($type) = $blkid =~ /TYPE="([^"]+)"/;
$self->fstype($type);
return $type || 'raw';
}
sub _spin_up {
my $self = shift;
my $nomount = shift;
unless ($self->server) {
$self->manager->info("provisioning server to mount $self\n");
my $server = $self->manager->get_server_in_zone($self->availabilityZone);
$self->server($server);
}
unless ($self->server->status eq 'running') {
$self->manager->info("Starting server to mount $self\n");
$self->server->start;
}
$self->server->mount_volume($self) unless $nomount || $self->mounted();
}
#sub as_string {
# my $self = shift;
# return $self->server.':'.$self->mtpt;
#}
=head1 Lifecycle Methods
The methods in this section control the state of the volume.
=head2 $snapshot = $vol->create_snapshot('description')
Create a VM::EC2::Snapshot of the volume with an optional
description. This differs from the VM::EC2::Volume method of the same
name in that it is aware of the mount state of the volume and will
first try to unmount it so that the snapshot is clean. After the
snapshot is started, the volume is remounted.
=cut
sub create_snapshot {
my $self = shift;
my $description = shift;
if (my $server = $self->server) {
my ($snap) = $server->create_snapshot($self => $description);
return $snap;
} else {
$self->ebs->create_snapshot($description);
}
}
=head2 $snapshot = $vol->snapshot('description')
Identical to create_snapshot(), but the method name is shorter.
=cut
sub snapshot {shift->create_snapshot(@_)}
=head2 $vol->mount($server [,$mtpt])
=head2 $vol->mount()
Mount the volume on the indicated VM::EC2::Staging::Server, optionally
at a named mount point on the file system. If the volume is already
attached to a different server, it will be detached first. If any of
these step fails, the method will die with a fatal error.
When called with no arguments, the volume is automounted on a staging
server, creating or starting the server if necessary.
=cut
# mount the volume on a server
sub mount {
my $self = shift;
unless (@_) {
return $self->_spin_up;
}
my ($server,$mtpt) = @_;
if (my $existing_server = $self->server) {
if ($existing_server eq $server) {
$self->unmount;
} else {
$self->detach;
}
}
$server->mount_volume($self,$mtpt);
}
=head2 $vol->unmount()
Unmount the volume from wherever it is, but leave it attached to the
staging server. If the volume is not already mounted, nothing happens.
Note that it is possible for a volume to be mounted on a I<stopped>
server, in which case the server will be started and the volume only
unmounted when it is up and running.
=cut
# unmount volume from wherever it is
sub unmount {
my $self = shift;
my $server = $self->server or return;
# guarantees that server is running, but avoids mounting the disk
# prior to unmounting it again.
$self->_spin_up('nomount');
$server->unmount_volume($self);
$self->mtpt(undef);
}
sub umount { shift->unmount(@_) } # because I forget
=head2 $vol->detach()
Unmount and detach the volume from its current server, if any.
Note that it is possible for a volume to be mounted on a I<stopped>
server, in which case the server will be started and the volume only
unmounted when it is up and running.
=cut
sub detach {
my $self = shift;
my $server = $self->server or return;
$self->current_status eq 'in-use' or return;
$self->unmount; # make sure we are not mounted; this might involve starting a server
$server->info("detaching $self\n");
my $status = $self->volume->detach;
$self->mtpt(undef);
$self->mtdev(undef);
$self->server(undef);
return $status;
}
=head2 $vol->delete()
Delete the volume entirely. If it is mounted and/or attached to a
server, it will be unmounted/detached first. If any steps fail, the
method will die with a fatal error.
=cut
# remove volume entirely
sub delete {
my $self = shift;
my $status = $self->current_status;
if ($status eq 'in-use') {
my $server = $self->server
|| $self->manager->find_server_by_instance($self->attachment->instanceId);
$server->delete_volume($self) if $server;
} elsif ($status eq 'available') {
$self->ec2->delete_volume($self);
} else {
croak "Cannot delete volume, status is $status";
}
$self->mounted(0);
$self->mtpt(undef);
$self->mtdev(undef);
$self->fstype(undef);
}
=head1 Data Operations
The methods in this section operate on the contents of the volume. By
and large, they operate with root privileges on the server machine via
judicious use of sudo. Elevated permissions on the local machine (on
which the script is running) are not needed.
=cut
=head2 $vol->get($source_on_vol_1,$source_on_vol_2,...,$dest)
Invoke rsync() on the server to copy files & directories from the
indicated source locations on the staging volume to the
destination. Source paths can be relative paths, such as
"media/photos/vacation", in which case they are relative to the top
level of the mounted volume, or absolute paths, such as
"/usr/local/media/photos/vacation", in which case they are treated as
absolute paths on the server on which the volume is mounted.
The destination can be a path on the local machine, a host:/path on a
remote machine, a staging server and path in the form $server:/path,
or a staging volume and path in the form "$volume/path". See
L<VM::EC2::Staging::Manager/Instance Methods for Managing Staging Volumes>
for more formats you can use.
As a special case, if you invoke get() with a
single argument:
$vol->get('/tmp/foo')
Then the entire volume will be rsynced into the destination directory
/tmp/foo.
=cut
# $vol->get($source1,$source2,$source3....,$dest)
# If $source not in format hostname:/path then
# volume will be appended to it.
sub get {
my $self = shift;
croak 'usage: ',ref($self),'->get($source1,$source2,$source3....,$dest_path)'
unless @_;
unshift @_,'./' if @_ < 2;
my $dest = pop;
my $server = $self->server or croak "no staging server available";
$self->mounted or croak "Volume is not currently mounted";
my @source = $self->_rel2abs(@_);
$server->rsync(@source,$dest);
}
=head2 $vol->copy($source_on_vol_1,$source_on_vol_2,...,$dest)
This is an alias for get(). It is intended to make it easier to read the
intent of this command:
$source_volume->copy($destination_volume);
Which basically makes a copy of $source_volume onto
$destination_volume.
=cut
sub copy { shift->get(@_) }
=head2 $vol->put($source1,$source2,$source3,...,$dest_on_volume)
Invoke rsync() on the server to copy files & directories from the
indicated source locations a destination located on the staging
volume. The rules for paths are the same as for the get() method and as described in
L<VM::EC2::Staging::Manager/Instance Methods for Managing Staging Volumes> .
As a special case, if you invoke put() with a single argument:
$vol->put('/tmp/foo')
Then the local directory /tmp/foo will be copied onto the top level of
the staging volume. To do something similar with multiple source
directories, use '/' or '.' as the destination:
$vol->put('/tmp/pictures','/tmp/audio' => '/');
=cut
# $vol->put($source1,$source2,$source3....,$dest)
# If $dest not in format hostname:/path then
# volume will be appended to it.
sub put {
my $self = shift;
croak 'usage: ',ref($self),'->put($source1,$source2,$source3....,$dest_path)'
unless @_;
push @_,'.' if @_ < 2;
my $dest = pop;
my @source = @_;
$self->_spin_up;
my $server = $self->server or croak "no staging server available";
($dest) = $self->_rel2abs($dest);
$server->rsync(@source,$dest);
}
=head2 $vol->dd($destination_volume)
The dd() method performs a block level copy of the volume's disk onto
the destination. The destination must be another staging volume.
=cut
sub dd {
my $self = shift;
unshift @_,$self if @_ < 2;
$self->_spin_up;
$self->server->dd(@_);
}
=head2 $output = $vol->cmd($cmd,@args)
This method runs command $cmd on the server that is mounting the
volume using ssh. Before the command is run, the working directory is
changed to the top level of the volume's mount point. Any arguments,
switches, etc you wish to pass to the command can be provided as
@args. The output of the command is returned as a string in a scalar
context, or an array of lines in a list context.
Example:
@log = $volume->cmd('tar cvf /tmp/archive.tar .');
=head2 $result = $vol->ssh($cmd,@args)
This is similar to cmd(), except that the output of the command is
sent to STDOUT and the method returns true if the command executed
succcessfully on the remote machine. The cmd() and ssh() methods are
equivalent to backticks are system() respectively.
Example:
$volume->ssh('gzip /tmp/archive.tar') or die "couldn't compress archive";
=head2 $output = $vol->df(@args)
=head2 $output = $vol->ls(@args)
=head2 $success = $vol->mkdir(@args)
=head2 $success = $vol->chown(@args)
=head2 $success = $vol->chgrp(@args)
=head2 $success = $vol->chmod(@args)
=head2 $success = $vol->cp(@args)
=head2 $success = $vol->mv(@args)
=head2 $success = $vol->rm(@args)
=head2 $success = $vol->rmdir(@args)
Each of these methods performs the same function as the like-named
command-line function, after first changing the working directory to
the top level of the volume. They behave as shown in the pseudocode
below:
chdir $vol->mtpt;
sudo $method @args
The df() and ls() methods return the output of their corresponding
commands. In a scalar context each method returns a string
corresponding to the output of running the command on the server to
which the volume is attached. In a list context, the methods return
one element per line of output.
For example:
my $free = $volume->df('.'); # free on current directory
my ($percent) = $free =~ /(\d+)%/;
warn "almost out of space" if $percent > 90;
The other methods return a boolean value indicating successful
execution of the command on the remote machine.
Command line switches can be passed along with other arguments:
$volume->mkdir('-p','media/photos/vacation');
$volume->chown('-R','fred','media');
With the exception of df, each of these commands runs as the
superuser, so be careful how you call them.
You may run your own commands using the cmd() and ssh() methods. The
former returns the output of the command. The latter returns a success
code:
@log = $volume->cmd('tar cvf /tmp/archive.tar .');
$volume->ssh('gzip /tmp/archive.tar') or die "couldn't compress archive";
Before calling any of these methods, the volume must be mounted and
its server running. A fatal error will occur otherwise.
=cut
sub df { shift->_cmd('df',@_) }
sub ls { shift->_cmd('sudo ls',@_) }
sub mkdir { shift->_ssh('sudo mkdir',@_) }
sub chown { shift->_ssh('sudo chown',@_) }
sub chgrp { shift->_ssh('sudo chgrp',@_) }
sub chmod { shift->_ssh('sudo chmod',@_) }
sub rm { shift->_ssh('sudo rm',@_) }
sub rmdir { shift->_ssh('sudo rmdir',@_) }
sub cp { shift->_ssh('sudo cp',@_) }
sub mv { shift->_ssh('sudo mv',@_) }
sub _cmd {
my $self = shift;
my $cmd = shift;
my @args = map {quotemeta} @_;
$self->mounted or croak "Volume is not currently mounted";
my $mtpt = $self->mtpt;
$self->server->scmd("cd '$mtpt'; $cmd @args");
}
sub _ssh {
my $self = shift;
my $cmd = shift;
my @args = map {quotemeta} @_;
$self->mounted or croak "Volume is not currently mounted";
my $mtpt = $self->mtpt;
$self->server->ssh("cd '$mtpt'; $cmd @args");
}
sub cmd { shift->_cmd(@_) }
sub ssh { shift->_ssh(@_) }
sub _rel2abs {
my $self = shift;
my @paths = @_;
my $server = $self->server or croak "no server";
my @result;
foreach (@paths) {
if (/^([^:]+):(.+)$/) {
push @result,$_;
}
elsif (m!^/!) { # absolute path
push @result,"$server:".$_;
}
else {
my $p = "$server:".File::Spec->rel2abs($_,$self->mtpt);
$p .= '/' if m!/$!;
push @result,$p;
}
}
return @result;
}
sub _select_zone {
my $self = shift;
my $ec2 = shift;
if (my @servers = VM::EC2::Staging::Server->_servers($ec2->endpoint)) {
return $servers[0]->instance->placement;
} else {
my @zones = $ec2->describe_availability_zones;
return $zones[rand @zones];
}
}
sub _get_vol_zone {
my $self = shift;
my ($ec2,$volid) = @_;
my $volume = $ec2->describe_volumes($volid) or croak "unknown volumeid $volid";
return $volume->availabilityZone;
}
sub DESTROY {
my $self = shift;
my $manager = $self->manager or return;
my $ebs = $self->ebs or return;
$manager->unregister_volume($self);
}
=head1 SEE ALSO
L<VM::EC2>
L<VM::EC2::Staging::Manager>
L<VM::EC2::Staging::Server>
L<VM::EC2::Instance>
L<VM::EC2::Volume>
L<VM::EC2::Snapshot>
=head1 AUTHOR
Lincoln Stein E<lt>lincoln.stein@gmail.comE<gt>.
Copyright (c) 2012 Ontario Institute for Cancer Research
This package and its accompanying libraries is free software; you can
redistribute it and/or modify it under the terms of the GPL (either
version 1, or at your option, any later version) or the Artistic
License 2.0. Refer to LICENSE for the full license text. In addition,
please see DISCLAIMER.txt for disclaimers of warranty.
=cut
1;
|