aboutsummaryrefslogtreecommitdiff
path: root/perl/lib/Wallet/Server.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl/lib/Wallet/Server.pm')
-rw-r--r--perl/lib/Wallet/Server.pm57
1 files changed, 55 insertions, 2 deletions
diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm
index f6ea342..946ba10 100644
--- a/perl/lib/Wallet/Server.pm
+++ b/perl/lib/Wallet/Server.pm
@@ -154,8 +154,8 @@ sub create_check {
$self->error ($acl->error);
return;
}
- @entries = sort { $$a[0] cmp $$b[0] && $$a[1] cmp $$b[1] } @entries;
- @acl = sort { $$a[0] cmp $$b[0] && $$a[1] cmp $$b[1] } @acl;
+ @entries = sort { $$a[0] cmp $$b[0] || $$a[1] cmp $$b[1] } @entries;
+ @acl = sort { $$a[0] cmp $$b[0] || $$a[1] cmp $$b[1] } @acl;
my $okay = 1;
if (@entries != @acl) {
$okay = 0;
@@ -516,6 +516,21 @@ sub get {
return $result;
}
+# Retrieve the information associated with an object, updating the current
+# information if we are of a type that allows autogenerated information.
+# Returns undef and sets the internal error if the retrieval fails or if the
+# user isn't authorized. If the object doesn't exist, attempts dynamic
+# creation of the object using the default ACL mappings (if any).
+sub update {
+ my ($self, $type, $name) = @_;
+ my $object = $self->retrieve ($type, $name);
+ return unless defined $object;
+ return unless $self->acl_verify ($object, 'get');
+ my $result = $object->update ($self->{user}, $self->{host});
+ $self->error ($object->error) unless defined $result;
+ return $result;
+}
+
# Store new data in an object, or returns undef and sets the internal error if
# the object can't be found or if the user isn't authorized. Also don't
# permit storing undef, although storing the empty string is fine. If the
@@ -734,6 +749,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 +987,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