diff options
Diffstat (limited to 'perl/lib')
-rw-r--r-- | perl/lib/Wallet/ACL.pm | 35 | ||||
-rw-r--r-- | perl/lib/Wallet/Server.pm | 38 |
2 files changed, 73 insertions, 0 deletions
diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index a3b0146..370df8b 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -17,6 +17,7 @@ use strict; use warnings; use vars qw($VERSION); +use Wallet::Object::Base; use DateTime; use DBI; @@ -207,6 +208,32 @@ sub rename { return 1; } +# Moves everything owned by one ACL to instead be owned by another. You'll +# normally want to use rename, but this exists for cases where the replacing +# ACL already exists and has things assigned to it. Returns true on success, +# false on failure. +sub replace { + my ($self, $replace_id, $user, $host, $time) = @_; + $time ||= time; + + my %search = (ob_owner => $self->{id}); + my @objects = $self->{schema}->resultset('Object')->search (\%search); + if (@objects) { + for my $object (@objects) { + my $type = $object->ob_type; + my $name = $object->ob_name; + my $object = eval { + Wallet::Object::Base->new($type, $name, $self->{schema}); + }; + $object->owner ($replace_id, $user, $host, $time); + } + } else { + $self->error ("no objects found for ACL $self->{id}"); + return; + } + return 1; +} + # Destroy the ACL, deleting it out of the database. Returns true on success, # false on failure. # @@ -643,6 +670,14 @@ On failure, the caller should call error() to get the error message. Note that rename() operations are not logged in the ACL history. +=item replace(ID) + +Replace this ACL with another. This goes through each object owned by +the ACL and changes its ownership to the new ACL, leaving this acl owning +nothing (and probably then needing to be deleted). Returns true on +success and false on failure. On failure, the caller should call error() +to get the error message. + =item show() Returns a human-readable description of this ACL, including its diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index f6ea342..6af0570 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -734,6 +734,36 @@ sub acl_rename { return 1; } +# Move all ACLs owned by one ACL to another, or return undef and set the +# internal error. +sub acl_replace { + my ($self, $old_id, $replace_id) = @_; + unless ($self->{admin}->check ($self->{user})) { + $self->acl_error ($old_id, 'replace'); + return; + } + my $acl = eval { Wallet::ACL->new ($old_id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + if ($acl->name eq 'ADMIN') { + $self->error ('cannot replace the ADMIN ACL'); + return; + } + my $replace_acl = eval { Wallet::ACL->new ($replace_id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + + unless ($acl->replace ($replace_id, $self->{user}, $self->{host})) { + $self->error ($acl->error); + return; + } + return 1; +} + # Destroy an ACL, deleting it out of the database. Returns true on success. # On failure, returns undef, setting the internal error. sub acl_destroy { @@ -942,6 +972,14 @@ either the current name or the numeric ID. NEW must not be all-numeric. To rename an ACL, the current user must be authorized by the ADMIN ACL. Returns true on success and false on failure. +=item acl_replace(OLD, NEW) + +Moves any object owned by the ACL identified by OLD to be instead owned by +NEW. This goes through all objects owned by OLD and individually changes +the owner, along with history updates. OLD and NEW may be either the name +or the numeric ID. To replace an ACL, the current user must be authorized +by the ADMIN ACL. Returns true on success and false on failure. + =item acl_show(ID) Returns a human-readable description, including membership, of the ACL |