Imported Upstream version 1.3upstream/1.3

1 files changed, 59 insertions, 9 deletions

diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm
index f6ea342..552ba9d 100644
--- a/perl/lib/Wallet/Server.pm
+++ b/perl/lib/Wallet/Server.pm
@@ -1,6 +1,7 @@
-# Wallet::Server -- Wallet system server implementation.
+# Wallet::Server -- Wallet system server implementation
 #
 # Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2016 Russ Allbery <eagle@eyrie.org>
 # Copyright 2007, 2008, 2010, 2011, 2013, 2014
 #     The Board of Trustees of the Leland Stanford Junior University
 #
@@ -11,20 +12,16 @@
 ##############################################################################
 
 package Wallet::Server;
-require 5.006;
 
+use 5.008;
 use strict;
 use warnings;
-use vars qw(%MAPPING $VERSION);
 
 use Wallet::ACL;
 use Wallet::Config;
 use Wallet::Schema;
 
-# This version should be increased on any code change to this module.  Always
-# use two digits for the minor version with a leading zero if necessary so
-# that it will sort properly.
-$VERSION = '0.11';
+our $VERSION = '1.03';
 
 ##############################################################################
 # Utility methods
@@ -154,8 +151,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 +513,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 +746,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 +984,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