aboutsummaryrefslogtreecommitdiff
path: root/perl/lib/Wallet/Object
diff options
context:
space:
mode:
authorJon Robertson <jonrober@stanford.edu>2014-10-14 17:06:43 -0700
committerJon Robertson <jonrober@stanford.edu>2014-10-14 17:06:43 -0700
commit1381f2e0d0bb2edfa4b52c9926c57b22379ee248 (patch)
tree909abb2a5fa9dd8f91e690d1eb9393cb5451835f /perl/lib/Wallet/Object
parentb658b799cb10b48d1a5aca19a7e63fe91d2af77a (diff)
Added rename support for file objects
File objects now support a rename command, which will rename the object and move the file to the right spot in the file store under its new name. Change-Id: I10ea2b8012586d69f0894905cfba54a738f3e418
Diffstat (limited to 'perl/lib/Wallet/Object')
-rw-r--r--perl/lib/Wallet/Object/Base.pm2
-rw-r--r--perl/lib/Wallet/Object/File.pm52
2 files changed, 52 insertions, 2 deletions
diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm
index a6a78bf..bdd61fb 100644
--- a/perl/lib/Wallet/Object/Base.pm
+++ b/perl/lib/Wallet/Object/Base.pm
@@ -187,7 +187,7 @@ sub log_set {
}
my %fields = map { $_ => 1 }
qw(owner acl_get acl_store acl_show acl_destroy acl_flags expires
- comment flags type_data);
+ comment flags type_data name);
unless ($fields{$field}) {
die "invalid history field $field";
}
diff --git a/perl/lib/Wallet/Object/File.pm b/perl/lib/Wallet/Object/File.pm
index 1ff1288..65fe40e 100644
--- a/perl/lib/Wallet/Object/File.pm
+++ b/perl/lib/Wallet/Object/File.pm
@@ -18,6 +18,7 @@ use warnings;
use vars qw(@ISA $VERSION);
use Digest::MD5 qw(md5_hex);
+use File::Copy qw(move);
use Wallet::Config ();
use Wallet::Object::Base;
@@ -55,6 +56,55 @@ sub file_path {
return "$Wallet::Config::FILE_BUCKET/$hash/$name";
}
+# Rename a file object. This includes renaming both the object itself, and
+# updating the file location for that object.
+sub rename {
+ my ($self, $new_name, $user, $host, $time) = @_;
+ $time ||= time;
+
+ my $old_name = $self->{name};
+ my $type = $self->{type};
+ my $schema = $self->{schema};
+ my $old_path = $self->file_path;
+
+ eval {
+
+ # Find the current object record.
+ my $guard = $schema->txn_scope_guard;
+ my %search = (ob_type => $type,
+ ob_name => $old_name);
+ my $object = $schema->resultset('Object')->find (\%search);
+ die "cannot find ${type}:${old_name}\n"
+ unless ($object and $object->ob_name eq $old_name);
+
+ # Update the object name but don't yet commit.
+ $object->ob_name ($new_name);
+
+ # Update the file to the path for the new name, and die if we can't.
+ $self->{name} = $new_name;
+ my $new_path = $self->file_path;
+ move($old_path, $new_path) or die $!;
+
+ $object->update;
+ $guard->commit;
+ };
+ if ($@) {
+ $self->{name} = $old_name;
+ $self->error ("cannot rename object $type $old_name: $!");
+ return;
+ }
+
+ eval {
+ $self->log_set ('name', $old_name, $new_name, $user, $host, $time);
+ };
+ if ($@) {
+ $self->error ("object $type $old_name was renamed but not logged: $!");
+ return 1;
+ }
+
+ return 1;
+}
+
##############################################################################
# Core methods
##############################################################################
@@ -145,7 +195,7 @@ API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend
my @name = qw(file mysql-lsdb)
my @trace = ($user, $host, time);
- my $object = Wallet::Object::Keytab->create (@name, $schema, @trace);
+ my $object = Wallet::Object::File->create (@name, $schema, @trace);
unless ($object->store ("the-password\n")) {
die $object->error, "\n";
}