Imported Upstream version 1.3upstream/1.3

7 files changed, 185 insertions, 53 deletions

diff --git a/perl/t/object/base.t b/perl/t/object/base.t
index ee9ff4b..8fedd64 100755
--- a/perl/t/object/base.t
+++ b/perl/t/object/base.t
@@ -12,7 +12,7 @@ use strict;
 use warnings;
 
 use POSIX qw(strftime);
-use Test::More tests => 137;
+use Test::More tests => 139;
 
 use Wallet::ACL;
 use Wallet::Admin;
@@ -208,6 +208,9 @@ 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->update (@trace), 'Update fails');
+is ($object->error, 'update is not supported for this type, use get instead',
+    ' 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');
diff --git a/perl/t/object/duo-ldap.t b/perl/t/object/duo-ldap.t
index 3648eba..8a00dbb 100644
--- a/perl/t/object/duo-ldap.t
+++ b/perl/t/object/duo-ldap.t
@@ -26,7 +26,7 @@ BEGIN {
 BEGIN {
     use_ok('Wallet::Admin');
     use_ok('Wallet::Config');
-    use_ok('Wallet::Object::Duo::LDAPProxy');
+    use_ok('Wallet::Object::Duo');
 }
 
 use lib 't/lib';
@@ -53,15 +53,14 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' });
 
 # Test error handling in the absence of configuration.
 my $object = eval {
-    Wallet::Object::Duo::LDAPProxy->new ('duo-ldap', 'test', $schema);
+    Wallet::Object::Duo->new ('duo-ldap', 'test', $schema);
 };
-is ($object, undef, 'Wallet::Object::Duo::LDAPProxy new with no config failed');
+is ($object, undef, 'Wallet::Object::Duo new with no config failed');
 is ($@, "duo object implementation not configured\n", '...with correct error');
 $object = eval {
-    Wallet::Object::Duo::LDAPProxy->create ('duo-ldap', 'test', $schema,
-                                            @trace);
+    Wallet::Object::Duo->create ('duo-ldap', 'test', $schema, @trace);
 };
-is ($object, undef, 'Wallet::Object::Duo::LDAPProxy creation with no config failed');
+is ($object, undef, 'Wallet::Object::Duo creation with no config failed');
 is ($@, "duo object implementation not configured\n", '...with correct error');
 
 # Set up the Duo configuration.
@@ -83,9 +82,8 @@ $mock->expect (
         response_file => 't/data/duo/integration.json',
     }
 );
-$object = Wallet::Object::Duo::LDAPProxy->create ('duo-ldap', 'test', $schema,
-                                            @trace);
-isa_ok ($object, 'Wallet::Object::Duo::LDAPProxy');
+$object = Wallet::Object::Duo->create ('duo-ldap', 'test', $schema, @trace);
+isa_ok ($object, 'Wallet::Object::Duo');
 
 # Check the metadata about the new wallet object.
 $expected = <<"EOO";
@@ -127,7 +125,7 @@ is ($object->flag_clear ('locked', @trace), 1,
     '...and clearing locked flag works');
 
 # Create a new object by wallet type and name.
-$object = Wallet::Object::Duo::LDAPProxy->new ('duo-ldap', 'test', $schema);
+$object = Wallet::Object::Duo->new ('duo-ldap', 'test', $schema);
 
 # Test deleting an integration.  We can't test this entirely properly because
 # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected
@@ -144,8 +142,7 @@ TODO: {
     local $TODO = 'Net::Duo::Mock::Agent not yet capable';
 
     is ($object->destroy (@trace), 1, 'Duo object deletion succeeded');
-    $object = eval { Wallet::Object::Duo::LDAPProxy->new ('duo-ldap', 'test',
-                                                          $schema) };
+    $object = eval { Wallet::Object::Duo->new ('duo-ldap', 'test', $schema) };
     is ($object, undef, '...and now object cannot be retrieved');
     is ($@, "cannot find duo:test\n", '...with correct error');
 }
