From dca2ad830232e2e8f9c577658f38779b66c8383a Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Tue, 18 Sep 2007 23:34:05 +0000
Subject: Implement the locked flag.

---
 perl/Wallet/Object/Base.pm   | 16 ++++++++++++++
 perl/Wallet/Object/Keytab.pm | 10 +++++++++
 perl/t/keytab.t              | 14 +++++++++++-
 perl/t/object.t              | 52 ++++++++++++++++++++++++++++++++++++++++----
 perl/t/server.t              | 33 ++++++++++++++++++++++++----
 5 files changed, 116 insertions(+), 9 deletions(-)

(limited to 'perl')

diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm
index 8d01ae8..10864b7 100644
--- a/perl/Wallet/Object/Base.pm
+++ b/perl/Wallet/Object/Base.pm
@@ -198,6 +198,10 @@ sub _set_internal {
     $time ||= time;
     my $name = $self->{name};
     my $type = $self->{type};
+    if ($self->flag_check ('locked')) {
+        $self->error ("cannot modify ${type}:${name}: object is locked");
+        return;
+    }
     eval {
         my $sql = "select ob_$attr from objects where ob_type = ? and
             ob_name = ?";
@@ -425,6 +429,10 @@ sub get { die "Do not instantiate Wallet::Object::Base directly\n"; }
 sub store {
     my ($self, $data, $user, $host, $time) = @_;
     my $id = $self->{type} . ':' . $self->{name};
+    if ($self->flag_check ('locked')) {
+        $self->error ("cannot store $id: object is locked");
+        return;
+    }
     $self->error ("cannot store $id: object type is immutable");
     return;
 }
@@ -508,6 +516,10 @@ sub destroy {
     $time ||= time;
     my $name = $self->{name};
     my $type = $self->{type};
+    if ($self->flag_check ('locked')) {
+        $self->error ("cannot destroy ${type}:${name}: object is locked");
+        return;
+    }
     eval {
         my $sql = 'delete from flags where fl_type = ? and fl_name = ?';
         $self->{dbh}->do ($sql, undef, $type, $name);
@@ -596,6 +608,10 @@ The following methods may be called on instantiated wallet objects.
 Normally, the only methods that a subclass will need to override are get(),
 store(), show(), and destroy().
 
+If the locked flag is set on an object, no actions may be performed on that
+object except for the flag methods and show().  All other actions will be
+rejected with an error saying the object is locked.
+
 =over 4
 
 =item acl(TYPE [, ACL, PRINCIPAL, HOSTNAME [, DATETIME]])
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index 38e0938..e4a41cd 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -187,6 +187,11 @@ sub create {
 # Override destroy to delete the principal out of Kerberos as well.
 sub destroy {
     my ($self, $user, $host, $time) = @_;
+    my $id = $self->{type} . ':' . $self->{name};
+    if ($self->flag_check ('locked')) {
+        $self->error ("cannot destroy $id: object is locked");
+        return;
+    }
     return undef if not $self->_kadmin_delprinc ($self->{name});
     return $self->SUPER::destroy ($user, $host, $time);
 }
@@ -196,6 +201,11 @@ sub destroy {
 sub get {
     my ($self, $user, $host, $time) = @_;
     $time ||= time;
+    my $id = $self->{type} . ':' . $self->{name};
+    if ($self->flag_check ('locked')) {
+        $self->error ("cannot get $id: object is locked");
+        return;
+    }
     unless (defined ($Wallet::Config::KEYTAB_TMP)) {
         $self->error ('KEYTAB_TMP configuration variable not set');
         return undef;
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 360065d..9337c80 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -3,7 +3,7 @@
 #
 # t/keytab.t -- Tests for the keytab object implementation.
 
-use Test::More tests => 38;
+use Test::More tests => 46;
 
 use Wallet::Config;
 use Wallet::Object::Keytab;
@@ -162,6 +162,12 @@ SKIP: {
     $object = Wallet::Object::Keytab->new ('keytab', 'wallet/one', $dbh);
     ok (defined ($object), 'Retrieving the object works');
     ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right type');
+    is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
+    is ($object->get (@trace), undef, ' and get fails');
+    is ($object->error, "cannot get keytab:wallet/one: object is locked",
+        ' because it is locked');
+    is ($object->flag_clear ('locked', @trace), 1,
+        ' and clearing locked works');
     my $data = $object->get (@trace);
     if (defined ($data)) {
         ok (defined ($data), ' and getting the keytab works');
@@ -220,6 +226,12 @@ EOO
     like ($object->error, qr{^cannot run /some/nonexistent/file: },
           ' with the right error');
     $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
+    is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
+    is ($object->destroy (@trace), undef, ' and destroying it fails');
+    is ($object->error, "cannot destroy keytab:wallet/one: object is locked",
+        ' because it is locked');
+    is ($object->flag_clear ('locked', @trace), 1,
+        ' and clearing locked works');
     is ($object->destroy (@trace), 1, ' and destroying it succeeds');
     ok (! created ('wallet/one'), ' and now it does not exist');
 
diff --git a/perl/t/object.t b/perl/t/object.t
index db7cb98..0349f28 100755
--- a/perl/t/object.t
+++ b/perl/t/object.t
@@ -3,7 +3,7 @@
 #
 # t/object.t -- Tests for the basic object implementation.
 
-use Test::More tests => 93;
+use Test::More tests => 118;
 
 use Wallet::ACL;
 use Wallet::Config;
@@ -150,8 +150,27 @@ if ($object->flag_set ('locked', @trace)) {
     is ($object->error, '', ' and setting it again works');
 }
 
-# Test stub methods.
-eval { $object->get };
+# Test stub methods and locked status.
+is ($object->store ("Some data", @trace), undef, 'Store fails');
+is ($object->error, "cannot store keytab:${princ}: object is locked",
+    ' because the object is locked');
+is ($object->owner ('', @trace), undef, ' and owner fails');
+is ($object->error, "cannot modify keytab:${princ}: object is locked",
+    ' for the same reason');
+is ($object->expires ('', @trace), undef, ' and expires fails');
+is ($object->error, "cannot modify keytab:${princ}: object is locked",
+    ' for the same reason');
+for my $acl (qw/get store show destroy flags/) {
+    is ($object->acl ($acl, '', @trace), undef, " and setting $acl ACL fails");
+    is ($object->error, "cannot modify keytab:${princ}: object is locked",
+        ' for the same reason');
+}
+is ($object->flag_check ('locked'), 1, ' and checking flags works');
+@flags = $object->flag_list;
+is (scalar (@flags), 2, ' and listing flags works');
+is ("@flags", 'locked unchanging', ' and returns the right data');
+is ($object->flag_clear ('locked', @trace), 1, 'Clearing locked succeeds');
+eval { $object->get (@trace) };
 is ($@, "Do not instantiate Wallet::Object::Base directly\n",
     'Get fails with the right error');
 ok (! $object->store ("Some data", @trace), 'Store fails');
@@ -169,7 +188,7 @@ my $output = <<"EOO";
     Destroy ACL: ADMIN
       Flags ACL: ADMIN
         Expires: $now
-          Flags: locked unchanging
+          Flags: unchanging
      Created by: $user
    Created from: $host
      Created on: $created
@@ -178,8 +197,33 @@ Members of ACL ADMIN (id: 1) are:
   krb5 $user
 EOO
 is ($object->show, $output, 'Show output is correct');
+is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
+$output = <<"EOO";
+           Type: keytab
+           Name: $princ
+          Owner: ADMIN
+        Get ACL: ADMIN
+      Store ACL: ADMIN
+       Show ACL: ADMIN
+    Destroy ACL: ADMIN
+      Flags ACL: ADMIN
+        Expires: $now
+          Flags: locked unchanging
+     Created by: $user
+   Created from: $host
+     Created on: $created
+
+Members of ACL ADMIN (id: 1) are:
+  krb5 $user
+EOO
+is ($object->show, $output, ' and show still works and is correct');
 
 # Test destroy.
+is ($object->destroy (@trace), undef, 'Destroy fails');
+is ($object->error, "cannot destroy keytab:${princ}: object is locked",
+    ' because of the locked status');
+is ($object->flag_clear ('locked', @trace), 1,
+    ' and clearing locked status works');
 if ($object->destroy (@trace)) {
     ok (1, 'Destroy is successful');
 } else {
diff --git a/perl/t/server.t b/perl/t/server.t
index 8dc2b89..e061f1a 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -3,7 +3,7 @@
 #
 # t/server.t -- Tests for the wallet server API.
 
-use Test::More tests => 241;
+use Test::More tests => 261;
 
 use Wallet::Config;
 use Wallet::Server;
@@ -300,6 +300,8 @@ is ($server->store ('base', 'service/admin', 'stuff'), undef,
     ' and now store fails');
 is ($server->error, "$admin not authorized to store base:service/admin",
     ' due to permissions again');
+is ($server->owner ('base', 'service/admin', 'ADMIN'), 1,
+    ' and setting the owner again works');
 
 # Test manipulating flags.
 is ($server->flag_clear ('base', 'service/admin', 'locked'), undef,
@@ -312,8 +314,27 @@ if ($server->flag_set ('base', 'service/admin', 'locked')) {
 } else {
     is ($server->error, '', ' but setting it works');
 }
+is ($server->store ('base', 'service/admin', 'stuff'), undef,
+    ' now store fails');
+is ($server->error, 'cannot store base:service/admin: object is locked',
+    ' because the object is locked');
+is ($server->expires ('base', 'service/admin', ''), undef,
+    ' and expires fails');
+is ($server->error, 'cannot modify base:service/admin: object is locked',
+    ' because the object is locked');
+is ($server->owner ('base', 'service/admin', ''), undef, ' and owner fails');
+is ($server->error, 'cannot modify base:service/admin: object is locked',
+    ' because the object is locked');
+for my $acl (qw/get store show destroy flags/) {
+    is ($server->acl ('base', 'service/admin', $acl, ''), undef,
+        " and setting $acl ACL fails");
+    is ($server->error, 'cannot modify base:service/admin: object is locked',
+        ' for the same reason');
+}
 is ($server->flag_clear ('base', 'service/admin', 'locked'), 1,
     ' and then clearing it works');
+is ($server->owner ('base', 'service/admin', ''), 1,
+    ' and then clearing owner works');
 is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1,
     ' and setting unchanging works');
 is ($server->flag_clear ('base', 'service/admin', 'locked'), undef,
@@ -438,8 +459,6 @@ is ($server->error,
 is ($server->flag_set ('base', 'service/both', 'unchanging'), 1,
     ' and set flags on an object we have an ACL');
 is ($server->flag_set ('base', 'service/both', 'locked'), 1, ' both flags');
-is ($server->flag_clear ('base', 'service/both', 'locked'), 1,
-    ' and clear flags');
 $show = $server->show ('base', 'service/both');
 $show =~ s/(Created on:) \d+$/$1 0/m;
 $expected = <<"EOO";
@@ -449,7 +468,7 @@ $expected = <<"EOO";
        Show ACL: user1
     Destroy ACL: user2
       Flags ACL: user1
-          Flags: unchanging
+          Flags: locked unchanging
      Created by: $admin
    Created from: $host
      Created on: 0
@@ -465,6 +484,12 @@ Members of ACL user2 (id: 3) are:
   krb5 $user2
 EOO
 is ($show, $expected, ' and show an object we jointly own');
+is ($server->store ('base', 'service/both', 'stuff'), undef,
+    ' but not store data');
+is ($server->error, 'cannot store base:service/both: object is locked',
+    ' when the object is locked');
+is ($server->flag_clear ('base', 'service/both', 'locked'), 1,
+    ' and clear flags');
 is ($server->destroy ('base', 'service/both'), undef,
     ' but not destroy it');
 is ($server->error, "$user1 not authorized to destroy base:service/both",
-- 
cgit v1.2.3