3 files changed, 98 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";
     }
diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm
index 95fd4e6..34075ed 100644
--- a/perl/lib/Wallet/Server.pm
+++ b/perl/lib/Wallet/Server.pm
@@ -244,6 +244,52 @@ sub autocreate {
     return 1;
 }
 
+# Rename an object.  We validate that the new name also falls within naming
+# constraints, then need to change all references to that.  If any updates
+# fail, we'll revert the entire commit.
+sub rename {
+    my ($self, $type, $name, $new_name) = @_;
+
+    my $schema = $self->{schema};
+    my $user = $self->{user};
+    my $host = $self->{host};
+
+    # Currently we only can rename file objects.
+    if (type ne 'file') {
+        $self->error ('rename is only supported for file objects');
+        return;
+    }
+
+    # Validate the new name.
+    if (defined (&Wallet::Config::verify_name)) {
+        my $error = Wallet::Config::verify_name ($type, $new_name, $user);
+        if ($error) {
+            $self->error ("${type}:${name} rejected: $error");
+            return;
+        }
+    }
+
+    # Get the object and error if it does not already exist.
+    my $class = $self->type_mapping ($type);
+    unless ($class) {
+        $self->error ("unknown object type $type");
+        return;
+    }
+    my $object = eval { $class->new ($type, $name, $schema) };
+    if ($@) {
+        $self->error ($@);
+        return;
+    }
+
+    # Rename the object.
+    $object = eval { $class->rename ($type, $name, $schema, $user, $host) };
+    if ($@) {
+        $self->error ($@);
+        return;
+    }
+    return $object;
+}
+
 # Given the name and type of an object, returns a Perl object representing it
 # or returns undef and sets the internal error.
 sub retrieve {