diff --git a/perl/t/object/duo-pam.t b/perl/t/object/duo-pam.t
index 7b88787..047343e 100644
--- a/perl/t/object/duo-pam.t
+++ b/perl/t/object/duo-pam.t
@@ -26,7 +26,7 @@ BEGIN {
 BEGIN {
     use_ok('Wallet::Admin');
     use_ok('Wallet::Config');
-    use_ok('Wallet::Object::Duo::PAM');
+    use_ok('Wallet::Object::Duo');
 }
 
 use lib 't/lib';
@@ -53,14 +53,14 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' });
 
 # Test error handling in the absence of configuration.
 my $object = eval {
-    Wallet::Object::Duo::PAM->new ('duo-pam', 'test', $schema);
+    Wallet::Object::Duo->new ('duo-pam', 'test', $schema);
 };
-is ($object, undef, 'Wallet::Object::Duo::PAM new with no config failed');
+is ($object, undef, 'Wallet::Object::Duo new with no config failed');
 is ($@, "duo object implementation not configured\n", '...with correct error');
 $object = eval {
-    Wallet::Object::Duo::PAM->create ('duo-pam', 'test', $schema, @trace);
+    Wallet::Object::Duo->create ('duo-pam', 'test', $schema, @trace);
 };
-is ($object, undef, 'Wallet::Object::Duo::PAM creation with no config failed');
+is ($object, undef, 'Wallet::Object::Duo creation with no config failed');
 is ($@, "duo object implementation not configured\n", '...with correct error');
 
 # Set up the Duo configuration.
@@ -82,9 +82,8 @@ $mock->expect (
         response_file => 't/data/duo/integration.json',
     }
 );
-$object = Wallet::Object::Duo::PAM->create ('duo-pam', 'test', $schema,
-                                            @trace);
-isa_ok ($object, 'Wallet::Object::Duo::PAM');
+$object = Wallet::Object::Duo->create ('duo-pam', 'test', $schema, @trace);
+isa_ok ($object, 'Wallet::Object::Duo');
 
 # Check the metadata about the new wallet object.
 $expected = <<"EOO";
@@ -126,7 +125,7 @@ is ($object->flag_clear ('locked', @trace), 1,
     '...and clearing locked flag works');
 
 # Create a new object by wallet type and name.
-$object = Wallet::Object::Duo::PAM->new ('duo-pam', 'test', $schema);
+$object = Wallet::Object::Duo->new ('duo-pam', 'test', $schema);
 
 # Test deleting an integration.  We can't test this entirely properly because
 # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected
@@ -143,8 +142,7 @@ TODO: {
     local $TODO = 'Net::Duo::Mock::Agent not yet capable';
 
     is ($object->destroy (@trace), 1, 'Duo object deletion succeeded');
-    $object = eval { Wallet::Object::Duo::PAM->new ('duo-pam', 'test',
-                                                    $schema) };
+    $object = eval { Wallet::Object::Duo->new ('duo-pam', 'test', $schema) };
     is ($object, undef, '...and now object cannot be retrieved');
     is ($@, "cannot find duo:test\n", '...with correct error');
 }
diff --git a/perl/t/object/duo-radius.t b/perl/t/object/duo-radius.t
index f258518..55cbb9d 100644
--- a/perl/t/object/duo-radius.t
+++ b/perl/t/object/duo-radius.t
@@ -26,7 +26,7 @@ BEGIN {
 BEGIN {
     use_ok('Wallet::Admin');
     use_ok('Wallet::Config');
-    use_ok('Wallet::Object::Duo::RadiusProxy');
+    use_ok('Wallet::Object::Duo');
 }
 
 use lib 't/lib';
@@ -53,17 +53,16 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' });
 
 # Test error handling in the absence of configuration.
 my $object = eval {
-    Wallet::Object::Duo::RadiusProxy->new ('duo-raduys', 'test', $schema);
+    Wallet::Object::Duo->new ('duo-radius', 'test', $schema);
 };
 is ($object, undef,
-    'Wallet::Object::Duo::RadiusProxy new with no config failed');
+    'Wallet::Object::Duo new with no config failed');
 is ($@, "duo object implementation not configured\n", '...with correct error');
 $object = eval {
-    Wallet::Object::Duo::RadiusProxy->create ('duo-radius', 'test', $schema,
-                                              @trace);
+    Wallet::Object::Duo->create ('duo-radius', 'test', $schema, @trace);
 };
 is ($object, undef,
-    'Wallet::Object::Duo::RadiusProxy creation with no config failed');
+    'Wallet::Object::Duo creation with no config failed');
 is ($@, "duo object implementation not configured\n", '...with correct error');
 
 # Set up the Duo configuration.
