From 0753a60cc0b6f9873c6b9fe70e298bd045306466 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 3 Feb 2013 23:24:40 -0800 Subject: Add current Stanford naming policy and test suite To make it easier to revise and test revisions to the Stanford wallet naming policy, convert the code to a module and include it in the distribution. Add a test suite for the current policy. Change-Id: I73b888fa8d18401a239144c2e9f810ad4692c44b Reviewed-on: https://gerrit.stanford.edu/755 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/t/stanford-naming.t | 193 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 193 insertions(+) create mode 100755 perl/t/stanford-naming.t (limited to 'perl/t/stanford-naming.t') diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t new file mode 100755 index 0000000..ec3760a --- /dev/null +++ b/perl/t/stanford-naming.t @@ -0,0 +1,193 @@ +#!/usr/bin/perl +# +# Tests for the Stanford naming policy. +# +# The naming policy code is included primarily an example for non-Stanford +# sites, but it's used at Stanford and this test suite is used to verify +# behavior at Stanford. +# +# Written by Russ Allbery +# Copyright 2013 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use 5.008; +use strict; +use warnings; + +use Test::More tests => 57; + +use lib 't/lib'; +use Util; + +# Load the naming policy module. +BEGIN { + use_ok('Wallet::Admin'); + use_ok('Wallet::Policy::Stanford', qw(default_owner verify_name)); + use_ok('Wallet::Server'); +} + +# Various valid keytab names. +my @VALID_KEYTABS = qw(host/example.stanford.edu HTTP/example.stanford.edu + service/example example/cgi class-example01/cgi dept-01example/cgi + group-example-01/cgi); + +# Various invalid keytab names. +my @INVALID_KEYTABS = qw(example host/example service/example.stanford.edu + thisistoolong/cgi not-valid/cgi unknown/example.stanford.edu); + +# Various valid file names. +my @VALID_FILES = qw(apps-example-config-file crcsg-example-db-s_example + idg-debian-gpg-key idg-devnull-password-root sulair-accounts-properties + idg-accounts-ssl-keystore idg-accounts-ssl-pkcs12 + crcsg-example-htpasswd-web sulair-example-password-ipmi + sulair-example-password-root sulair-example-password-tivoli + sulair-example-ssh-dsa sulair-example-ssh-rsa idg-mdm-ssl-key + idg-openafs-tivoli-key); + +# Various invalid file names. +my @INVALID_FILES = qw(unknown foo-example-ssh-rsa idg-accounts-foo !!bad); + +# Global variables for the wallet server setup. +my $ADMIN = 'admin@EXAMPLE.COM'; +my $HOST = 'localhost'; +my @TRACE = ($ADMIN, $HOST); + +# Start by testing lots of straightforward naming validity. +for my $name (@VALID_KEYTABS) { + is(verify_name('keytab', $name), undef, "Valid keytab $name"); +} +for my $name (@INVALID_KEYTABS) { + isnt(verify_name('keytab', $name), undef, "Invalid keytab $name"); +} +for my $name (@VALID_FILES) { + is(verify_name('file', $name), undef, "Valid file $name"); +} +for my $name (@INVALID_FILES) { + isnt(verify_name('file', $name), undef, "Invalid file $name"); +} + +# Now we need an actual database. Use Wallet::Admin to set it up. +db_setup; +my $setup = eval { Wallet::Admin->new }; +is($@, q{}, 'Database initialization did not die'); +is($setup->reinitialize($ADMIN), 1, 'Database initialization succeeded'); +my $server = eval { Wallet::Server->new(@TRACE) }; +is($@, q{}, 'Server creation did not die'); + +# Create a host/example.stanford.edu ACL that uses the netdb ACL type. +is($server->acl_create('host/example.stanford.edu'), 1, 'Created netdb ACL'); +is( + $server->acl_add('host/example.stanford.edu', 'netdb', + 'example.stanford.edu'), + 1, + '...with netdb ACL line' +); +is( + $server->acl_add('host/example.stanford.edu', 'krb5', + 'host/example.stanford.edu@stanford.edu'), + 1, + '...and krb5 ACL line' +); + +# Likewise for host/foo.example.edu with the netdb-root ACL type. +is($server->acl_create('host/foo.stanford.edu'), 1, 'Created netdb-root ACL'); +is( + $server->acl_add('host/foo.stanford.edu', 'netdb-root', + 'foo.stanford.edu'), + 1, + '...with netdb-root ACL line' +); +is( + $server->acl_add('host/foo.stanford.edu', 'krb5', + 'host/foo.stanford.edu@stanford.edu'), + 1, + '...and krb5 ACL line' +); + +# Now we can test default ACLs. First, without a root instance. +local $ENV{REMOTE_USER} = $ADMIN; +is_deeply( + [default_owner('keytab', 'host/bar.stanford.edu')], + [ + 'host/bar.stanford.edu', + ['netdb', 'bar.stanford.edu'], + ['krb5', 'host/bar.stanford.edu@stanford.edu'] + ], + 'Correct default owner for host-based keytab' +); +is_deeply( + [default_owner('keytab', 'HTTP/example.stanford.edu')], + [ + 'host/example.stanford.edu', + ['netdb', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + '...and when netdb ACL already exists' +); +is_deeply( + [default_owner('keytab', 'webauth/foo.stanford.edu')], + [ + 'host/foo.stanford.edu', + ['netdb-root', 'foo.stanford.edu'], + ['krb5', 'host/foo.stanford.edu@stanford.edu'] + ], + '...and when netdb-root ACL already exists' +); + +# Now with a root instance. +local $ENV{REMOTE_USER} = 'admin/root@stanford.edu'; +is_deeply( + [default_owner('keytab', 'host/bar.stanford.edu')], + [ + 'host/bar.stanford.edu', + ['netdb-root', 'bar.stanford.edu'], + ['krb5', 'host/bar.stanford.edu@stanford.edu'] + ], + 'Correct default owner for host-based keytab for /root' +); +is_deeply( + [default_owner('keytab', 'HTTP/example.stanford.edu')], + [ + 'host/example.stanford.edu', + ['netdb-root', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + '...and when netdb ACL already exists' +); +is_deeply( + [default_owner('keytab', 'webauth/foo.stanford.edu')], + [ + 'host/foo.stanford.edu', + ['netdb-root', 'foo.stanford.edu'], + ['krb5', 'host/foo.stanford.edu@stanford.edu'] + ], + '...and when netdb-root ACL already exists' +); + +# Check for a type that isn't host-based. +is(default_owner('keytab', 'service/foo'), undef, + 'No default owner for service/foo'); + +# Check for an unknown object type. +is(default_owner('unknown', 'foo'), undef, + 'No default owner for unknown 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"; + is_deeply( + [default_owner('file', $name)], + [ + 'host/example.stanford.edu', + ['netdb-root', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + "Default owner for file $name", + ); +} + +# Clean up. +$setup->destroy; +unlink 'wallet-db'; -- cgit v1.2.3 From abcbf4eada033bd364d685f56e80f0bd07a3f76a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 5 Feb 2013 18:09:49 -0800 Subject: Refactor Stanford naming policy, add new file patterns Refactor the Wallet::Policy::Stanford module to pull some of the constants out, and then add data and support in the naming policy for the new file object naming scheme. Change-Id: Iba0c24c119ce529a1d3fd8cd3332335c4433df09 Reviewed-on: https://gerrit.stanford.edu/756 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Policy/Stanford.pm | 176 +++++++++++++++++++++++++++++++++-------- perl/t/stanford-naming.t | 35 +++++++- 2 files changed, 174 insertions(+), 37 deletions(-) (limited to 'perl/t/stanford-naming.t') diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm index 906f6ba..640c43c 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/Wallet/Policy/Stanford.pm @@ -29,6 +29,59 @@ BEGIN { @EXPORT_OK = qw(default_owner verify_name); } +############################################################################## +# Configuration +############################################################################## + +# These variables are all declared as globals so that they can be overridden +# from wallet.conf if desirable. + +# The domain to append to hostnames to fully-qualify them. +our $DOMAIN = 'stanford.edu'; + +# Groups for file object naming. This default is entirely Stanford-specific, +# even more so than the rest of this file. +our @GROUPS = qw(apps crcsg gsb idg sysadmin sulair vast); + +# File object types. Each type can have one or more parameters: whether it is +# host-based (host), whether it takes a qualifier after the host or service +# (extra), and whether that qualifier is mandatory (need_extra). +our %FILE_TYPES = ( + config => { extra => 1, need_extra => 1 }, + db => { extra => 1, need_extra => 1 }, + 'gpg-key' => { }, + htpasswd => { host => 1, extra => 1, need_extra => 1 }, + password => { extra => 1, need_extra => 1 }, + 'password-ipmi' => { host => 1 }, + 'password-root' => { host => 1 }, + 'password-tivoli' => { host => 1 }, + properties => { extra => 1 }, + 'ssh-dsa' => { host => 1 }, + 'ssh-rsa' => { host => 1 }, + 'ssl-key' => { host => 1, extra => 1 }, + 'ssl-keystore' => { extra => 1 }, + 'ssl-pkcs12' => { extra => 1 }, + 'tivoli-key' => { host => 1 }, +); + +# Host-based file object types for the legacy file object naming scheme. +our @FILE_HOST_LEGACY = qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key); + +# File object types for the legacy file object naming scheme. +our @FILE_TYPES_LEGACY = qw(config db gpg-key htpasswd password properties + ssh-rsa ssh-dsa ssl-key ssl-keystore ssl-pkcs12 tivoli-key); + +# Host-based Kerberos principal prefixes. +our @KEYTAB_HOST = qw(HTTP afpserver cifs ftp host imap ipp ldap lpr nfs pop + postgres sieve smtp webauth xmpp); + +# The Kerberos realm, used when forming principals for krb5 ACLs. +our $REALM = 'stanford.edu'; + +# A file listing principal names that should be required to use a root +# instance to autocreate any objects. +our $ROOT_REQUIRED = '/etc/remctl/acl/its-idg'; + ############################################################################## # Implementation ############################################################################## @@ -40,7 +93,7 @@ BEGIN { # pose a security problem. # # On any failure, just return an empty ACL to use the default. -sub acl_has_netdb_root { +sub _acl_has_netdb_root { my ($name) = @_; my $schema = eval { Wallet::Schema->connect }; return unless ($schema and not $@); @@ -52,19 +105,19 @@ sub acl_has_netdb_root { return; } -# Map a file object name to a hostname and return it. Returns undef if this -# file object name doesn't map to a hostname. -sub _host_for_file { +# Map a file object name to a hostname for the legacy file object naming +# scheme and return it. Returns undef if this file object name doesn't map to +# a hostname. +sub _host_for_file_legacy { my ($name) = @_; - my %allowed = map { $_ => 1 } - qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key); + my %allowed = map { $_ => 1 } @FILE_HOST_LEGACY; my $allowed_regex = '(?:' . join ('|', sort keys %allowed) . ')'; if ($name !~ /^[^-]+-(.*)-$allowed_regex(?:-.*)?$/) { return; } my $host = $1; if ($host !~ /\./) { - $host .= '.stanford.edu'; + $host .= q{.} . $DOMAIN; } return $host; } @@ -73,14 +126,12 @@ sub _host_for_file { # keytab principal name doesn't map to a hostname. sub _host_for_keytab { my ($name) = @_; - my %allowed = map { $_ => 1 } - qw(HTTP afpserver cifs ftp host imap ipp ldap lpr nfs pop postgres - sieve smtp webauth xmpp); + my %allowed = map { $_ => 1 } @KEYTAB_HOST; return unless $name =~ m,/,; my ($service, $host) = split ('/', $name, 2); return unless $allowed{$service}; if ($host !~ /\./) { - $host .= '.stanford.edu'; + $host .= q{.} . $DOMAIN; } return $host; } @@ -91,22 +142,21 @@ sub _host_for_keytab { # using root instances by default. sub default_owner { my ($type, $name) = @_; - my $realm = 'stanford.edu'; my %host_for = ( keytab => \&_host_for_keytab, - file => \&_host_for_file, + file => \&_host_for_file_legacy, ); return unless defined $host_for{$type}; my $host = $host_for{$type}->($name); return unless $host; my $acl_name = "host/$host"; my @acl; - if ($ENV{REMOTE_USER} =~ m,/root, or acl_has_netdb_root ($acl_name)) { + if ($ENV{REMOTE_USER} =~ m,/root, or _acl_has_netdb_root ($acl_name)) { @acl = ([ 'netdb-root', $host ], - [ 'krb5', "host/$host\@$realm" ]); + [ 'krb5', "host/$host\@$REALM" ]); } else { @acl = ([ 'netdb', $host ], - [ 'krb5', "host/$host\@$realm" ]); + [ 'krb5', "host/$host\@$REALM" ]); } return ($acl_name, @acl); } @@ -119,11 +169,8 @@ sub default_owner { # creation using a */root instance. sub verify_name { my ($type, $name, $user) = @_; - my %host = map { $_ => 1 } - qw(HTTP afpserver cifs ftp http host ident imap ipp ldap lpr nfs pop - postgres sieve smtp uniengd webauth xmpp); my %staff; - if (open (STAFF, '<', '/etc/remctl/acl/its-idg')) { + if (open (STAFF, '<', $ROOT_REQUIRED)) { local $_; while () { s/^\s+//; @@ -141,6 +188,7 @@ sub verify_name { # Check keytab naming conventions. if ($type eq 'keytab') { + my %host = map { $_ => 1 } @KEYTAB_HOST; if ($name !~ m,^[a-zA-Z0-9_-]+/[a-z0-9.-]+$,) { return "invalid principal name $name"; } @@ -169,20 +217,80 @@ sub verify_name { # Check file object naming conventions. if ($type eq 'file') { - my %groups = map { $_ => 1 } - qw(apps crcsg gsb idg sysadmin sulair vast); - my %types = map { $_ => 1 } - qw(config db gpg-key htpasswd password properties ssh-rsa ssh-dsa - ssl-key ssl-keystore ssl-pkcs12 tivoli-key); - if ($name !~ m,^[a-zA-Z0-9_.-]+$,) { - return "invalid file object $name"; - } - my $group_regex = '(?:' . join ('|', sort keys %groups) . ')'; - my $type_regex = '(?:' . join ('|', sort keys %types) . ')'; - if ($name !~ /^$group_regex-/) { - return "no recognized owning group in $name"; - } elsif ($name !~ /^$group_regex-.*-$type_regex(-.*)?$/) { - return "invalid file object name $name"; + my %groups = map { $_ => 1 } @GROUPS; + if ($name =~ m{ / }xms) { + my @name = split('/', $name); + + # Names have between two and four components and all must be + # non-empty. + if (@name > 4) { + return "too many components in $name"; + } + if (@name < 2) { + return "too few components in $name"; + } + if (grep { $_ eq q{} } @name) { + return "empty component in $name"; + } + + # All objects start with the type. First check if this is a + # host-based type. + my $type = shift @name; + if ($FILE_TYPES{$type} && $FILE_TYPES{$type}{host}) { + my ($host, $extra) = @name; + if ($host !~ m{ [.] }xms) { + return "host name $host is not fully qualified"; + } + if (defined($extra) && !$FILE_TYPES{$type}{extra}) { + return "extraneous component at end of $name"; + } + if (!defined($extra) && $FILE_TYPES{$type}{need_extra}) { + return "missing component in $name"; + } + return; + } + + # Otherwise, the name is group-based. There be at least two + # remaining components. + if (@name < 2) { + return "too few components in $name"; + } + my ($group, $service, $extra) = @name; + + # Check the group. + if (!$groups{$group}) { + return "unknown group $group"; + } + + # Check the type. Be sure it's not host-based. + if (!$FILE_TYPES{$type}) { + return "unknown type $type"; + } + if ($FILE_TYPES{$type}{host}) { + return "bad name for host-based file type $type"; + } + + # Check the extra data. + if (defined($extra) && !$FILE_TYPES{$type}{extra}) { + return "extraneous component at end of $name"; + } + if (!defined($extra) && $FILE_TYPES{$type}{need_extra}) { + return "missing component in $name"; + } + return; + } else { + # Legacy naming scheme. + my %types = map { $_ => 1 } @FILE_TYPES_LEGACY; + if ($name !~ m,^[a-zA-Z0-9_.-]+$,) { + return "invalid file object $name"; + } + my $group_regex = '(?:' . join ('|', sort keys %groups) . ')'; + my $type_regex = '(?:' . join ('|', sort keys %types) . ')'; + if ($name !~ /^$group_regex-/) { + return "no recognized owning group in $name"; + } elsif ($name !~ /^$group_regex-.*-$type_regex(-.*)?$/) { + return "invalid file object name $name"; + } } } diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t index ec3760a..2ed8014 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 => 57; +use Test::More tests => 91; use lib 't/lib'; use Util; @@ -38,7 +38,28 @@ my @INVALID_KEYTABS = qw(example host/example service/example.stanford.edu thisistoolong/cgi not-valid/cgi unknown/example.stanford.edu); # Various valid file names. -my @VALID_FILES = qw(apps-example-config-file crcsg-example-db-s_example +my @VALID_FILES = qw(htpasswd/example.stanford.edu/web + password-ipmi/example.stanford.edu + password-root/example.stanford.edu + password-tivoli/example.stanford.edu + ssh-dsa/example.stanford.edu + ssh-rsa/example.stanford.edu + ssl-key/example.stanford.edu + ssl-key/example.stanford.edu/mysql + tivoli-key/example.stanford.edu + config/idg/example/foo + db/idg/example/s_foo + gpg-key/idg/debian + password/idg/example/backup + properties/idg/accounts + properties/idg/accounts/sponsorship + ssl-keystore/idg/accounts + ssl-keystore/idg/accounts/sponsorship + ssl-pkcs12/idg/accounts + ssl-pkcs12/idg/accounts/sponsorship); + +# Various valid legacy file names. +my @VALID_LEGACY_FILES = qw(apps-example-config-file crcsg-example-db-s_example idg-debian-gpg-key idg-devnull-password-root sulair-accounts-properties idg-accounts-ssl-keystore idg-accounts-ssl-pkcs12 crcsg-example-htpasswd-web sulair-example-password-ipmi @@ -47,7 +68,12 @@ my @VALID_FILES = qw(apps-example-config-file crcsg-example-db-s_example idg-openafs-tivoli-key); # Various invalid file names. -my @INVALID_FILES = qw(unknown foo-example-ssh-rsa idg-accounts-foo !!bad); +my @INVALID_FILES = qw(unknown foo-example-ssh-rsa idg-accounts-foo !!bad + htpasswd/example.stanford.edu htpasswd/example password-root/example + password-root/example.stanford.edu/foo ssh-foo/example.stanford.edu + tivoli-key/example.stanford.edu/foo tivoli-key config config/idg + config/idg/example db/idg/example password/idg/example + idg/password/example properties//accounts properties/idg/); # Global variables for the wallet server setup. my $ADMIN = 'admin@EXAMPLE.COM'; @@ -64,6 +90,9 @@ for my $name (@INVALID_KEYTABS) { for my $name (@VALID_FILES) { is(verify_name('file', $name), undef, "Valid file $name"); } +for my $name (@VALID_LEGACY_FILES) { + is(verify_name('file', $name), undef, "Valid file $name"); +} for my $name (@INVALID_FILES) { isnt(verify_name('file', $name), undef, "Invalid file $name"); } -- cgit v1.2.3 From 7001e303c51b1b18f07fb764c91b5ff67b2318f8 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 5 Feb 2013 19:01:55 -0800 Subject: 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 Tested-by: Russ Allbery --- perl/Wallet/Policy/Stanford.pm | 18 +++++++++++++++++- perl/t/stanford-naming.t | 26 +++++++++++++++++++++++++- 2 files changed, 42 insertions(+), 2 deletions(-) (limited to 'perl/t/stanford-naming.t') 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"; -- cgit v1.2.3 From 271896c3a9dee9108e021519e340e4547ef5ab93 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 5 Feb 2013 19:51:00 -0800 Subject: Separate legacy groups from new groups in Stanford policy Add all the new group names for the Stanford naming policy and associate them with default ACLs (not yet used). Distinguish them from the legacy group names, and use the appropriate ones for naming policy enforcement. Change-Id: I4b87ff48d34d82195245798f41afefff26efa95d Reviewed-on: https://gerrit.stanford.edu/758 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Policy/Stanford.pm | 20 +++++++++++++++----- perl/t/stanford-naming.t | 31 ++++++++++++++++--------------- 2 files changed, 31 insertions(+), 20 deletions(-) (limited to 'perl/t/stanford-naming.t') diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm index 0183df8..840f5f3 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/Wallet/Policy/Stanford.pm @@ -39,9 +39,19 @@ BEGIN { # The domain to append to hostnames to fully-qualify them. our $DOMAIN = 'stanford.edu'; -# Groups for file object naming. This default is entirely Stanford-specific, -# even more so than the rest of this file. -our @GROUPS = qw(apps crcsg gsb idg sysadmin sulair vast); +# Groups for file object naming, each mapped to the ACL to use for +# non-host-based objects owned by that group. This default is entirely +# Stanford-specific, even more so than the rest of this file. +our %GROUPS = ( + 'its-apps' => 'group/sharedapps', + 'its-crc-sg' => 'group/crcsg', + 'its-idg' => 'group/its-idg', + 'its-rc' => 'group/its-rc', + 'its-sa-core' => 'group/its-sa-core', +); + +# Legacy group names for older file objects. +our @GROUPS_LEGACY = qw(apps crcsg gsb idg sysadmin sulair vast); # File object types. Each type can have one or more parameters: whether it is # host-based (host), whether it takes a qualifier after the host or service @@ -233,7 +243,6 @@ sub verify_name { # Check file object naming conventions. if ($type eq 'file') { - my %groups = map { $_ => 1 } @GROUPS; if ($name =~ m{ / }xms) { my @name = split('/', $name); @@ -274,7 +283,7 @@ sub verify_name { my ($group, $service, $extra) = @name; # Check the group. - if (!$groups{$group}) { + if (!$GROUPS{$group}) { return "unknown group $group"; } @@ -296,6 +305,7 @@ sub verify_name { return; } else { # Legacy naming scheme. + my %groups = map { $_ => 1 } @GROUPS_LEGACY; my %types = map { $_ => 1 } @FILE_TYPES_LEGACY; if ($name !~ m,^[a-zA-Z0-9_.-]+$,) { return "invalid file object $name"; diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t index 909ad1e..00c7121 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 => 94; +use Test::More tests => 95; use lib 't/lib'; use Util; @@ -47,16 +47,16 @@ my @VALID_FILES = qw(htpasswd/example.stanford.edu/web ssl-key/example.stanford.edu ssl-key/example.stanford.edu/mysql tivoli-key/example.stanford.edu - config/idg/example/foo - db/idg/example/s_foo - gpg-key/idg/debian - password/idg/example/backup - properties/idg/accounts - properties/idg/accounts/sponsorship - ssl-keystore/idg/accounts - ssl-keystore/idg/accounts/sponsorship - ssl-pkcs12/idg/accounts - ssl-pkcs12/idg/accounts/sponsorship); + config/its-idg/example/foo + db/its-idg/example/s_foo + gpg-key/its-idg/debian + password/its-idg/example/backup + properties/its-idg/accounts + properties/its-idg/accounts/sponsorship + ssl-keystore/its-idg/accounts + ssl-keystore/its-idg/accounts/sponsorship + ssl-pkcs12/its-idg/accounts + ssl-pkcs12/its-idg/accounts/sponsorship); # Various valid legacy file names. my @VALID_LEGACY_FILES = qw(apps-example-config-file crcsg-example-db-s_example @@ -71,9 +71,10 @@ my @VALID_LEGACY_FILES = qw(apps-example-config-file crcsg-example-db-s_example my @INVALID_FILES = qw(unknown foo-example-ssh-rsa idg-accounts-foo !!bad htpasswd/example.stanford.edu htpasswd/example password-root/example password-root/example.stanford.edu/foo ssh-foo/example.stanford.edu - tivoli-key/example.stanford.edu/foo tivoli-key config config/idg - config/idg/example db/idg/example password/idg/example - idg/password/example properties//accounts properties/idg/); + tivoli-key/example.stanford.edu/foo tivoli-key config config/its-idg + config/its-idg/example db/its-idg/example password/its-idg/example + its-idg/password/example properties//accounts properties/its-idg/ + ssl-keystore/idg/accounts); # Global variables for the wallet server setup. my $ADMIN = 'admin@EXAMPLE.COM'; @@ -224,7 +225,7 @@ is_deeply( ); # Check for a file object that isn't host-based. -is(default_owner('file', 'config/idg/example/foo'), undef, +is(default_owner('file', 'config/its-idg/example/foo'), undef, 'No default owner for non-host-based file type'); # Check for legacy autocreation mappings for file objects. -- cgit v1.2.3 From 4948053f7fd8a19f5c645d535ea3fa96f9539f4e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 5 Feb 2013 20:18:35 -0800 Subject: Add default owner for group-based files in Stanford policy In Wallet::Policy::Stanford, add support for setting a default owner of file objects whose names are based on a group that has an ACL mapping. Change-Id: I4f63815621d81e26ba4779d10f249cb31eef2b5e Reviewed-on: https://gerrit.stanford.edu/759 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Policy/Stanford.pm | 94 +++++++++++++++++++++++++++++------------- perl/t/stanford-naming.t | 14 +++++-- 2 files changed, 77 insertions(+), 31 deletions(-) (limited to 'perl/t/stanford-naming.t') diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm index 840f5f3..39bea33 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/Wallet/Policy/Stanford.pm @@ -42,7 +42,7 @@ our $DOMAIN = 'stanford.edu'; # Groups for file object naming, each mapped to the ACL to use for # non-host-based objects owned by that group. This default is entirely # Stanford-specific, even more so than the rest of this file. -our %GROUPS = ( +our %ACL_FOR_GROUP = ( 'its-apps' => 'group/sharedapps', 'its-crc-sg' => 'group/crcsg', 'its-idg' => 'group/its-idg', @@ -56,7 +56,7 @@ our @GROUPS_LEGACY = qw(apps crcsg gsb idg sysadmin sulair vast); # File object types. Each type can have one or more parameters: whether it is # host-based (host), whether it takes a qualifier after the host or service # (extra), and whether that qualifier is mandatory (need_extra). -our %FILE_TYPES = ( +our %FILE_TYPE = ( config => { extra => 1, need_extra => 1 }, db => { extra => 1, need_extra => 1 }, 'gpg-key' => { }, @@ -96,6 +96,21 @@ our $ROOT_REQUIRED = '/etc/remctl/acl/its-idg'; # Implementation ############################################################################## +# Retrieve an existing ACL and return its members as a list. +# +# $name - Name of the ACL to retrieve +# +# Returns: Members of the ACL as a list of pairs +# The empty list on any failure to retrieve the ACL +sub _acl_members { + my ($name) = @_; + my $schema = eval { Wallet::Schema->connect }; + return if (!$schema || $@); + my $acl = eval { Wallet::ACL->new ($name, $schema) }; + return if (!$acl || $@); + return $acl->list; +} + # Retrieve an existing ACL and check whether it contains a netdb-root member. # This is used to check if a default ACL is already present with a netdb-root # member so that we can return a default owner that matches. We only ever @@ -105,11 +120,7 @@ our $ROOT_REQUIRED = '/etc/remctl/acl/its-idg'; # On any failure, just return an empty ACL to use the default. sub _acl_has_netdb_root { my ($name) = @_; - my $schema = eval { Wallet::Schema->connect }; - return unless ($schema and not $@); - my $acl = eval { Wallet::ACL->new ($name, $schema) }; - return unless ($acl and not $@); - for my $line ($acl->list) { + for my $line (_acl_members($name)) { return 1 if $line->[0] eq 'netdb-root'; } return; @@ -144,7 +155,7 @@ sub _host_for_file { # Parse the name and check whether this is a host-based object. my ($type, $host) = split('/', $name); - return if !$FILE_TYPES{$type}{host}; + return if !$FILE_TYPE{$type}{host}; return $host; } @@ -168,23 +179,50 @@ sub _host_for_keytab { # using root instances by default. sub default_owner { my ($type, $name) = @_; + + # How to determine the host for host-based objects. my %host_for = ( keytab => \&_host_for_keytab, file => \&_host_for_file, ); - return unless defined $host_for{$type}; - my $host = $host_for{$type}->($name); - return unless $host; - my $acl_name = "host/$host"; - my @acl; - if ($ENV{REMOTE_USER} =~ m,/root, or _acl_has_netdb_root ($acl_name)) { - @acl = ([ 'netdb-root', $host ], - [ 'krb5', "host/$host\@$REALM" ]); - } else { - @acl = ([ 'netdb', $host ], - [ 'krb5', "host/$host\@$REALM" ]); + + # If we have a possible host mapping, see if we can use that. + if (defined($host_for{$type})) { + my $host = $host_for{$type}->($name); + if ($host) { + my $acl_name = "host/$host"; + my @acl; + if ($ENV{REMOTE_USER} =~ m,/root, + || _acl_has_netdb_root ($acl_name)) { + @acl = ([ 'netdb-root', $host ], + [ 'krb5', "host/$host\@$REALM" ]); + } else { + @acl = ([ 'netdb', $host ], + [ 'krb5', "host/$host\@$REALM" ]); + } + return ($acl_name, @acl); + } } - return ($acl_name, @acl); + + # We have no open if this is not a file object. + return if $type ne 'file'; + + # Parse the name of the file object only far enough to get type and group + # (if there is a group). + my ($file_type, $group) = split('/', $name); + + # Host-based file objects should be caught by the above. We certainly + # can't do anything about them here. + return if $FILE_TYPE{$file_type}{host}; + + # If we have a mapping for this group, retrieve the ACL contents. We + # would like to just return the ACL name, but wallet currently requires we + # return the whole ACL. + my $acl = $ACL_FOR_GROUP{$group}; + return if !defined($acl); + my @members = _acl_members($acl); + return if @members == 0; + return ($acl, @members); } # Enforce a naming policy. Host-based keytabs must have fully-qualified @@ -261,15 +299,15 @@ sub verify_name { # All objects start with the type. First check if this is a # host-based type. my $type = shift @name; - if ($FILE_TYPES{$type} && $FILE_TYPES{$type}{host}) { + if ($FILE_TYPE{$type} && $FILE_TYPE{$type}{host}) { my ($host, $extra) = @name; if ($host !~ m{ [.] }xms) { return "host name $host is not fully qualified"; } - if (defined($extra) && !$FILE_TYPES{$type}{extra}) { + if (defined($extra) && !$FILE_TYPE{$type}{extra}) { return "extraneous component at end of $name"; } - if (!defined($extra) && $FILE_TYPES{$type}{need_extra}) { + if (!defined($extra) && $FILE_TYPE{$type}{need_extra}) { return "missing component in $name"; } return; @@ -283,23 +321,23 @@ sub verify_name { my ($group, $service, $extra) = @name; # Check the group. - if (!$GROUPS{$group}) { + if (!$ACL_FOR_GROUP{$group}) { return "unknown group $group"; } # Check the type. Be sure it's not host-based. - if (!$FILE_TYPES{$type}) { + if (!$FILE_TYPE{$type}) { return "unknown type $type"; } - if ($FILE_TYPES{$type}{host}) { + if ($FILE_TYPE{$type}{host}) { return "bad name for host-based file type $type"; } # Check the extra data. - if (defined($extra) && !$FILE_TYPES{$type}{extra}) { + if (defined($extra) && !$FILE_TYPE{$type}{extra}) { return "extraneous component at end of $name"; } - if (!defined($extra) && $FILE_TYPES{$type}{need_extra}) { + if (!defined($extra) && $FILE_TYPE{$type}{need_extra}) { return "missing component in $name"; } return; diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t index 00c7121..9473ed5 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 => 95; +use Test::More tests => 97; use lib 't/lib'; use Util; @@ -136,6 +136,11 @@ is( '...and krb5 ACL line' ); +# Create a group/its-idg ACL, which will be used for autocreation of file +# objects. +is($server->acl_create('group/its-idg'), 1, 'Created group/its-idg ACL'); +is($server->acl_add('group/its-idg', 'krb5', $ADMIN), 1, '...with member'); + # Now we can test default ACLs. First, without a root instance. local $ENV{REMOTE_USER} = $ADMIN; is_deeply( @@ -225,8 +230,11 @@ is_deeply( ); # Check for a file object that isn't host-based. -is(default_owner('file', 'config/its-idg/example/foo'), undef, - 'No default owner for non-host-based file type'); +is_deeply( + [default_owner('file', 'config/its-idg/example/foo')], + ['group/its-idg', ['krb5', $ADMIN]], + 'Default owner for file config/its-idg/example/foo', +); # Check for legacy autocreation mappings for file objects. for my $type (qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key)) { -- cgit v1.2.3 From 3733b1537c987a42e4c3f6b30f4ccfef378e7cfc Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 13 Feb 2013 12:13:41 -0800 Subject: Add ssl-keypair to Stanford naming policy Used currently by MDM to store both the certificate and the key in the same file for convenience. Change-Id: I38901ac93fe3022c2e00f735a0f995500841d709 Reviewed-on: https://gerrit.stanford.edu/784 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- docs/stanford-naming | 10 ++++++++++ perl/Wallet/Policy/Stanford.pm | 1 + perl/t/stanford-naming.t | 4 +++- 3 files changed, 14 insertions(+), 1 deletion(-) (limited to 'perl/t/stanford-naming.t') diff --git a/docs/stanford-naming b/docs/stanford-naming index aa59f68..5207c40 100644 --- a/docs/stanford-naming +++ b/docs/stanford-naming @@ -141,6 +141,16 @@ Object Naming (OLD: --ssl-key) + ssl-keypair/[/] + + Same as ssl-key except that the signed certificate is included in + the same file as the private key. This is used for convenience + with some applications that want to have both the signed + certificate and private key in the same file. + + The meaning of and are the same as for + ssl-key. + tivoli-key/ The Tivoli password or backup encryption key for this server. diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm index 39bea33..1444d51 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/Wallet/Policy/Stanford.pm @@ -69,6 +69,7 @@ our %FILE_TYPE = ( 'ssh-dsa' => { host => 1 }, 'ssh-rsa' => { host => 1 }, 'ssl-key' => { host => 1, extra => 1 }, + 'ssl-keypair' => { host => 1, extra => 1 }, 'ssl-keystore' => { extra => 1 }, 'ssl-pkcs12' => { extra => 1 }, 'tivoli-key' => { host => 1 }, diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t index 9473ed5..3b9ea60 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 => 97; +use Test::More tests => 99; use lib 't/lib'; use Util; @@ -46,6 +46,8 @@ my @VALID_FILES = qw(htpasswd/example.stanford.edu/web ssh-rsa/example.stanford.edu ssl-key/example.stanford.edu ssl-key/example.stanford.edu/mysql + ssl-keypair/example.stanford.edu + ssl-keypair/example.stanford.edu/mysql tivoli-key/example.stanford.edu config/its-idg/example/foo db/its-idg/example/s_foo -- cgit v1.2.3