From aebae838e3aa327e94d796bd99b48c169ffe6683 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Fri, 6 Feb 2015 13:04:35 -0800 Subject: wallet-report: Added a report for unstored objects Report on all file objects that have never had data stored in them. Also clean up the text around the 'objects unused' report which said that it did this plus things that were never gotten, but in reality only reported on the objects that were never gotten. Change-Id: I30c9585ac6f3744fbea2f94b3d6874a64c0109ad --- server/wallet-report | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'server/wallet-report') diff --git a/server/wallet-report b/server/wallet-report index b5a2247..1c8f914 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -25,7 +25,8 @@ Wallet reporting help: objects flag Objects with that flag set objects owner Objects owned by that owner objects type Objects of that type - objects unused Objects that have never been stored/gotten + objects unused Objects that have never been gotten + objects unstored Objects that have never been stored owners All ACL entries owning matching objects EOH @@ -220,6 +221,8 @@ Displays a summary of all available commands. =item objects unused +=item objects unstored + Returns a list of objects in the database. Objects will be listed in the form: -- cgit v1.2.3 From f14bd8343010ad96104965029e36c5a65d231571 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Sat, 7 Feb 2015 16:09:12 -0800 Subject: Added an object history report to wallet-report Took code from Commerzbank AG and refactored to add to wallet-report. This does a complete dump of all object history for searching on. Change-Id: Id22c51d2938ad90e0c6a19aaa016501a1ba333b3 --- perl/lib/Wallet/Report.pm | 42 ++++++++++++++++++++++++++++++++++++++++++ server/wallet-report | 8 +++++++- 2 files changed, 49 insertions(+), 1 deletion(-) (limited to 'server/wallet-report') diff --git a/perl/lib/Wallet/Report.pm b/perl/lib/Wallet/Report.pm index 2382d87..912bc17 100644 --- a/perl/lib/Wallet/Report.pm +++ b/perl/lib/Wallet/Report.pm @@ -242,6 +242,48 @@ sub objects { return @objects; } +# Returns a list of all object_history records stored in the wallet database +# including all of their fields. On error and for an empty database, the +# empty list will be returned. To distinguish between an empty list and an +# error, call error(), which will return undef if there was no error. +# Farms out specific statement to another subroutine for specific search +# types, but each case should return ob_type and ob_name in that order. +sub objects_history { + my ($self, $type, @args) = @_; + undef $self->{error}; + + # All fields in the order we want to see them. + my @fields = ('oh_on', 'oh_by', 'oh_type', 'oh_name', 'oh_action', + 'oh_from'); + + # Get the search and options array refs from specific functions. + my %search = (); + my %options = (order_by => \@fields, + select => \@fields); + + # Perform the search and return on any errors. + my @objects; + my $schema = $self->{schema}; + eval { + my @objects_rs + = $schema->resultset('ObjectHistory')->search (\%search, + \%options); + for my $object_rs (@objects_rs) { + my @rec; + for my $field (@fields) { + push (@rec, $object_rs->get_column($field)); + } + push (@objects, \@rec); + } + }; + if ($@) { + $self->error ("cannot list objects: $@"); + return; + } + + return @objects; +} + ############################################################################## # ACL reports ############################################################################## diff --git a/server/wallet-report b/server/wallet-report index 1c8f914..bc499d4 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -23,6 +23,7 @@ Wallet reporting help: objects All objects objects acl Objects granting permissions to that ACL objects flag Objects with that flag set + objects history History of all objects objects owner Objects owned by that owner objects type Objects of that type objects unused Objects that have never been gotten @@ -75,7 +76,12 @@ sub command { print $HELP; } elsif ($command eq 'objects') { die "too many arguments to objects\n" if @args > 2; - my @objects = $report->objects (@args); + my @objects; + if (@args && $args[0] eq 'history') { + @objects = $report->objects_history (@args); + } else { + @objects = $report->objects (@args); + } if (!@objects and $report->error) { die $report->error, "\n"; } -- cgit v1.2.3 From 1575e25c9e9edc8d577a0f1118732c98871984e0 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Tue, 17 Feb 2015 14:32:59 -0800 Subject: Added reports to list all types and acl schemes Two new reports, 'types' and 'schemes'. These will print out all configured types and acl schemes. Change-Id: Ib06d37755fe80c168a6f723c9a1e683fdf5dfcde --- perl/lib/Wallet/Report.pm | 38 ++++++++++++++++++++++++++++++++++++++ perl/t/general/report.t | 26 +++++++++++++++++++++++++- server/wallet-report | 16 ++++++++++++++++ 3 files changed, 79 insertions(+), 1 deletion(-) (limited to 'server/wallet-report') diff --git a/perl/lib/Wallet/Report.pm b/perl/lib/Wallet/Report.pm index 912bc17..4d92d64 100644 --- a/perl/lib/Wallet/Report.pm +++ b/perl/lib/Wallet/Report.pm @@ -284,6 +284,27 @@ sub objects_history { return @objects; } +############################################################################## +# Type reports +############################################################################## + +# Return an alphabetical list of all valid types set up, along with the class +# that they belong to. +sub types { + my ($self) = @_; + + my (@types); + my @types_rs = $self->{schema}->resultset('Type')->all; + for my $type_rs (@types_rs) { + my $name = $type_rs->ty_name; + my $class = $type_rs->ty_class; + push(@types, [ $name, $class ]); + } + + @types = sort { $a->[0] cmp $b->[0] } @types; + return @types; +} + ############################################################################## # ACL reports ############################################################################## @@ -527,6 +548,23 @@ sub owners { return @owners; } +# Return an alphabetical list of all valid types set up, along with the class +# that they belong to. +sub acl_schemes { + my ($self) = @_; + + my (@schemes); + my @acls_rs = $self->{schema}->resultset('AclScheme')->all; + for my $acl_rs (@acls_rs) { + my $name = $acl_rs->as_name; + my $class = $acl_rs->as_class; + push(@schemes, [ $name, $class ]); + } + + @schemes = sort { $a->[0] cmp $b->[0] } @schemes; + return @schemes; +} + ############################################################################## # Auditing ############################################################################## diff --git a/perl/t/general/report.t b/perl/t/general/report.t index 8d348ed..a63ab79 100755 --- a/perl/t/general/report.t +++ b/perl/t/general/report.t @@ -11,7 +11,7 @@ use strict; use warnings; -use Test::More tests => 197; +use Test::More tests => 215; use Wallet::Admin; use Wallet::Report; @@ -41,6 +41,30 @@ is (scalar (@acls), 1, 'One ACL in the database'); is ($acls[0][0], 1, ' and that is ACL ID 1'); is ($acls[0][1], 'ADMIN', ' with the right name'); +# Check to see that we have all types that we expect. +my @types = $report->types; +is (scalar (@types), 10, 'There are ten types created'); +is ($types[0][0], 'base', ' and the first member is correct'); +is ($types[1][0], 'duo', ' and the second member is correct'); +is ($types[2][0], 'duo-ldap', ' and the third member is correct'); +is ($types[3][0], 'duo-pam', ' and the fourth member is correct'); +is ($types[4][0], 'duo-radius', ' and the fifth member is correct'); +is ($types[5][0], 'duo-rdp', ' and the sixth member is correct'); +is ($types[6][0], 'file', ' and the seventh member is correct'); +is ($types[7][0], 'keytab', ' and the eighth member is correct'); +is ($types[8][0], 'password', ' and the nineth member is correct'); +is ($types[9][0], 'wa-keyring', ' and the tenth member is correct'); + +# And that we have all schemes that we expect. +my @schemes = $report->acl_schemes; +is (scalar (@schemes), 6, 'There are six acl schemes created'); +is ($schemes[0][0], 'base', ' and the first member is correct'); +is ($schemes[1][0], 'krb5', ' and the second member is correct'); +is ($schemes[2][0], 'krb5-regex', ' and the third member is correct'); +is ($schemes[3][0], 'ldap-attr', ' and the fourth member is correct'); +is ($schemes[4][0], 'netdb', ' and the fifth member is correct'); +is ($schemes[5][0], 'netdb-root', ' and the sixth member is correct'); + # Create an object. my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); diff --git a/server/wallet-report b/server/wallet-report index bc499d4..6d1436c 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -29,6 +29,8 @@ Wallet reporting help: objects unused Objects that have never been gotten objects unstored Objects that have never been stored owners All ACL entries owning matching objects + schemes All configured ACL schemes + types All configured wallet types EOH ############################################################################## @@ -98,6 +100,20 @@ sub command { for my $entry (@entries) { print join (' ', @$entry), "\n"; } + } elsif ($command eq 'schemes') { + die "too many arguments to schemes\n" if @args > 0; + my @schemes = $report->acl_schemes; + for my $entry (@schemes) { + print join (' ', @$entry), "\n"; + } + + } elsif ($command eq 'types') { + die "too many arguments to types\n" if @args > 0; + my @types = $report->types; + for my $entry (@types) { + print join (' ', @$entry), "\n"; + } + } else { die "unknown command $command\n"; } -- cgit v1.2.3 From 45a7c9d2896cf2e0d1548fd98b3b78f9f812744f Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 16 Apr 2015 14:58:58 -0700 Subject: wallet-report: Added report of all host-based objects for host "wallet-report objects host " reports on all objects that belong to the given host. This can be used to query things for retiring systems. Change-Id: Ib1c8e5978fed141d54ecc8504b56b43c037f9b17 --- perl/lib/Wallet/Config.pm | 28 +++++++++++++++ perl/lib/Wallet/Policy/Stanford.pm | 49 +++++++++++++++++--------- perl/lib/Wallet/Report.pm | 70 +++++++++++++++++++++++++++++++++++++- perl/t/general/report.t | 18 +++++++++- perl/t/policy/stanford.t | 28 +++++++++++++-- server/wallet-report | 3 ++ 6 files changed, 176 insertions(+), 20 deletions(-) (limited to 'server/wallet-report') diff --git a/perl/lib/Wallet/Config.pm b/perl/lib/Wallet/Config.pm index 76c7ecd..b3e1931 100644 --- a/perl/lib/Wallet/Config.pm +++ b/perl/lib/Wallet/Config.pm @@ -792,6 +792,34 @@ keytab objects for particular principals have fully-qualified hostnames: Objects that aren't of type C or which aren't for a host-based key have no naming requirements enforced by this example. +=head1 OBJECT HOST-BASED NAMES + +The above demonstrates having a host-based naming convention, where we +expect one part of an object name to be the name of the host that this +object is for. The most obvious examples are those keytab objects +above, where we want certain keytab names to be in the form of +/. It's then also useful to provide a Perl function +named is_for_host which then can be used to tell if a given object is a +host-based keytab for a specific host. This function is then called by +the objects_hostname in Wallet::Report to give a list of all host-based +objects for a given hostname. It should return true if the given object +is a host-based object for the hostname, otherwise false. + +An example that matches the same policy as the last verify_name example +would be: + + sub is_for_host { + my ($type, $name, $hostname) = @_; + my %host_based = map { $_ => 1 } + qw(HTTP cifs host imap ldap nfs pop sieve smtp webauth); + return 0 unless $type eq 'keytab'; + return 0 unless $name =~ m%/%; + my ($service, $instance) = split ('/', $name, 2); + return 0 unless $host_based{$service}; + return 1 if $hostname eq $instance; + return 0; + } + =head1 ACL NAMING ENFORCEMENT Similar to object names, by default wallet permits administrators to diff --git a/perl/lib/Wallet/Policy/Stanford.pm b/perl/lib/Wallet/Policy/Stanford.pm index 362f098..86e204e 100644 --- a/perl/lib/Wallet/Policy/Stanford.pm +++ b/perl/lib/Wallet/Policy/Stanford.pm @@ -25,8 +25,8 @@ our (@EXPORT_OK, $VERSION); # against circular module loading (not that we load any modules, but # consistency is good). BEGIN { - $VERSION = '1.00'; - @EXPORT_OK = qw(default_owner verify_name); + $VERSION = '1.01'; + @EXPORT_OK = qw(default_owner verify_name is_for_host); } ############################################################################## @@ -87,6 +87,18 @@ our %PASSWORD_TYPE = ( 'service' => { extra => 1, need_extra => 1 }, ); +# Mappings that let us determine the host for a host-based object, if any. +our %HOST_FOR = ( + 'keytab' => \&_host_for_keytab, + 'file' => \&_host_for_file, + 'password' => \&_host_for_password, + 'duo' => \&_host_for_duo, + 'duo-pam' => \&_host_for_duo, + 'duo-radius' => \&_host_for_duo, + 'duo-ldap' => \&_host_for_duo, + 'duo-rdp' => \&_host_for_duo, +); + # 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); @@ -204,6 +216,23 @@ sub _host_for_duo { return $name; } +# Take a object type and name, along with a host name, and use these to +# decide if the given object is host-based and matches the given host. +sub is_for_host { + my ($type, $name, $host) = @_; + + # If we have a possible host mapping, get the host and see if it matches. + if (defined($HOST_FOR{$type})) { + my $object_host = $HOST_FOR{$type}->($name); + return 0 unless $object_host; + if ($host eq $object_host) { + return 1; + } + } + + return 0; +} + # The default owner of host-based objects should be the host keytab and the # NetDB ACL for that host, with one twist. If the creator of a new node is # using a root instance, we want to require everyone managing that node be @@ -211,21 +240,9 @@ sub _host_for_duo { 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, - 'password' => \&_host_for_password, - 'duo' => \&_host_for_duo, - 'duo-pam' => \&_host_for_duo, - 'duo-radius' => \&_host_for_duo, - 'duo-ldap' => \&_host_for_duo, - 'duo-rdp' => \&_host_for_duo, - ); - # 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 (defined($HOST_FOR{$type})) { + my $host = $HOST_FOR{$type}->($name); if ($host) { my $acl_name = "host/$host"; my @acl; diff --git a/perl/lib/Wallet/Report.pm b/perl/lib/Wallet/Report.pm index 4d92d64..fc7bb4d 100644 --- a/perl/lib/Wallet/Report.pm +++ b/perl/lib/Wallet/Report.pm @@ -249,7 +249,7 @@ sub objects { # Farms out specific statement to another subroutine for specific search # types, but each case should return ob_type and ob_name in that order. sub objects_history { - my ($self, $type, @args) = @_; + my ($self, $search_type, @args) = @_; undef $self->{error}; # All fields in the order we want to see them. @@ -284,6 +284,56 @@ sub objects_history { return @objects; } +# Returns a list of all objects stored in the wallet database in the form of +# type and name pairs. On error and for an empty database, the empty list +# will be returned. To distinguish between an empty list and an error, call +# error(), which will return undef if there was no error. Farms out specific +# statement to another subroutine for specific search types, but each case +# should return ob_type and ob_name in that order. +sub objects_hostname { + my ($self, $type, $hostname) = @_; + undef $self->{error}; + + # Make sure we have a given hostname. + if (!$hostname) { + $self->error ("object hosts requires one argument to search"); + return; + } + + # If we don't have a way to get host-based object lists, quit. + unless (defined &Wallet::Config::is_for_host) { + $self->error ('no host-based policy defined'); + return; + } + + # Search on all objects. + my %search = (); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + my @objects; + my $schema = $self->{schema}; + eval { + my @objects_rs = $schema->resultset('Object')->search (\%search, + \%options); + + # Check to see if an object is for the given host and add to list if + # so. + for my $object_rs (@objects_rs) { + my $type = $object_rs->ob_type; + my $name = $object_rs->ob_name; + next unless &Wallet::Config::is_for_host($type, $name, $hostname); + push (@objects, [ $type, $name ]); + } + }; + if ($@) { + $self->error ("cannot list objects: $@"); + return; + } + + return @objects; +} + ############################################################################## # Type reports ############################################################################## @@ -753,6 +803,24 @@ empty search result, the caller should call error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. +=item objects_history(TYPE) + +Returns a dump of the entire object history table. The return value is +a list of references to each field in that table, in the following order: + + oh_on, oh_by, oh_type, oh_name, oh_action, oh_from + +=item objects_hostname(TYPE, HOSTNAME) + +Returns a list of all host-based objects for a given hostname. The +output is identical to the general objects command, but we need to +separate this out because the way it searches is very different. + +Returns the empty list on failure. To distinguish between this and an +empty search result, the caller should call error(). error() is +guaranteed to return the error message if there was an error and undef if +there was no error. + =item owners(TYPE, NAME) Returns a list of all ACL lines contained in owner ACLs for objects diff --git a/perl/t/general/report.t b/perl/t/general/report.t index a63ab79..170fe29 100755 --- a/perl/t/general/report.t +++ b/perl/t/general/report.t @@ -11,7 +11,7 @@ use strict; use warnings; -use Test::More tests => 215; +use Test::More tests => 218; use Wallet::Admin; use Wallet::Report; @@ -281,6 +281,22 @@ is (scalar (@lines), 1, 'Searching for ACL naming violations finds one'); is ($lines[0][0], 3, ' and the first has the right ID'); is ($lines[0][1], 'second', ' and the right name'); +# Set a host-based object matching script so that we can test the host report. +# The deactivation trick isn't needed here. +package Wallet::Config; +sub is_for_host { + my ($type, $name, $host) = @_; + my ($service, $principal) = split ('/', $name, 2); + return 0 unless $service && $principal; + return 1 if $host eq $principal; + return 0; +} +package main; +@lines = $report->objects_hostname ('host', 'admin'); +is (scalar (@lines), 1, 'Searching for host-based objects finds one'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); + # Set up a file bucket so that we can create an object we can retrieve. system ('rm -rf test-files') == 0 or die "cannot remove test-files\n"; mkdir 'test-files' or die "cannot create test-files: $!\n"; diff --git a/perl/t/policy/stanford.t b/perl/t/policy/stanford.t index 555086c..9ed0fa6 100755 --- a/perl/t/policy/stanford.t +++ b/perl/t/policy/stanford.t @@ -16,7 +16,7 @@ use 5.008; use strict; use warnings; -use Test::More tests => 101; +use Test::More tests => 130; use lib 't/lib'; use Util; @@ -24,7 +24,8 @@ 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::Policy::Stanford', + qw(default_owner verify_name is_for_host)); use_ok('Wallet::Server'); } @@ -101,6 +102,29 @@ for my $name (@INVALID_FILES) { isnt(verify_name('file', $name), undef, "Invalid file $name"); } +# Now test a few cases for checking to see if a file is host-based. We don't +# test the legacy examples because they're more complicated and less obvious. +for my $name (@VALID_KEYTABS) { + my $hostname = 'example.stanford.edu'; + if ($name =~ m{\b$hostname\b}) { + is(is_for_host('keytab', $name, $hostname), 1, + "Keytab $name belongs to $hostname"); + } else { + is(is_for_host('keytab', $name, $hostname), 0, + "Keytab $name doesn't belong to $hostname"); + } +} +for my $name (@VALID_FILES) { + my $hostname = 'example.stanford.edu'; + if ($name =~ m{\b$hostname\b}) { + is(is_for_host('file', $name, $hostname), 1, + "File $name belongs to $hostname"); + } else { + is(is_for_host('file', $name, $hostname), 0, + "File $name doesn't belong to $hostname"); + } +} + # Now we need an actual database. Use Wallet::Admin to set it up. db_setup; my $setup = eval { Wallet::Admin->new }; diff --git a/server/wallet-report b/server/wallet-report index 6d1436c..77a2f8a 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -24,6 +24,7 @@ Wallet reporting help: objects acl Objects granting permissions to that ACL objects flag Objects with that flag set objects history History of all objects + objects host All host-based objects for a specific host objects owner Objects owned by that owner objects type Objects of that type objects unused Objects that have never been gotten @@ -81,6 +82,8 @@ sub command { my @objects; if (@args && $args[0] eq 'history') { @objects = $report->objects_history (@args); + } elsif (@args && $args[0] eq 'host') { + @objects = $report->objects_hostname (@args); } else { @objects = $report->objects (@args); } -- cgit v1.2.3 From 5d668b86ced32e84fd0f49046326a0a5e20dc8eb Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Tue, 9 Jun 2015 15:04:14 -0700 Subject: Added wallet report for nested ACL We needed a way to report on where all a specific ACL might be nested, since we can't destroy an ACL until it's no longer being nested. For the immediate this is part of wallet-report. Change-Id: I41c11b73325d1eb3a28289eac3505bf965877be1 --- perl/lib/Wallet/Report.pm | 47 ++++++++++++++++++++++++++++++++++++++++------- perl/t/general/report.t | 9 ++++++++- server/wallet-report | 1 + 3 files changed, 49 insertions(+), 8 deletions(-) (limited to 'server/wallet-report') diff --git a/perl/lib/Wallet/Report.pm b/perl/lib/Wallet/Report.pm index fc7bb4d..353cd97 100644 --- a/perl/lib/Wallet/Report.pm +++ b/perl/lib/Wallet/Report.pm @@ -359,8 +359,7 @@ sub types { # ACL reports ############################################################################## -# Returns the SQL statement required to find and return all ACLs in the -# database. +# Returns the array of all ACLs in the database. sub acls_all { my ($self) = @_; my @acls; @@ -384,7 +383,7 @@ sub acls_all { return (@acls); } -# Returns the SQL statement required to find all empty ACLs in the database. +# Returns the array of all empty ACLs in the database. sub acls_empty { my ($self) = @_; my @acls; @@ -410,9 +409,36 @@ sub acls_empty { return (@acls); } -# Returns the SQL statement and the field required to find ACLs containing the -# specified entry. The identifier is automatically surrounded by wildcards to -# do a substring search. +# Returns the array of ACLs that nest a given ACL. +sub acls_nesting { + my ($self, $name) = @_; + my @acls; + + my $schema = $self->{schema}; + my %search = (ae_scheme => 'nested', + ae_identifier => $name); + my %options = (join => 'acl_entries', + prefetch => 'acl_entries', + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); +} + +# Returns the array of all ACLs containing the specified entry. The given +# identifier is automatically surrounded by wildcards to do a substring +# search. sub acls_entry { my ($self, $type, $identifier) = @_; my @acls; @@ -440,7 +466,7 @@ sub acls_entry { return (@acls); } -# Returns the SQL statement required to find unused ACLs. +# Returns the array of all unused ACLs. sub acls_unused { my ($self) = @_; my @acls; @@ -553,6 +579,13 @@ sub acls { @acls = $self->acls_empty; } elsif ($type eq 'unused') { @acls = $self->acls_unused; + } elsif ($type eq 'nesting') { + if (@args == 0) { + $self->error ('ACL nesting search requires an ACL to search'); + return; + } else { + @acls = $self->acls_nesting (@args); + } } else { $self->error ("unknown search type: $type"); return; diff --git a/perl/t/general/report.t b/perl/t/general/report.t index 6f6b750..a841acd 100755 --- a/perl/t/general/report.t +++ b/perl/t/general/report.t @@ -11,7 +11,7 @@ use strict; use warnings; -use Test::More tests => 219; +use Test::More tests => 222; use Wallet::Admin; use Wallet::Report; @@ -366,6 +366,13 @@ is ($server->acl_add ('third', 'base', 'baz'), 1, is (scalar (@acls), 0, 'There are no duplicate ACLs'); is ($report->error, undef, ' and no error'); +# See if the acl nesting report works correctly. +is ($server->acl_add ('fourth', 'nested', 'second'), 1, + 'Adding an ACL as a nested entry for another works'); +@acls = $report->acls ('nesting', 'second'); +is (scalar (@acls), 1, ' and the nested report shows one nesting'); +is ($acls[0][1], 'fourth', ' with the correct ACL nesting it'); + # Clean up. $admin->destroy; system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; diff --git a/server/wallet-report b/server/wallet-report index 77a2f8a..4719a8a 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -17,6 +17,7 @@ Wallet reporting help: acls duplicate ACLs that duplicate another acls empty All empty ACLs acls entry ACLs containing this entry (wildcarded) + acls nesting ACLs containing this ACL as a nested entry acls unused ACLs that are not referenced by any object audit acls name ACLs failing the naming policy audit objects name Objects failing the naming policy -- cgit v1.2.3 From d223a3eafc5eb8fe58d664994669c908b6c01346 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 3 Jan 2016 15:05:26 -0800 Subject: Document the acls nested report in the man page Change-Id: Ib077a196ee5389d7ec6d90fcf411cae0a81e071d --- server/wallet-report | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'server/wallet-report') diff --git a/server/wallet-report b/server/wallet-report index 4719a8a..e38ef74 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -207,6 +207,10 @@ Returns all ACLs containing an entry with given scheme and identifier. The scheme must be an exact match, but the string will match any identifier containing that string. +=item acls nested + +Returns all ACLs that contain this ACL as a nested entry. + =item acls unused Returns all ACLs that are not referenced by any of the objects in the @@ -310,7 +314,9 @@ Russ Allbery =head1 COPYRIGHT AND LICENSE -Copyright 2008, 2009, 2010, 2013 The Board of Trustees of the Leland +Copyright 2016 Russ Allbery + +Copyright 2008, 2009, 2010, 2013, 2015 The Board of Trustees of the Leland Stanford Junior University Permission is hereby granted, free of charge, to any person obtaining a -- cgit v1.2.3 From f20e65a6f0efdcc10a663ecac3833645c94484ef Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 3 Jan 2016 15:09:42 -0800 Subject: Add POD documentation for objects host report Change-Id: I710de6a1df01ecd9aebd202288a9efb434c09054 --- server/wallet-report | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'server/wallet-report') diff --git a/server/wallet-report b/server/wallet-report index e38ef74..3284ba3 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -278,6 +278,12 @@ those where that ACL has any other, more limited permissions. Returns all objects which have the given flag set. +=item objects host + +Returns all objects that belong to the given host. This requires adding +local configuration to identify objects that belong to a given host. See +L for more information. + =item objects owner Returns all objects owned by the given ACL name or ID. -- cgit v1.2.3 From 7187257790441c29617406217446fc358b1c336c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 3 Jan 2016 15:11:59 -0800 Subject: Add POD documentation of schemes and types reports Change-Id: I9f8f986952510f6b2d326ccaab4bb7006a033b9d --- server/wallet-report | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'server/wallet-report') diff --git a/server/wallet-report b/server/wallet-report index 3284ba3..d598aeb 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -312,6 +312,14 @@ The output will be one line per ACL line in the form: with duplicates suppressed. +=item schemes + +Returns a list of all registered ACL schemes. + +=item types + +Returns a list of all registered object types. + =back =head1 AUTHOR -- cgit v1.2.3 From 6d6718c3c19180adbb5b17985c539d2a4a693f8a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 3 Jan 2016 16:54:54 -0800 Subject: Add stopwords for some additional spelling issues Change-Id: If63ea5829252fda13b68d031fb9f48c93b71697a --- contrib/wallet-contacts | 2 +- server/wallet-report | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'server/wallet-report') diff --git a/contrib/wallet-contacts b/contrib/wallet-contacts index ce16ab1..c2f3bf1 100755 --- a/contrib/wallet-contacts +++ b/contrib/wallet-contacts @@ -174,7 +174,7 @@ if ($mail) { ############################################################################## =for stopwords -ACL NetDB SQL hostname lookup swhois whois Allbery +ACL NetDB SQL hostname lookup swhois whois Allbery -dryrun =head1 NAME diff --git a/server/wallet-report b/server/wallet-report index d598aeb..22637ca 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -135,7 +135,7 @@ wallet-report - Wallet server reporting interface =for stopwords metadata ACL hostname backend acl acls wildcard SQL Allbery remctl -MERCHANTABILITY NONINFRINGEMENT sublicense +MERCHANTABILITY NONINFRINGEMENT sublicense unstored =head1 SYNOPSIS -- cgit v1.2.3 From 884297fc439a4c3eba2365cdb810214dfc4f5799 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 17 Jan 2016 12:39:57 -0800 Subject: Update Perl version declaration and warnings for server scripts Add use 5.008 and use warnings uniformly to all of the server backend scripts. --- server/keytab-backend | 5 +---- server/wallet-admin | 9 ++++----- server/wallet-backend | 5 +---- server/wallet-report | 9 ++++----- 4 files changed, 10 insertions(+), 18 deletions(-) (limited to 'server/wallet-report') diff --git a/server/keytab-backend b/server/keytab-backend index bd5a3f9..6e47331 100755 --- a/server/keytab-backend +++ b/server/keytab-backend @@ -16,10 +16,7 @@ # # The keytab for the extracted principal will be printed to standard output. -############################################################################## -# Declarations and site configuration -############################################################################## - +use 5.008; use strict; use warnings; diff --git a/server/wallet-admin b/server/wallet-admin index 7ba1021..e74b2f1 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -1,12 +1,11 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Wallet server administrative commands. -############################################################################## -# Declarations and site configuration -############################################################################## - +use 5.008; use strict; +use warnings; + use Wallet::Admin; ############################################################################## diff --git a/server/wallet-backend b/server/wallet-backend index ea3e21e..aa83a96 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -2,10 +2,7 @@ # # Wallet server for storing and retrieving secure data. -############################################################################## -# Declarations and site configuration -############################################################################## - +use 5.008; use strict; use warnings; diff --git a/server/wallet-report b/server/wallet-report index 22637ca..6508227 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -1,12 +1,11 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Wallet server reporting interface. -############################################################################## -# Declarations and globals -############################################################################## - +use 5.008; use strict; +use warnings; + use Wallet::Report; # The help output, sent in reply to the help command. Lists each supported -- cgit v1.2.3