Switch to Module::Build for the Perl module

The wallet server now requires Perl 5.8 or later (instead of 5.006 in
previous versions) and is now built with Module::Build instead of
ExtUtils::MakeMaker.  This should be transparent to anyone not working
with the source code, since Perl 5.8 was released in 2002, but
Module::Build is now required to build the wallet server.  It is
included in some versions of Perl, or can be installed separately from
CPAN, distribution packages, or other sources.

Also reorganize the test suite to use subdirectories.

Change-Id: Id06120ba2bad1ebbfee3d8a48ca2f25869463165
Reviewed-on: https://gerrit.stanford.edu/1530
Reviewed-by: Russ Allbery <rra@stanford.edu>
Tested-by: Russ Allbery <rra@stanford.edu>

1 files changed, 353 insertions, 0 deletions

diff --git a/perl/t/object/base.t b/perl/t/object/base.t
new file mode 100755
index 0000000..0432a23
--- /dev/null
+++ b/perl/t/object/base.t
@@ -0,0 +1,353 @@
+#!/usr/bin/perl -w
+#
+# Tests for the basic object implementation.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 2008, 2011, 2014
+#     The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+use POSIX qw(strftime);
+use Test::More tests => 137;
+
+use Wallet::ACL;
+use Wallet::Admin;
+use Wallet::Config;
+use Wallet::Object::Base;
+
+use lib 't/lib';
+use Util;
+
+# Some global defaults to use.
+my $user = 'admin@EXAMPLE.COM';
+my $host = 'localhost';
+my @trace = ($user, $host, time);
+my $princ = 'service/test@EXAMPLE.COM';
+
+# Use Wallet::Admin to set up the database.
+db_setup;
+my $admin = eval { Wallet::Admin->new };
+is ($@, '', 'Database connection succeeded');
+is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
+my $schema = $admin->schema;
+
+# Okay, now we have a database.  Test create and new.  We make believe this is
+# a keytab object; it won't matter for what we're doing.
+my $object = eval {
+    Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
+  };
+is ($@, '', 'Object creation did not die');
+ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class');
+my $other = eval {
+    Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
+  };
+like ($@, qr/^cannot create object \Qkeytab:$princ: /, 'Repeating fails');
+$other = eval { Wallet::Object::Base->create ('', $princ, $schema, @trace) };
+is ($@, "invalid object type\n", 'Using an empty type fails');
+$other = eval { Wallet::Object::Base->create ('keytab', '', $schema, @trace) };
+is ($@, "invalid object name\n", ' as does an empty name');
+$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $schema) };
+is ($@, "cannot find keytab:a$princ\n", 'Searching for unknown object fails');
+$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) };
+is ($@, '', 'Object new did not die');
+ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class');
+
+# Simple accessor tests.
+is ($object->type, 'keytab', 'Type accessor works');
+is ($object->name, $princ, 'Name accessor works');
+
+# We'll use this for later tests.
+my $acl = Wallet::ACL->new ('ADMIN', $schema);
+
+# Owner.
+is ($object->owner, undef, 'Owner is not set to start');
+if ($object->owner ('ADMIN', @trace)) {
+    ok (1, ' and setting it to ADMIN works');
+} else {
+    is ($object->error, '', ' and setting it to ADMIN works');
+}
+is ($object->owner, $acl->id, ' at which point it is ADMIN');
+ok (! $object->owner ('unknown', @trace),
+    ' but setting it to something bogus fails');
+is ($object->error, 'ACL unknown not found', ' with the right error');
+if ($object->owner ('', @trace)) {
+    ok (1, ' and clearing it works');
+} else {
+    is ($object->error, '', ' and clearing it works');
+}
+is ($object->owner, undef, ' at which point it is cleared');
+is ($object->owner ('ADMIN', @trace), 1, ' and setting it again works');
+
+# Expires.
+is ($object->expires, undef, 'Expires is not set to start');
+my $now = strftime ('%Y-%m-%d %T', localtime time);
+if ($object->expires ($now, @trace)) {
+    ok (1, ' and setting it works');
+} else {
+    is ($object->error, '', ' and setting it works');
+}
+is ($object->expires, $now, ' at which point it matches');
+ok (! $object->expires ('13/13/13 13:13:13', @trace),
+    ' but setting it to something bogus fails');
+is ($object->error, 'malformed expiration time 13/13/13 13:13:13',
+    ' with the right error');
+if ($object->expires ('', @trace)) {
+    ok (1, ' and clearing it works');
+} else {
+    is ($object->error, '', ' and clearing it works');
+}
+is ($object->expires, undef, ' at which point it is cleared');
+is ($object->expires ($now, @trace), 1, ' and setting it again works');
+
+# Comment.
+is ($object->comment, undef, 'Comment is not set to start');
+if ($object->comment ('this is a comment', @trace)) {
+    ok (1, ' and setting it works');
+} else {
+    is ($object->error, '', ' and setting it works');
+}
+is ($object->comment, 'this is a comment', ' at which point it matches');
+if ($object->comment ('', @trace)) {
+    ok (1, ' and clearing it works');
+} else {
+    is ($object->error, '', ' and clearing it works');
+}
+is ($object->comment, undef, ' at which point it is cleared');
+is ($object->comment (join (' ', ('this is a comment') x 5), @trace), 1,
+    ' and setting it again works');
+
+# ACLs.
+for my $type (qw/get store show destroy flags/) {
+    is ($object->acl ($type), undef, "ACL $type is not set to start");
+    if ($object->acl ($type, $acl->id, @trace)) {
+        ok (1, ' and setting it to ADMIN (numeric) works');
+    } else {
+        is ($object->error, '', ' and setting it to ADMIN (numeric) works');
+    }
+    is ($object->acl ($type), $acl->id, ' at which point it is ADMIN');
+    ok (! $object->acl ($type, 22, @trace),
+        ' but setting it to something bogus fails');
+    is ($object->error, 'ACL 22 not found', ' with the right error');
+    if ($object->acl ($type, '', @trace)) {
+        ok (1, ' and clearing it works');
+    } else {
+        is ($object->error, '', ' and clearing it works');
+    }
+    is ($object->acl ($type), undef, ' at which point it is cleared');
+    is ($object->acl ($type, $acl->id, @trace), 1,
+        ' and setting it again works');
+}
+
+# Flags.
+my @flags = $object->flag_list;
+is (scalar (@flags), 0, 'No flags set to start');
+is ($object->flag_check ('locked'), 0, ' and locked is not set');
+is ($object->flag_set ('locked', @trace), 1, ' and setting locked works');
+is ($object->flag_check ('locked'), 1, ' and now locked is set');
+@flags = $object->flag_list;
+is (scalar (@flags), 1, ' and there is one flag');
+is ($flags[0], 'locked', ' which is locked');
+is ($object->flag_set ('locked', @trace), undef, 'Setting locked again fails');
+is ($object->error,
+    "cannot set flag locked on keytab:$princ: flag already set",
+    ' with the right error');
+is ($object->flag_set ('unchanging', @trace), 1,
+    ' but setting unchanging works');
+is ($object->flag_check ('unchanging'), 1, ' and unchanging is now set');
+@flags = $object->flag_list;
+is (scalar (@flags), 2, ' and there are two flags');
+is ($flags[0], 'locked', ' which are locked');
+is ($flags[1], 'unchanging', ' and unchanging');
+is ($object->flag_clear ('locked', @trace), 1, 'Clearing locked works');
+is ($object->flag_check ('locked'), 0, ' and now it is not set');
+is ($object->flag_check ('unchanging'), 1, ' but unchanging still is');
+is ($object->flag_clear ('locked', @trace), undef,
+    ' and clearing it again fails');
+is ($object->error,
+    "cannot clear flag locked on keytab:$princ: flag not set",
+    ' with the right error');
+if ($object->flag_set ('locked', @trace)) {
+    ok (1, ' and setting it again works');
+} else {
+    is ($object->error, '', ' and setting it again works');
+}
+
+# Attributes.  Very boring.
+is ($object->attr ('foo'), undef, 'Retrieving an attribute fails');
+is ($object->error, 'unknown attribute foo', ' with the right error');
+is ($object->attr ('foo', [ 'foo' ], @trace), undef, ' and setting fails');
+is ($object->error, 'unknown attribute foo', ' with the right error');
+
+# 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 setting owner fails');
+is ($object->error, "cannot modify keytab:${princ}: object is locked",
+    ' for the same reason');
+is ($object->owner, 1, ' but retrieving the owner works');
+is ($object->expires ('', @trace), undef, ' and setting expires fails');
+is ($object->error, "cannot modify keytab:${princ}: object is locked",
+    ' for the same reason');
+is ($object->expires, $now, ' but retrieving expires works');
+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->acl ($acl), 1, " but retrieving $acl ACL works");
+}
+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');
+is ($object->error, "cannot store keytab:$princ: object type is immutable",
+    ' with the right error');
+
+# Test show.
+my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
+my $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
+        Comment: this is a comment this is a comment this is a comment this is
+                 a comment this is a comment
+          Flags: unchanging
+     Created by: $user
+   Created from: $host
+     Created on: $date
+
+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
+        Comment: this is a comment this is a comment this is a comment this is
+                 a comment this is a comment
+          Flags: locked unchanging
+     Created by: $user
+   Created from: $host
+     Created on: $date
+
+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 {
+    is ($object->error, '', 'Destroy is successful');
+}
+$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) };
+is ($@, "cannot find keytab:$princ\n", ' and object is all gone');
+
+# Test history.
+$object = eval {
+    Wallet::Object::Base->create ('keytab', $princ, $schema, @trace)
+  };
+ok (defined ($object), 'Recreating the object succeeds');
+$output = <<"EOO";
+$date  create
+    by $user from $host
+$date  set owner to ADMIN (1)
+    by $user from $host
+$date  unset owner (was ADMIN (1))
+    by $user from $host
+$date  set owner to ADMIN (1)
+    by $user from $host
+$date  set expires to $now
+    by $user from $host
+$date  unset expires (was $now)
+    by $user from $host
+$date  set expires to $now
+    by $user from $host
+$date  set comment to this is a comment
+    by $user from $host
+$date  unset comment (was this is a comment)
+    by $user from $host
+$date  set comment to this is a comment this is a comment this is a comment this is a comment this is a comment
+    by $user from $host
+$date  set acl_get to ADMIN (1)
+    by $user from $host
+$date  unset acl_get (was ADMIN (1))
+    by $user from $host
+$date  set acl_get to ADMIN (1)
+    by $user from $host
+$date  set acl_store to ADMIN (1)
+    by $user from $host
+$date  unset acl_store (was ADMIN (1))
+    by $user from $host
+$date  set acl_store to ADMIN (1)
+    by $user from $host
+$date  set acl_show to ADMIN (1)
+    by $user from $host
+$date  unset acl_show (was ADMIN (1))
+    by $user from $host
+$date  set acl_show to ADMIN (1)
+    by $user from $host
+$date  set acl_destroy to ADMIN (1)
+    by $user from $host
+$date  unset acl_destroy (was ADMIN (1))
+    by $user from $host
+$date  set acl_destroy to ADMIN (1)
+    by $user from $host
+$date  set acl_flags to ADMIN (1)
+    by $user from $host
+$date  unset acl_flags (was ADMIN (1))
+    by $user from $host
+$date  set acl_flags to ADMIN (1)
+    by $user from $host
+$date  set flag locked
+    by $user from $host
+$date  set flag unchanging
+    by $user from $host
+$date  clear flag locked
+    by $user from $host
+$date  set flag locked
+    by $user from $host
+$date  clear flag locked
+    by $user from $host
+$date  set flag locked
+    by $user from $host
+$date  clear flag locked
+    by $user from $host
+$date  destroy
+    by $user from $host
+$date  create
+    by $user from $host
+EOO
+is ($object->history, $output, ' and the history is correct');
+
+# Clean up.
+$admin->destroy;
+END {
+    unlink 'wallet-db';
+}