@@ -85,9 +84,8 @@ $mock->expect (
         response_file => 't/data/duo/integration-radius.json',
     }
 );
-$object = Wallet::Object::Duo::RadiusProxy->create ('duo-radius', 'test',
-                                                    $schema, @trace);
-isa_ok ($object, 'Wallet::Object::Duo::RadiusProxy');
+$object = Wallet::Object::Duo->create ('duo-radius', 'test', $schema, @trace);
+isa_ok ($object, 'Wallet::Object::Duo');
 
 # Check the metadata about the new wallet object.
 $expected = <<"EOO";
@@ -130,8 +128,7 @@ is ($object->flag_clear ('locked', @trace), 1,
     '...and clearing locked flag works');
 
 # Create a new object by wallet type and name.
-$object = Wallet::Object::Duo::RadiusProxy->new ('duo-radius', 'test',
-                                                 $schema);
+$object = Wallet::Object::Duo->new ('duo-radius', 'test', $schema);
 
 # Test deleting an integration.  We can't test this entirely properly because
 # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected
@@ -149,7 +146,7 @@ TODO: {
 
     is ($object->destroy (@trace), 1, 'Duo object deletion succeeded');
     $object = eval {
-        Wallet::Object::Duo::RadiusProxy->new ('duo-radius', 'test', $schema);
+        Wallet::Object::Duo->new ('duo-radius', 'test', $schema);
     };
     is ($object, undef, '...and now object cannot be retrieved');
     is ($@, "cannot find duo:test\n", '...with correct error');
diff --git a/perl/t/object/duo-rdp.t b/perl/t/object/duo-rdp.t
index 9b2d566..25060ac 100644
--- a/perl/t/object/duo-rdp.t
+++ b/perl/t/object/duo-rdp.t
@@ -26,7 +26,7 @@ BEGIN {
 BEGIN {
     use_ok('Wallet::Admin');
     use_ok('Wallet::Config');
-    use_ok('Wallet::Object::Duo::RDP');
+    use_ok('Wallet::Object::Duo');
 }
 
 use lib 't/lib';
@@ -53,14 +53,14 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' });
 
 # Test error handling in the absence of configuration.
 my $object = eval {
-    Wallet::Object::Duo::RDP->new ('duo-rdp', 'test', $schema);
+    Wallet::Object::Duo->new ('duo-rdp', 'test', $schema);
 };
-is ($object, undef, 'Wallet::Object::Duo::RDP new with no config failed');
+is ($object, undef, 'Wallet::Object::Duo new with no config failed');
 is ($@, "duo object implementation not configured\n", '...with correct error');
 $object = eval {
-    Wallet::Object::Duo::RDP->create ('duo-rdp', 'test', $schema, @trace);
+    Wallet::Object::Duo->create ('duo-rdp', 'test', $schema, @trace);
 };
-is ($object, undef, 'Wallet::Object::Duo::RDP creation with no config failed');
+is ($object, undef, 'Wallet::Object::Duo creation with no config failed');
 is ($@, "duo object implementation not configured\n", '...with correct error');
 
 # Set up the Duo configuration.
@@ -82,9 +82,8 @@ $mock->expect (
         response_file => 't/data/duo/integration-rdp.json',
     }
 );
-$object = Wallet::Object::Duo::RDP->create ('duo-rdp', 'test', $schema,
-                                            @trace);
-isa_ok ($object, 'Wallet::Object::Duo::RDP');
+$object = Wallet::Object::Duo->create ('duo-rdp', 'test', $schema, @trace);
+isa_ok ($object, 'Wallet::Object::Duo');
 
 # Check the metadata about the new wallet object.
 $expected = <<"EOO";
@@ -125,7 +124,7 @@ is ($object->flag_clear ('locked', @trace), 1,
     '...and clearing locked flag works');
 
 # Create a new object by wallet type and name.
-$object = Wallet::Object::Duo::RDP->new ('duo-rdp', 'test', $schema);
+$object = Wallet::Object::Duo->new ('duo-rdp', 'test', $schema);
 
 # Test deleting an integration.  We can't test this entirely properly because
 # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected
@@ -142,8 +141,7 @@ TODO: {
     local $TODO = 'Net::Duo::Mock::Agent not yet capable';
 
     is ($object->destroy (@trace), 1, 'Duo object deletion succeeded');
-    $object = eval { Wallet::Object::Duo::RDP->new ('duo-rdp', 'test',
-                                                    $schema) };
+    $object = eval { Wallet::Object::Duo->new ('duo-rdp', 'test', $schema) };
     is ($object, undef, '...and now object cannot be retrieved');
     is ($@, "cannot find duo:test\n", '...with correct error');
 }
diff --git a/perl/t/object/keytab.t b/perl/t/object/keytab.t
index 69db438..111b7d0 100755
--- a/perl/t/object/keytab.t
+++ b/perl/t/object/keytab.t
@@ -12,7 +12,7 @@ use strict;
 use warnings;
 
 use POSIX qw(strftime);
-use Test::More tests => 141;
+use Test::More tests => 142;
 
 BEGIN { $Wallet::Config::KEYTAB_TMP = '.' }
 
@@ -25,15 +25,28 @@ use Wallet::Object::Keytab;
 use lib 't/lib';
 use Util;
 
-# Mapping of klist -ke encryption type names to the strings that Kerberos uses
-# internally.  It's very annoying to have to maintain this, and it probably
-# breaks with Heimdal.
+# Mapping of klist -ke output from old MIT Kerberos implementations to to the
+# strings that Kerberos uses internally.  It's very annoying to have to
+# maintain this, and it probably breaks with Heimdal.
+#
+# Newer versions of MIT Kerberos just print out the canonical enctype names
+# and don't need this logic, but the current test requires that they still
+# have entries.  That's why the second set where the key and value are the
+# same.
 my %enctype =
     ('triple des cbc mode with hmac/sha1'      => 'des3-cbc-sha1',
      'des cbc mode with crc-32'                => 'des-cbc-crc',
      'des cbc mode with rsa-md5'               => 'des-cbc-md5',
+     'aes-128 cts mode with 96-bit sha-1 hmac' => 'aes128-cts-hmac-sha1-96',
      'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts-hmac-sha1-96',
-     'arcfour with hmac/md5'                   => 'rc4-hmac');
+     'arcfour with hmac/md5'                   => 'rc4-hmac',
+
+     'des3-cbc-sha1'                           => 'des3-cbc-sha1',
+     'des-cbc-crc'                             => 'des-cbc-crc',
+     'des-cbc-md5'                             => 'des-cbc-md5',
+     'aes128-cts-hmac-sha1-96'                 => 'aes128-cts-hmac-sha1-96',
+     'aes256-cts-hmac-sha1-96'                 => 'aes256-cts-hmac-sha1-96',
+     'rc4-hmac'                                => 'rc4-hmac');
 
 # Some global defaults to use.
 my $user = 'admin@EXAMPLE.COM';
