Add default owner support to Stanford naming policy

Add support for a default owner for host-based file objects to
Wallet::Policy::Stanford.

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

2 files changed, 42 insertions, 2 deletions

diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm
index 640c43c..0183df8 100644
--- a/perl/Wallet/Policy/Stanford.pm
+++ b/perl/Wallet/Policy/Stanford.pm
@@ -122,6 +122,22 @@ sub _host_for_file_legacy {
     return $host;
 }
 
+# Map a file object name to a hostname.  Returns undef if this file object
+# name doesn't map to a hostname.
+sub _host_for_file {
+    my ($name) = @_;
+
+    # If $name doesn't contain /, defer to the legacy naming scheme.
+    if ($name !~ m{ / }xms) {
+        return _host_for_file_legacy($name);
+    }
+
+    # Parse the name and check whether this is a host-based object.
+    my ($type, $host) = split('/', $name);
+    return if !$FILE_TYPES{$type}{host};
+    return $host;
+}
+
 # Map a keytab object name to a hostname and return it.  Returns undef if this
 # keytab principal name doesn't map to a hostname.
 sub _host_for_keytab {
@@ -144,7 +160,7 @@ sub default_owner {
     my ($type, $name) = @_;
     my %host_for = (
         keytab => \&_host_for_keytab,
-        file   => \&_host_for_file_legacy,
+        file   => \&_host_for_file,
     );
     return unless defined $host_for{$type};
     my $host = $host_for{$type}->($name);
diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t
index 2ed8014..909ad1e 100755
--- a/perl/t/stanford-naming.t
+++ b/perl/t/stanford-naming.t
@@ -16,7 +16,7 @@ use 5.008;
 use strict;
 use warnings;
 
-use Test::More tests => 91;
+use Test::More tests => 94;
 
 use lib 't/lib';
 use Util;
@@ -203,6 +203,30 @@ is(default_owner('keytab', 'service/foo'), undef,
 is(default_owner('unknown', 'foo'), undef,
     'No default owner for unknown type');
 
+# Check for autocreation mappings for host-based file objects.
+is_deeply(
+    [default_owner('file', 'ssl-key/example.stanford.edu')],
+    [
+        'host/example.stanford.edu',
+        ['netdb-root', 'example.stanford.edu'],
+        ['krb5', 'host/example.stanford.edu@stanford.edu']
+    ],
+    'Default owner for file ssl-key/example.stanford.edu',
+);
+is_deeply(
+    [default_owner('file', 'ssl-key/example.stanford.edu/mysql')],
+    [
+        'host/example.stanford.edu',
+        ['netdb-root', 'example.stanford.edu'],
+        ['krb5', 'host/example.stanford.edu@stanford.edu']
+    ],
+    'Default owner for file ssl-key/example.stanford.edu/mysql',
+);
+
+# Check for a file object that isn't host-based.
+is(default_owner('file', 'config/idg/example/foo'), undef,
+    'No default owner for non-host-based file type');
+
 # Check for legacy autocreation mappings for file objects.
 for my $type (qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key)) {
     my $name = "idg-example-$type";