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') 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 0e16def8a9e12f9b2232b29da79cdacb6710b086 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Fri, 6 Feb 2015 23:43:50 -0800 Subject: Added acl replace command to wallet backend New command for replacing the ownership of anything owned by a specific ACL with another ACL. This differs from acl rename in that it's to be used when the destination ACL already exists and potentially already owns some objects. Change-Id: I765bebf499fe0f861abc2ffe1873990590beed36 --- client/wallet.pod | 10 ++++++++ perl/lib/Wallet/ACL.pm | 35 ++++++++++++++++++++++++++ perl/lib/Wallet/Server.pm | 38 ++++++++++++++++++++++++++++ perl/t/general/acl.t | 64 ++++++++++++++++++++++++++++++++++++++++++++--- server/wallet-backend | 22 ++++++++++++++++ 5 files changed, 166 insertions(+), 3 deletions(-) (limited to 'server') diff --git a/client/wallet.pod b/client/wallet.pod index 4b58bbf..20d1874 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -227,6 +227,16 @@ renamed. may be either the current name or the numeric ID. must not be all-numeric. To rename an ACL, the current user must be authorized by the C ACL. +=item acl replace + +Find any objects owned by , and then change their ownership to + instead. should already exist, and may already have +some objects owned by it. is not deleted afterwards, though in +most cases that is probably your next step. The C ACL may not be +replaced from. and may be either the current name or the +numeric ID. To replace an ACL, the current user must be authorized by +the C ACL. + =item acl show Display the name, numeric ID, and entries of the ACL . diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index a3b0146..370df8b 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -17,6 +17,7 @@ use strict; use warnings; use vars qw($VERSION); +use Wallet::Object::Base; use DateTime; use DBI; @@ -207,6 +208,32 @@ sub rename { return 1; } +# Moves everything owned by one ACL to instead be owned by another. You'll +# normally want to use rename, but this exists for cases where the replacing +# ACL already exists and has things assigned to it. Returns true on success, +# false on failure. +sub replace { + my ($self, $replace_id, $user, $host, $time) = @_; + $time ||= time; + + my %search = (ob_owner => $self->{id}); + my @objects = $self->{schema}->resultset('Object')->search (\%search); + if (@objects) { + for my $object (@objects) { + my $type = $object->ob_type; + my $name = $object->ob_name; + my $object = eval { + Wallet::Object::Base->new($type, $name, $self->{schema}); + }; + $object->owner ($replace_id, $user, $host, $time); + } + } else { + $self->error ("no objects found for ACL $self->{id}"); + return; + } + return 1; +} + # Destroy the ACL, deleting it out of the database. Returns true on success, # false on failure. # @@ -643,6 +670,14 @@ On failure, the caller should call error() to get the error message. Note that rename() operations are not logged in the ACL history. +=item replace(ID) + +Replace this ACL with another. This goes through each object owned by +the ACL and changes its ownership to the new ACL, leaving this acl owning +nothing (and probably then needing to be deleted). Returns true on +success and false on failure. On failure, the caller should call error() +to get the error message. + =item show() Returns a human-readable description of this ACL, including its diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index f6ea342..6af0570 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -734,6 +734,36 @@ sub acl_rename { return 1; } +# Move all ACLs owned by one ACL to another, or return undef and set the +# internal error. +sub acl_replace { + my ($self, $old_id, $replace_id) = @_; + unless ($self->{admin}->check ($self->{user})) { + $self->acl_error ($old_id, 'replace'); + return; + } + my $acl = eval { Wallet::ACL->new ($old_id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + if ($acl->name eq 'ADMIN') { + $self->error ('cannot replace the ADMIN ACL'); + return; + } + my $replace_acl = eval { Wallet::ACL->new ($replace_id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + + unless ($acl->replace ($replace_id, $self->{user}, $self->{host})) { + $self->error ($acl->error); + return; + } + return 1; +} + # Destroy an ACL, deleting it out of the database. Returns true on success. # On failure, returns undef, setting the internal error. sub acl_destroy { @@ -942,6 +972,14 @@ either the current name or the numeric ID. NEW must not be all-numeric. To rename an ACL, the current user must be authorized by the ADMIN ACL. Returns true on success and false on failure. +=item acl_replace(OLD, NEW) + +Moves any object owned by the ACL identified by OLD to be instead owned by +NEW. This goes through all objects owned by OLD and individually changes +the owner, along with history updates. OLD and NEW may be either the name +or the numeric ID. To replace an ACL, the current user must be authorized +by the ADMIN ACL. Returns true on success and false on failure. + =item acl_show(ID) Returns a human-readable description, including membership, of the ACL diff --git a/perl/t/general/acl.t b/perl/t/general/acl.t index 1dd5c53..ff8ddad 100755 --- a/perl/t/general/acl.t +++ b/perl/t/general/acl.t @@ -12,11 +12,11 @@ use strict; use warnings; use POSIX qw(strftime); -use Test::More tests => 101; +use Test::More tests => 109; use Wallet::ACL; use Wallet::Admin; -use Wallet::Server; +use Wallet::Object::Base; use lib 't/lib'; use Util; @@ -46,7 +46,7 @@ $acl = eval { Wallet::ACL->create (3, $schema, @trace) }; ok (!defined ($acl), 'Creating with a numeric name'); is ($@, "ACL name may not be all numbers\n", ' with the right error message'); $acl = eval { Wallet::ACL->create ('test', $schema, @trace) }; -ok (!defined ($acl), 'Creating a duplicate object'); +ok (!defined ($acl), 'Creating a duplicate acl'); like ($@, qr/^cannot create ACL test: /, ' with the right error message'); $acl = eval { Wallet::ACL->new ('test2', $schema) }; ok (!defined ($acl), 'Searching for a non-existent ACL'); @@ -231,6 +231,64 @@ is ($@, '', ' with no exceptions'); is ($acl->name, 'example', ' and the right name'); like ($acl->id, qr{\A[23]\z}, ' and an ID of 2 or 3'); +# Test replace. by creating three acls, then assigning two objects to the +# first, one to the second, and another to the third. Then replace the first +# acl with the second, so that we can verify that multiple objects are moved, +# that an object already belonging to the new acl is okay, and that the +# objects with unrelated ACL are unaffected. +my ($acl_old, $acl_new, $acl_other, $obj_old_one, $obj_old_two, $obj_new, + $obj_unrelated); +eval { + $acl_old = Wallet::ACL->create ('example-old', $schema, @trace); + $acl_new = Wallet::ACL->create ('example-new', $schema, @trace); + $acl_other = Wallet::ACL->create ('example-other', $schema, @trace); +}; +is ($@, '', 'ACLs needed for testing replace are created'); +eval { + $obj_old_one = Wallet::Object::Base->create ('keytab', + 'service/test1@EXAMPLE.COM', + $schema, @trace); + $obj_old_two = Wallet::Object::Base->create ('keytab', + 'service/test2@EXAMPLE.COM', + $schema, @trace); + $obj_new = Wallet::Object::Base->create ('keytab', + 'service/test3@EXAMPLE.COM', + $schema, @trace); + $obj_unrelated = Wallet::Object::Base->create ('keytab', + 'service/test4@EXAMPLE.COM', + $schema, @trace); +}; +is ($@, '', ' and so were needed objects'); +if ($obj_old_one->owner ('example-old', @trace) + && $obj_old_two->owner ('example-old', @trace) + && $obj_new->owner ('example-new', @trace) + && $obj_unrelated->owner ('example-other', @trace)) { + + ok (1, ' and setting initial ownership on the objects succeeds'); +} +is ($acl_old->replace('example-new', @trace), 1, + ' and replace ran successfully'); +eval { + $obj_old_one = Wallet::Object::Base->new ('keytab', + 'service/test1@EXAMPLE.COM', + $schema); + $obj_old_two = Wallet::Object::Base->new ('keytab', + 'service/test2@EXAMPLE.COM', + $schema); + $obj_new = Wallet::Object::Base->new ('keytab', + 'service/test3@EXAMPLE.COM', + $schema); + $obj_unrelated = Wallet::Object::Base->new ('keytab', + 'service/test4@EXAMPLE.COM', + $schema); +}; +is ($obj_old_one->owner, 'example-new', ' and first replace is correct'); +is ($obj_old_two->owner, 'example-new', ' and second replace is correct'); +is ($obj_new->owner, 'example-new', + ' and object already with new acl is correct'); +is ($obj_unrelated->owner, 'example-other', + ' and unrelated object ownership is correct'); + # Clean up. $setup->destroy; END { diff --git a/server/wallet-backend b/server/wallet-backend index 8dfc952..dcf2300 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -173,6 +173,9 @@ sub command { } elsif ($action eq 'rename') { check_args (2, 2, [], @args); $server->acl_rename (@args) or failure ($server->error, @_); + } elsif ($action eq 'replace') { + check_args (2, 2, [], @args); + $server->acl_replace (@args) or failure ($server->error, @_); } elsif ($action eq 'show') { check_args (1, 1, [], @args); my $output = $server->acl_show (@args); @@ -449,6 +452,25 @@ accidental lockout, but administrators can remove themselves from the C ACL and can leave only a non-functioning entry on the ACL. Use caution when removing entries from the C ACL. +=item acl rename + +Renames the ACL identified by to . This changes the +human-readable name, not the underlying numeric ID, so the ACL's +associations with objects will be unchanged. The C ACL may not be +renamed. may be either the current name or the numeric ID. +must not be all-numeric. To rename an ACL, the current user must be +authorized by the C ACL. + +=item acl replace + +Find any objects owned by , and then change their ownership to + instead. should already exist, and may already have +some objects owned by it. is not deleted afterwards, though in +most cases that is probably your next step. The C ACL may not be +replaced from. and may be either the current name or the +numeric ID. To replace an ACL, the current user must be authorized by +the C ACL. + =item acl show Display the name, numeric ID, and entries of the ACL . -- 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') 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') 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 000b338694fae87996220336678fe990a1c3e3e1 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Wed, 18 Feb 2015 15:17:51 -0800 Subject: Added new method for wallet-backend, update update will work generally like get, but only for objects that have a concept of updating content automatically, like keytabs and passwords. For these, the content will be updated before sending to the client. In a later release get for keytabs will be modified to never update the kvno before sending to the user, and so the unchanging flag will be phased out in lieu of explicitly using the method that does what you want. Change-Id: I96a84416c5e50278eb29fe07052dde6e063bc071 --- NEWS | 9 ++++++ client/wallet.pod | 13 +++++++++ perl/lib/Wallet/Object/Base.pm | 9 ++++++ perl/lib/Wallet/Object/Keytab.pm | 59 ++++++++++++++++++++++++++------------ perl/lib/Wallet/Object/Password.pm | 32 ++++++++++++++++----- perl/lib/Wallet/Server.pm | 15 ++++++++++ perl/t/object/base.t | 5 +++- perl/t/object/password.t | 8 +++++- server/wallet-backend | 16 +++++++++++ 9 files changed, 138 insertions(+), 28 deletions(-) (limited to 'server') diff --git a/NEWS b/NEWS index 64c0fbc..664da05 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,15 @@ wallet 1.3 (xxxx-xx-xx) generate content for the object if you do a get before storing any content inside it. + Added a new command to wallet-backend, update. This will update the + contents of an object before running a get on it, and is only valid + for objects that can automatically get new content, such as keytab + and password objects. A keytab will get a new kvno regardless of + the unchanging flag if called with update. In a future release get + will be changed to never update a keytab, and the unchanging flag + will be ignored. Please start moving to use get or update as the + situation warrants. + Added an acl replace command, to change all objects owned by one ACL to be owned by another. diff --git a/client/wallet.pod b/client/wallet.pod index 20d1874..672f0e4 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -385,6 +385,19 @@ If an object with type and name does not already exist when this command is issued (as checked with the check interface), B will attempt to automatically create it (using autocreate). +=item update + +Prints to standard output the data associated with the object identified +by and , or stores it in a file if the B<-f> option was +given. This will generate new data in the object, and only works for +objects that support generating new data automatically, such as keytabs or +passwords. Types that do not support generating new data will fail and +direct you to use get instead. + +If an object with type and name does not already exist when +this command is issued (as checked with the check interface), B +will attempt to automatically create it (using autocreate). + =back =head1 ATTRIBUTES diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index bdd61fb..97e6127 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -609,6 +609,15 @@ sub history { # The get methods must always be overridden by the subclass. sub get { die "Do not instantiate Wallet::Object::Base directly\n"; } +# The update method should only work if a subclass supports it as something +# different from get. That makes it explicit about whether the subclass has +# a meaningful update. +sub update { + my ($self) = @_; + $self->error ("update is not supported for this type, use get instead"); + return; +} + # Provide a default store implementation that returns an immutable object # error so that auto-generated types don't have to provide their own. sub store { diff --git a/perl/lib/Wallet/Object/Keytab.pm b/perl/lib/Wallet/Object/Keytab.pm index 975179b..c625766 100644 --- a/perl/lib/Wallet/Object/Keytab.pm +++ b/perl/lib/Wallet/Object/Keytab.pm @@ -28,6 +28,37 @@ use Wallet::Kadmin; # that it will sort properly. $VERSION = '0.09'; +############################################################################## +# Shared methods +############################################################################## + +# Generate a keytab into a temporary file and then return that as the return +# value. Used by both get and update, as the only difference is how we +# handle the unchanging flag. +sub retrieve { + my ($self, $operation, $user, $host, $time) = @_; + $time ||= time; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot get $id: object is locked"); + return; + } + my $kadmin = $self->{kadmin}; + my $result; + if ($operation eq 'get' && $self->flag_check ('unchanging')) { + $result = $kadmin->keytab ($self->{name}); + } else { + my @enctypes = $self->attr ('enctypes'); + $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); + } + if (defined $result) { + $self->log_action ($operation, $user, $host, $time); + } else { + $self->error ($kadmin->error); + } + return $result; +} + ############################################################################## # Enctype restriction ############################################################################## @@ -314,25 +345,15 @@ sub destroy { # return that as the return value. sub get { my ($self, $user, $host, $time) = @_; - $time ||= time; - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - my $kadmin = $self->{kadmin}; - my $result; - if ($self->flag_check ('unchanging')) { - $result = $kadmin->keytab ($self->{name}); - } else { - my @enctypes = $self->attr ('enctypes'); - $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); - } - if (defined $result) { - $self->log_action ('get', $user, $host, $time); - } else { - $self->error ($kadmin->error); - } + my $result = $self->retrieve ('get', $user, $host, $time); + return $result; +} + +# Our update implementation. Generate a new keytab regardless of the +# unchanging flag. +sub update { + my ($self, $user, $host, $time) = @_; + my $result = $self->retrieve ('update', $user, $host, $time); return $result; } diff --git a/perl/lib/Wallet/Object/Password.pm b/perl/lib/Wallet/Object/Password.pm index d06c8a6..3fd6ec8 100644 --- a/perl/lib/Wallet/Object/Password.pm +++ b/perl/lib/Wallet/Object/Password.pm @@ -57,12 +57,12 @@ sub file_path { } ############################################################################## -# Core methods +# Shared methods ############################################################################## # Return the contents of the file. -sub get { - my ($self, $user, $host, $time) = @_; +sub retrieve { + my ($self, $operation, $user, $host, $time) = @_; $time ||= time; my $id = $self->{type} . ':' . $self->{name}; if ($self->flag_check ('locked')) { @@ -72,13 +72,13 @@ sub get { my $path = $self->file_path; return unless $path; - # If nothing is yet stored, generate a random password and save it to - # the file. + # If nothing is yet stored, or we have requested an update, generate a + # random password and save it to the file. my $schema = $self->{schema}; my %search = (ob_type => $self->{type}, ob_name => $self->{name}); my $object = $schema->resultset('Object')->find (\%search); - unless ($object->ob_stored_on) { + if (!$object->ob_stored_on || $operation eq 'update') { unless (open (FILE, '>', $path)) { $self->error ("cannot store initial settings for $id: $!\n"); return; @@ -103,10 +103,28 @@ sub get { $self->error ("cannot get $id: $!"); return; } - $self->log_action ('get', $user, $host, $time); + $self->log_action ($operation, $user, $host, $time); return $data; } +############################################################################## +# Core methods +############################################################################## + +# Return the contents of the file. +sub get { + my ($self, $user, $host, $time) = @_; + my $result = $self->retrieve ('get', $user, $host, $time); + return $result; +} + +# Return the contents of the file after resetting them to a random string. +sub update { + my ($self, $user, $host, $time) = @_; + my $result = $self->retrieve ('update', $user, $host, $time); + return $result; +} + 1; __END__ diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index 6af0570..3ef5954 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -516,6 +516,21 @@ sub get { return $result; } +# Retrieve the information associated with an object, updating the current +# information if we are of a type that allows autogenerated information. +# Returns undef and sets the internal error if the retrieval fails or if the +# user isn't authorized. If the object doesn't exist, attempts dynamic +# creation of the object using the default ACL mappings (if any). +sub update { + my ($self, $type, $name) = @_; + my $object = $self->retrieve ($type, $name); + return unless defined $object; + return unless $self->acl_verify ($object, 'get'); + my $result = $object->update ($self->{user}, $self->{host}); + $self->error ($object->error) unless defined $result; + return $result; +} + # Store new data in an object, or returns undef and sets the internal error if # the object can't be found or if the user isn't authorized. Also don't # permit storing undef, although storing the empty string is fine. If the 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/password.t b/perl/t/object/password.t index c0f2fbc..4fe6b50 100644 --- a/perl/t/object/password.t +++ b/perl/t/object/password.t @@ -13,7 +13,7 @@ use strict; use warnings; use POSIX qw(strftime); -use Test::More tests => 31; +use Test::More tests => 33; use Wallet::Admin; use Wallet::Config; @@ -111,6 +111,12 @@ 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 { diff --git a/server/wallet-backend b/server/wallet-backend index dcf2300..ea3e21e 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -315,6 +315,14 @@ sub command { } splice (@_, 3); $server->store (@args) or failure ($server->error, @_); + } elsif ($command eq 'update') { + check_args (2, 2, [], @args); + my $output = $server->update (@args); + if (defined $output) { + print $output; + } else { + failure ($server->error, @_); + } } else { error "unknown command $command"; } @@ -611,6 +619,14 @@ Stores for the object identified by and for later retrieval with C. Not all object types support this. If is not given as an argument, it will be read from standard input. +=item update + +Prints to standard output the data associated with the object identified +by and . If the object is one that can have changing +information, such as a keytab or password, then we generate new data for +that object regardless of whether there is current data or the unchanging +flag is set. + =back =head1 ATTRIBUTES -- 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') 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') 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') 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') 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') 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') 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') 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