@@ -159,7 +172,7 @@ my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
 
 # Basic keytab creation and manipulation tests.
 SKIP: {
-    skip 'no keytab configuration', 52 unless -f 't/data/test.keytab';
+    skip 'no keytab configuration', 53 unless -f 't/data/test.keytab';
 
     # Set up our configuration.
     $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
@@ -296,6 +309,7 @@ EOO
                                         @trace)
       };
     ok (defined ($object), 'Creating good principal succeeds');
+    is ($@, '', ' with no error');
     ok (created ('wallet/one'), ' and the principal was created');
   SKIP: {
         skip 'no kadmin program test for Heimdal', 2
diff --git a/perl/t/object/password.t b/perl/t/object/password.t
new file mode 100644
index 0000000..306d82b
--- /dev/null
+++ b/perl/t/object/password.t
@@ -0,0 +1,125 @@
+#!/usr/bin/perl
+#
+# Tests for the password object implementation.  Only includes tests that are
+# basic or different from the file object implementation.
+#
+# Written by Jon Robertson <jonrober@stanford.edu>
+# Copyright 2015
+#     The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+use strict;
+use warnings;
+
+use POSIX qw(strftime);
+use Test::More tests => 33;
+
+use Wallet::Admin;
+use Wallet::Config;
+use Wallet::Object::Password;
+
+use lib 't/lib';
+use Util;
+
+# Some global defaults to use.
+my $user = 'admin@EXAMPLE.COM';
+my $host = 'localhost';
+my @trace = ($user, $host, time);
+
+# Flush all output immediately.
+$| = 1;
+
+# Use Wallet::Admin to set up the database.
+system ('rm -rf test-files') == 0 or die "cannot remove test-files\n";
+db_setup;
+my $admin = eval { Wallet::Admin->new };
+is ($@, '', 'Database connection succeeded');
+is ($admin->reinitialize ($user), 1, 'Database initialization succeeded');
+my $schema = $admin->schema;
+
+# Use this to accumulate the history traces so that we can check history.
+my $history = '';
+my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);
+
+$Wallet::Config::PWD_FILE_BUCKET = undef;
+
+# Test error handling in the absence of configuration.
+my $object = eval {
+    Wallet::Object::Password->create ('password', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Creating a basic password object succeeds');
+ok ($object->isa ('Wallet::Object::Password'), ' and is the right class');
+is ($object->get (@trace), undef, ' and get fails');
+is ($object->error, 'password support not configured',
+    ' with the right error');
+is ($object->store (@trace), undef, ' and store fails');
+is ($object->error, 'password support not configured',
+    ' with the right error');
+is ($object->destroy (@trace), 1, ' but destroy succeeds');
+
+# Set up our configuration.
+mkdir 'test-files' or die "cannot create test-files: $!\n";
+$Wallet::Config::PWD_FILE_BUCKET = 'test-files';
+$Wallet::Config::PWD_LENGTH_MIN = 10;
+$Wallet::Config::PWD_LENGTH_MAX = 10;
+
+# Okay, now we can test.  First, the basic object without store.
+$object = eval {
+    Wallet::Object::Password->create ('password', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Creating a basic password object succeeds');
+ok ($object->isa ('Wallet::Object::Password'), ' and is the right class');
+my $pwd = $object->get (@trace);
+like ($pwd, qr{^.{$Wallet::Config::PWD_LENGTH_MIN}$},
+      ' and get creates a random password string of the right length');
+ok (-d 'test-files/09', ' and the hash bucket was created');
+ok (-f 'test-files/09/test', ' and the file exists');
+is (contents ('test-files/09/test'), $pwd, ' with the right contents');
+my $pwd2 = $object->get (@trace);
+is ($pwd, $pwd2, ' and getting again gives the same string');
+is ($object->destroy (@trace), 1, ' and destroying the object succeeds');
+
+# Now check to see if the password length is adjusted.
+$Wallet::Config::PWD_LENGTH_MIN = 20;
+$Wallet::Config::PWD_LENGTH_MAX = 20;
+$object = eval {
+    Wallet::Object::Password->create ('password', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Recreating the object succeeds');
+$pwd = $object->get (@trace);
+like ($pwd, qr{^.{$Wallet::Config::PWD_LENGTH_MIN}$},
+      ' and get creates a random password string of a longer length');
+is ($object->destroy (@trace), 1, ' and destroying the object succeeds');
+
+# Now store something and be sure that we get something reasonable.
+$object = eval {
+    Wallet::Object::Password->create ('password', 'test', $schema, @trace)
+  };
+ok (defined ($object), 'Recreating the object succeeds');
+is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds');
+ok (-f 'test-files/09/test', ' and the file exists');
+is (contents ('test-files/09/test'), 'foo', ' with the right contents');
+is ($object->get (@trace), "foo\n", ' and get returns correctly');
+unlink 'test-files/09/test';
+is ($object->get (@trace), undef,
+    ' and get will not autocreate a password if there used to be data');
+is ($object->error, 'cannot get password:test: object has not been stored',
+    ' as if it had not been stored');
+is ($object->store ("bar\n\0baz\n", @trace), 1, ' but storing again works');
+ok (-f 'test-files/09/test', ' and the file exists');
+is (contents ('test-files/09/test'), 'bar', ' with the right contents');
+is ($object->get (@trace), "bar\n\0baz\n", ' and get returns correctly');
+
+# And check to make sure update changes the contents.
+$pwd = $object->update (@trace);
+isnt ($pwd, "bar\n\0baz\n", 'Update changes the contents');
+like ($pwd, qr{^.{$Wallet::Config::PWD_LENGTH_MIN}$},
+      ' to a random password string of the right length');
+
+# Clean up.
+$admin->destroy;
+END {
+    system ('rm -r test-files') == 0 or die "cannot remove test-files\n";
+    unlink ('wallet-db');
+}