From 574a9c0456c182831b3d01a4d7ee0c737b91b107 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 14:39:39 -0700 Subject: Remove Subversion Id strings --- server/keytab-backend | 1 - server/wallet-admin | 1 - server/wallet-backend | 1 - 3 files changed, 3 deletions(-) (limited to 'server') diff --git a/server/keytab-backend b/server/keytab-backend index 06fed3d..b37fb3a 100755 --- a/server/keytab-backend +++ b/server/keytab-backend @@ -1,5 +1,4 @@ #!/usr/bin/perl -our $ID = q$Id$; # # keytab-backend -- Extract keytabs from the KDC without changing the key. # diff --git a/server/wallet-admin b/server/wallet-admin index 4c27e9b..0daa986 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -our $ID = q$Id$; # # wallet-admin -- Wallet server administrative commands. # diff --git a/server/wallet-backend b/server/wallet-backend index 74e0eb0..448f175 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -1,5 +1,4 @@ #!/usr/bin/perl -our $ID = q$Id$; # # wallet-backend -- Wallet server for storing and retrieving secure data. # -- cgit v1.2.3 From c2cde5918af1882ee63324fd9e09f07c8e6e5cc9 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 16:39:08 -0700 Subject: Add owners report Add a new report owners command to wallet-admin and corresponding report_owners() method to Wallet::Admin, which returns all ACL lines on owner ACLs for matching objects. --- NEWS | 4 ++++ perl/Wallet/Admin.pm | 47 ++++++++++++++++++++++++++++++++++++++++-- perl/t/admin.t | 55 +++++++++++++++++++++++++++++++++++++++++++++++-- server/wallet-admin | 39 ++++++++++++++++++++++++++++++++++- tests/server/admin-t.in | 45 +++++++++++++++++++++++++++++++--------- 5 files changed, 175 insertions(+), 15 deletions(-) (limited to 'server') diff --git a/NEWS b/NEWS index e16c630..ab0828b 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,10 @@ wallet 0.10 (unreleased) Fix logging in wallet-backend and the remctl configuration to not log the data passed to store. + Add a new report owners command to wallet-admin and corresponding + report_owners() method to Wallet::Admin, which returns all ACL lines + on owner ACLs for matching objects. + wallet 0.9 (2008-04-24) The wallet command-line client now reads the data for store from a diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 3a2f687..c11c3d4 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -22,7 +22,7 @@ use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; ############################################################################## # Constructor, destructor, and accessors @@ -171,6 +171,38 @@ sub list_acls { } } +# Returns a report of all ACL lines contained in owner ACLs for matching +# objects. Objects are specified by type and name, which may be SQL wildcard +# expressions. Each list member will be a pair of ACL scheme and ACL +# identifier, with duplicates removed. On error and for no matching entries, +# the empty list will be returned. To distinguish between an empty return and +# an error, call error(), which will return undef if there was no error. +sub report_owners { + my ($self, $type, $name) = @_; + undef $self->{error}; + my @lines; + eval { + my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries, + acls, objects where ae_id = ac_id and ac_id = ob_owner and + ob_type like ? and ob_name like ? order by ae_scheme, + ae_identifier'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute ($type, $name); + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@lines, [ @$object ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot report on owners: $@"); + $self->{dbh}->rollback; + return; + } else { + return @lines; + } +} + ############################################################################## # Object registration ############################################################################## @@ -335,6 +367,17 @@ be deleted and a fresh set of wallet database tables will be created. This method is equivalent to calling destroy() followed by initialize(). Returns true on success and false on failure. +=item report_owners(TYPE, NAME) + +Returns a list of all ACL lines contained in owner ACLs for objects +matching TYPE and NAME, which are interpreted as SQL patterns using C<%> +as a wildcard. The return value is a list of references to pairs of +schema and identifier, with duplicates removed. + +Returns the empty list on failure. To distinguish between this and no +matches, 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. + =back =head1 SEE ALSO diff --git a/perl/t/admin.t b/perl/t/admin.t index 7a8b8ae..8804f34 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -3,11 +3,11 @@ # t/admin.t -- Tests for wallet administrative interface. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -use Test::More tests => 29; +use Test::More tests => 57; use Wallet::Admin; use Wallet::Schema; @@ -73,6 +73,57 @@ is ($acls[0][1], 'ADMIN', ' and the first name is still the same'); is ($acls[1][0], 3, ' but the second ID has changed'); is ($acls[1][1], 'second', ' and the second name is correct'); +# Currently, we have no owners, so we should get an empty owner report. +my @lines = $admin->report_owners ('%', '%'); +is (scalar (@lines), 0, 'Owner report is currently empty'); +is ($admin->error, undef, ' and there is no error'); + +# Set an owner and make sure we now see something in the report. +is ($server->owner ('base', 'service/admin', 'ADMIN'), 1, + 'Setting an owner works'); +@lines = $admin->report_owners ('%', '%'); +is (scalar (@lines), 1, ' and now there is one owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); +@lines = $admin->report_owners ('keytab', '%'); +is (scalar (@lines), 0, 'Owners of keytabs is empty'); +is ($admin->error, undef, ' with no error'); +@lines = $admin->report_owners ('base', 'foo/%'); +is (scalar (@lines), 0, 'Owners of base foo/* objects is empty'); +is ($admin->error, undef, ' with no error'); + +# Create a second object with the same owner. +is ($server->create ('base', 'service/foo'), 1, + 'Creating base:service/foo succeeds'); +is ($server->owner ('base', 'service/foo', 'ADMIN'), 1, + ' and setting the owner to the same value works'); +@lines = $admin->report_owners ('base', 'service/%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Change the owner of the second object to an empty ACL. +is ($server->owner ('base', 'service/foo', 'second'), 1, + ' and changing the owner to an empty ACL works'); +@lines = $admin->report_owners ('base', '%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Add a few things to the second ACL to see what happens. +is ($server->acl_add ('second', 'base', 'foo'), 1, + 'Adding an ACL line to the new ACL works'); +is ($server->acl_add ('second', 'base', 'bar'), 1, + ' and adding another ACL line to the new ACL works'); +@lines = $admin->report_owners ('base', '%'); +is (scalar (@lines), 3, ' and now there are three owners in the report'); +is ($lines[0][0], 'base', ' first has the right scheme'); +is ($lines[0][1], 'bar', ' and the right identifier'); +is ($lines[1][0], 'base', ' second has the right scheme'); +is ($lines[1][1], 'foo', ' and the right identifier'); +is ($lines[2][0], 'krb5', ' third has the right scheme'); +is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); unlink 'wallet-db'; diff --git a/server/wallet-admin b/server/wallet-admin index 0daa986..b5674c5 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -3,7 +3,7 @@ # wallet-admin -- Wallet server administrative commands. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -64,6 +64,22 @@ sub command { } else { die "only objects or acls are supported for list\n"; } + } elsif ($command eq 'report') { + die "too few arguments to report\n" if @args < 1; + my $report = shift @args; + if ($report eq 'owners') { + die "too many arguments to report owners\n" if @args > 2; + die "too few arguments to report owners\n" if @args < 2; + my @lines = $admin->report_owners (@args); + if (!@lines and $admin->error) { + die $admin->error, "\n"; + } + for my $line (@lines) { + print join (' ', @$line), "\n"; + } + } else { + die "unknown report type $report\n"; + } } elsif ($command eq 'register') { die "too many arguments to register\n" if @args > 3; die "too few arguments to register\n" if @args < 3; @@ -168,6 +184,27 @@ default as part of database initialization, so this command is used primarily to register local implementations of additional object types or ACL schemes. +=item report [ ... ] + +Runs a wallet report. The currently supported report types are: + +=over 4 + +=item report owners + +Returns a list of all ACL lines in owner ACLs for all objects matching +both and . These can be the type or name of +objects or they can be patterns using C<%> as the wildcard character +following the normal rules of SQL patterns. + +The output will be one line per ACL line in the form: + + + +with duplicates suppressed. + +=back + =back =head1 SEE ALSO diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in index 44ea1fe..3e84022 100644 --- a/tests/server/admin-t.in +++ b/tests/server/admin-t.in @@ -3,12 +3,12 @@ # Tests for the wallet-admin dispatch code. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. use strict; -use Test::More tests => 54; +use Test::More tests => 64; # Create a dummy class for Wallet::Admin that prints what method was called # with its arguments and returns data for testing. @@ -71,6 +71,13 @@ sub register_verifier { return 1; } +sub report_owners { + shift; + print "report_owners @_\n"; + return if ($error or $empty); + return ([ krb5 => 'admin@EXAMPLE.COM' ]); +} + # Back to the main package and the actual test suite. Lie about whether the # Wallet::Admin package has already been loaded. package main; @@ -98,10 +105,11 @@ is ($err, "unknown command foo\n", 'Unknown command'); is ($out, "new\n", ' and nothing ran'); # Check too few and too many arguments for every command. -my %commands = (destroy => [0, 0], - initialize => [1, 1], - list => [1, 1], - register => [3, 3]); +my %commands = (destroy => [0, 0], + initialize => [1, 1], + list => [1, 1], + register => [3, 3], + report => [1, -1]); for my $command (sort keys %commands) { my ($min, $max) = @{ $commands{$command} }; if ($min > 0) { @@ -110,10 +118,12 @@ for my $command (sort keys %commands) { "Too few arguments for $command"); is ($out, "new\n", ' and nothing ran'); } - ($out, $err) = run_admin ($command, ('foo') x ($max + 1)); - is ($err, "too many arguments to $command\n", - "Too many arguments for $command"); - is ($out, "new\n", ' and nothing ran'); + if ($max >= 0) { + ($out, $err) = run_admin ($command, ('foo') x ($max + 1)); + is ($err, "too many arguments to $command\n", + "Too many arguments for $command"); + is ($out, "new\n", ' and nothing ran'); + } } # Test destroy. @@ -179,6 +189,15 @@ is ($err, '', 'Register succeeds for verifier'); is ($out, "new\nregister_verifier foo Foo::Verifier\n", ' and returns the right outout'); +# Test report. +($out, $err) = run_admin ('report', 'foo'); +is ($err, "unknown report type foo\n", 'Report requires a known report'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('report', 'owners', '%', '%'); +is ($err, '', 'Report succeeds for owners'); +is ($out, "new\nreport_owners % %\nkrb5 admin\@EXAMPLE.COM\n", + ' and returns the right output'); + # Test error handling. $Wallet::Admin::error = 1; ($out, $err) = run_admin ('destroy'); @@ -204,6 +223,9 @@ is ($out, "new\nregister_object foo Foo::Object\n", is ($err, "some error\n", 'Error handling succeeds for register verifier'); is ($out, "new\nregister_verifier foo Foo::Verifier\n", ' and calls the right methods'); +($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); +is ($err, "some error\n", 'Error handling succeeds for report owners'); +is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); # Test empty lists. $Wallet::Admin::error = 0; @@ -214,3 +236,6 @@ is ($out, "new\nlist_objects\n", ' and calls the right methods'); ($out, $err) = run_admin ('list', 'acls'); is ($err, '', 'list acls runs with an empty list and no errors'); is ($out, "new\nlist_acls\n", ' and calls the right methods'); +($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); +is ($err, '', 'report owners runs with an empty list and no errors'); +is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); -- cgit v1.2.3 From 2c5bd71125d411639b4a61116957879eebae21ad Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 3 Dec 2009 08:52:19 -0800 Subject: Improved wallet-admin list command with searches wallet-admin's list command now has additional searches added for objects and acls that match certain specifiers. For objects these include searching for objects owned by a specific ACL, objects owned by no one, objects of a specific type, objects with a specific flag, and objects for which a specific ACL has any privileges at all. For acls, this includes the ability to search for any ACL with an entry with given type and identifier. --- perl/Wallet/Admin.pm | 167 ++++++++++++++++++++++++++++++++++++++++++++++++--- perl/t/admin.t | 55 ++++++++++++++--- server/wallet-admin | 8 +-- 3 files changed, 206 insertions(+), 24 deletions(-) (limited to 'server') diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index c11c3d4..91f1bfb 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -22,7 +22,7 @@ use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.03'; +$VERSION = '0.04'; ############################################################################## # Constructor, destructor, and accessors @@ -114,20 +114,132 @@ sub destroy { # Reporting ############################################################################## +# Given an ACL name, translate it to the ID for that ACL and return it. +# Often this is unneeded and could be done with a join, but by doing it in a +# separate step, we can give an error for the specific case of someone +# searching for a non-existant ACL. +sub acl_name_to_id { + my ($self, $acl) = @_; + my ($id); + eval { + my $sql = 'select ac_id from acls where ac_name=?'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute ($acl); + while (defined (my $row = $sth->fetchrow_hashref)) { + $id = $row->{'ac_id'}; + } + $self->{dbh}->commit; + }; + + if (!defined $id || $id !~ /^\d+$/) { + $self->error ("could not find the acl $acl"); + return ''; + } + return $id; +} + +# Return the SQL statement to find every object in the database. +sub list_objects_all { + my ($self) = @_; + my $sql = 'select ob_type, ob_name from objects order by ob_type, + ob_name'; + return $sql; +} + +# Return the SQL statement and the search field required to find all objects +# matching a specific type. +sub list_objects_type { + my ($self, $type) = @_; + my $sql = 'select ob_type, ob_name from objects where ob_type=? order + by ob_type, ob_name'; + return ($sql, $type); +} + +# Return the SQL statement and search field required to find all objects +# owned by a given ACL. If the requested owner is 'null', then we ignore +# this and do a different search for IS NULL. If the requested owner does +# not actually match any ACLs, set an error and return the empty string. +sub list_objects_owner { + my ($self, $owner) = @_; + my ($sth); + if ($owner =~ /^null$/i) { + my $sql = 'select ob_type, ob_name from objects where ob_owner is null + order by objects.ob_type, objects.ob_name'; + return ($sql); + } else { + my $id = $self->acl_name_to_id ($owner); + return '' unless $id; + my $sql = 'select ob_type, ob_name from objects where ob_owner=? + order by objects.ob_type, objects.ob_name'; + return ($sql, $id); + } +} + +# Return the SQL statement and search field required to find all objects +# that have a specific flag set. +sub list_objects_flag { + my ($self, $flag) = @_; + my $sql = 'select ob_type, ob_name from objects left join flags on + (objects.ob_type=flags.fl_type AND objects.ob_name=flags.fl_name) + where flags.fl_flag=? order by objects.ob_type, objects.ob_name'; + return ($sql, $flag); +} + +# Return the SQL statement and search field required to find all objects +# that a given ACL has any permissions on. This expands from +# list_objects_owner in that it will also match any records that have the ACL +# set for get, store, show, destroy, or flags. If the requested owner does +# not actually match any ACLs, set an error and return the empty string. +sub list_objects_acl { + my ($self, $acl) = @_; + + my $id = $self->acl_name_to_id ($acl); + return '' unless $id; + + my $sql = 'select ob_type, ob_name from objects where + ob_owner=? or ob_acl_get=? or ob_acl_store=? or ob_acl_show=? or + ob_acl_destroy=? or ob_acl_flags=? + order by objects.ob_type, objects.ob_name'; + return ($sql, $id, $id, $id, $id, $id, $id); +} + # 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. +# 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 list_objects { - my ($self) = @_; + my ($self, $type, @args) = @_; undef $self->{error}; + + # Find the SQL statement and the arguments to use. + my $sql = ''; + my @search = (); + if (!defined $type || $type eq '') { + ($sql) = $self->list_objects_all (); + } else { + if (@args != 1) { + $self->error ("object searches require an argument to search"); + } elsif ($type eq 'type') { + ($sql, @search) = $self->list_objects_type (@args); + } elsif ($type eq 'owner') { + ($sql, @search) = $self->list_objects_owner (@args); + } elsif ($type eq 'flag') { + ($sql, @search) = $self->list_objects_flag (@args); + } elsif ($type eq 'acl') { + ($sql, @search) = $self->list_objects_acl (@args); + } else { + $self->error ("do not know search type: $type"); + } + return unless $sql; + } + my @objects; eval { - my $sql = 'select ob_type, ob_name from objects order by ob_type, - ob_name'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute; my $object; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (@search); while (defined ($object = $sth->fetchrow_arrayref)) { push (@objects, [ @$object ]); } @@ -142,6 +254,25 @@ sub list_objects { } } +# Returns the SQL statement required to find and return all ACLs in the db. +sub list_acls_all { + my ($self) = @_; + my $sql = 'select ac_id, ac_name from acls order by ac_id'; + return ($sql); +} + +# Returns the SQL statement and the field required to search the ACLs and +# return only those entries which contain a entries with identifiers +# matching a particular given string. +sub list_acls_entry { + my ($self, $type, $identifier) = @_; + my $sql = 'select distinct ac_id, ac_name from acl_entries + left join acls on (ae_id=ac_id) where ae_scheme=? and + ae_identifier like ? order by ac_id'; + $identifier = '%'.$identifier.'%'; + return ($sql, $type, $identifier); +} + # Returns a list of all ACLs stored in the wallet database as a list of pairs # of ACL IDs and ACL names. On error and for an empty database, the empty # list will be returned; however, this is unlikely since any valid database @@ -149,13 +280,29 @@ sub list_objects { # list and an error, call error(), which will return undef if there was no # error. sub list_acls { - my ($self) = @_; + my ($self, $type, @args) = @_; undef $self->{error}; + + # Find the SQL statement and the arguments to use. + my $sql = ''; + my @search = (); + if (!defined $type || $type eq '') { + ($sql) = $self->list_acls_all (); + } else { + if (@args == 0) { + $self->error ("acl searches require an argument to search"); + } elsif ($type eq 'entry') { + ($sql, @search) = $self->list_acls_entry (@args); + } else { + $self->error ("do not know search type: $type"); + } + return unless $sql; + } + my @acls; eval { - my $sql = 'select ac_id, ac_name from acls order by ac_id'; my $sth = $self->{dbh}->prepare ($sql); - $sth->execute; + $sth->execute (@search); my $object; while (defined ($object = $sth->fetchrow_arrayref)) { push (@acls, [ @$object ]); diff --git a/perl/t/admin.t b/perl/t/admin.t index 8804f34..77c786d 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 57; +use Test::More tests => 77; use Wallet::Admin; use Wallet::Schema; @@ -54,15 +54,6 @@ is ($objects[0][1], 'service/admin', ' and the right name'); is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), 1, 'Registering Wallet::ACL::Base works'); -# Create another ACL. -is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); -@acls = $admin->list_acls; -is (scalar (@acls), 2, ' and now there are two ACLs'); -is ($acls[0][0], 1, ' and the first ID is correct'); -is ($acls[0][1], 'ADMIN', ' and the first name is correct'); -is ($acls[1][0], 2, ' and the second ID is correct'); -is ($acls[1][1], 'first', ' and the second name is correct'); - # Delete that ACL and create another. is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds'); is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds'); @@ -124,6 +115,50 @@ is ($lines[1][1], 'foo', ' and the right identifier'); is ($lines[2][0], 'krb5', ' third has the right scheme'); is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); +# Test ownership and other ACL values. Change one keytab to be not owned by +# ADMIN, but have group permission on it. We'll need a third object neither +# owned by ADMIN or with any permissions from it. +is ($server->create ('base', 'service/null'), 1, + 'Creating base:service/null succeeds'); +is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, + 'Changing the get ACL for the search also does'); +@lines = $admin->list_objects ('owner', 'ADMIN'); +is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +@lines = $admin->list_objects ('owner', 'null'); +is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/null', ' and the right name'); +@lines = $admin->list_objects ('acl', 'ADMIN'); +is (scalar (@lines), 2, 'ADMIN has any rights at all on two objects'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($lines[1][0], 'base', ' and the second has the right type'); +is ($lines[1][1], 'service/foo', ' and the right name'); + +# Listing objects of a specific type. +@lines = $admin->list_objects ('type', 'base'); +is (scalar (@lines), 3, 'Searching for all objects of type base finds three'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($lines[1][0], 'base', ' and the second has the right type'); +is ($lines[1][1], 'service/foo', ' and the right name'); +is ($lines[2][0], 'base', ' and the third has the right type'); +is ($lines[2][1], 'service/null', ' and the right name'); +@lines = $admin->list_objects ('type', 'keytab'); +is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none'); + +# Test setting a flag, searching for objects with it, and then clearing it. +is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, + 'Setting a flag works'); +@lines = $admin->list_objects ('flag', 'unchanging'); +is (scalar (@lines), 1, 'Searching for all objects with that flag finds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, + 'Clearing the flag works'); + # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); unlink 'wallet-db'; diff --git a/server/wallet-admin b/server/wallet-admin index b5674c5..01fea5c 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -42,11 +42,11 @@ sub command { unless $args[0] =~ /^[^\@\s]+\@\S+$/; $admin->initialize (@args) or die $admin->error, "\n"; } elsif ($command eq 'list') { - die "too many arguments to list\n" if @args > 1; + die "too many arguments to list\n" if @args > 4; die "too few arguments to list\n" if @args < 1; - my ($type) = @args; + my ($type, $subtype, @search) = @args; if ($type eq 'objects') { - my @objects = $admin->list_objects; + my @objects = $admin->list_objects ($subtype, @search); if (!@objects and $admin->error) { die $admin->error, "\n"; } @@ -54,7 +54,7 @@ sub command { print join (' ', @$object), "\n"; } } elsif ($type eq 'acls') { - my @acls = $admin->list_acls; + my @acls = $admin->list_acls ($subtype, @search); if (!@acls and $admin->error) { die $admin->error, "\n"; } -- cgit v1.2.3 From 43c1420d37df58fdfc8b7e5ae229afd34a8bf070 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 21 Jan 2010 19:08:48 -0800 Subject: Documentation additions and fixes Added documentation for the new object and acl list searches to perl/Wallet/Admin.pm and server/wallet-admin. Also fixed a POD error in perl/Wallet/Kadmin.pm's docs. --- perl/Wallet/Admin.pm | 38 ++++++++++++++++++++++++++++---------- perl/Wallet/Kadmin.pm | 2 ++ server/wallet-admin | 51 ++++++++++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 78 insertions(+), 13 deletions(-) (limited to 'server') diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 701c813..c86cbba 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -475,12 +475,14 @@ initialize() uses C as the hostname and PRINCIPAL as the user when logging the history of the ADMIN ACL creation and for any subsequent actions on the object it returns. -=item list_acls() +=item list_acls(TYPE, SEARCH) -Returns a list of all ACLs in the database. The return value is a list of -references to pairs of ACL ID and name. For example, if there are two -ACLs in the database, one with name "ADMIN" and ID 1 and one with name -"group/admins" and ID 3, list_acls() would return: +Returns a list of all ACLs matching a search type and string in the +database, or all ACLs if no search information is given. The return value +is a list of references to pairs of ACL ID and name. For example, if +there are two ACLs in the database, one with name "ADMIN" and ID 1 and one +with name "group/admins" and ID 3, list_acls() with no arguments would +return: ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) @@ -489,12 +491,20 @@ at least one ACL, but an error can be distinguished from the odd case of a database with no ACLs by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. -=item list_objects() +There are currently two search types. 'empty' takes no arguments, and will +return only those acls that have no entries within them. 'entry' takes two +arguments -- an entry scheme and an entry identifier -- and will return +any ACLs with an entry that matches the given scheme and contains the +given identifier. -Returns a list of all objects in the database. The return value is a list -of references to pairs of type and name. For example, if two objects -existed in the database, both of type "keytab" and with values -"host/example.com" and "foo", list_objects() would return: +=item list_objects(TYPE, SEARCH) + +Returns a list of all objects matching a search type and string in the +database, or all objects in the database if no search information is +given. The return value is a list of references to pairs of type and +name. For example, if two objects existed in the database, both of type +"keytab" and with values "host/example.com" and "foo", list_objects() +with no arguments would return: ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) @@ -503,6 +513,14 @@ database containing no objects, 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. +There are four types of searches currently. 'type' (with a given type) +will return only those entries where the type matches the given type. +'owner', with a given owner, will only return those objects owned by the +given acl name. 'flag', with a given flag name, will only return those +items with a flag set to the given value. 'acl' operates like 'owner', +but will return only those objects that have the given acl name on any +of the possible acl settings, not just owner. + =item register_object (TYPE, CLASS) Register in the database a mapping from the object type TYPE to the class diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 200136c..0a9bd43 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -120,6 +120,8 @@ calling valid_principal on the returned object -- this method is a shortcut in case we want to check validity without creating the object and worrying about proper setup. +=back + =head1 SEE ALSO kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) diff --git a/server/wallet-admin b/server/wallet-admin index 01fea5c..761288d 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -156,10 +156,10 @@ Before running C, the wallet system has to be configured. See Wallet::Config(3) for more details. Depending on the database backend used, the database may also have to be created in advance. -=item list (acls | objects) +=item list (acls | objects) [ [ ... ] ] -Returns a list of all ACLs or objects in the database. ACLs will be -listed in the form: +Returns a list of ACLs or objects in the database. ACLs will be listed +in the form: (ACL ID: ) @@ -171,6 +171,51 @@ be listed in the form: In both cases, there will be one line per ACL or object. +If no searchtype is given, all the ACLs or objects in the database will +be returned. If a searchtype (and possible search arguments) are given, +then the ACLs or objects will be limited to those that match the search. + +The currently supported object search types are: + +=over 4 + +=item list objects type + +Returns all objects of the given type. + +=item list objects flag + +Returns all objects which have the given flag set. + +=item list objects owner + +Returns all objects owned by the given ACL name. + +=item list objects acl + +Returns all objects for which the given ACL name has any permissions. +This includes those objects owned by the ACL, but also those for which the +ACL has get permissions, for example. + +=back + +The currently supported ACL search types are: + +=over 4 + +=item list acls empty + +Returns all ACLs which have no entries, generally so that abandoned ACLs +can be housekept. + +=item list acls entry + +Returns all ACLs containing an entry with given schema and identifier. +The schema is used for an exact search, while the identifier given will +match any identifier containing that text, for flexibility. + +=back + =item register (object | verifier) Registers an implementation of a wallet object or ACL verifier in the -- cgit v1.2.3 From 346660359be7666e8629c14b2d12cebf794f6f26 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 15:47:04 -0800 Subject: Coding style and whitespace fixes Combine a long series of eval blocks into a single block and a single error check. Remove trailing whitespace, and in some cases remove trailing () on method calls where the parens aren't useful. --- perl/Wallet/Admin.pm | 28 +++++++++--------- perl/Wallet/Kadmin.pm | 7 ++--- perl/Wallet/Kadmin/Heimdal.pm | 68 +++++++++++++++---------------------------- perl/Wallet/Object/Keytab.pm | 2 +- perl/t/kadmin.t | 6 ++-- perl/t/keytab.t | 2 +- server/wallet-admin | 6 ++-- 7 files changed, 49 insertions(+), 70 deletions(-) (limited to 'server') diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index c86cbba..ff87b94 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -477,11 +477,11 @@ actions on the object it returns. =item list_acls(TYPE, SEARCH) -Returns a list of all ACLs matching a search type and string in the -database, or all ACLs if no search information is given. The return value -is a list of references to pairs of ACL ID and name. For example, if -there are two ACLs in the database, one with name "ADMIN" and ID 1 and one -with name "group/admins" and ID 3, list_acls() with no arguments would +Returns a list of all ACLs matching a search type and string in the +database, or all ACLs if no search information is given. The return value +is a list of references to pairs of ACL ID and name. For example, if +there are two ACLs in the database, one with name "ADMIN" and ID 1 and one +with name "group/admins" and ID 3, list_acls() with no arguments would return: ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) @@ -492,18 +492,18 @@ database with no ACLs by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. There are currently two search types. 'empty' takes no arguments, and will -return only those acls that have no entries within them. 'entry' takes two -arguments -- an entry scheme and an entry identifier -- and will return +return only those acls that have no entries within them. 'entry' takes two +arguments -- an entry scheme and an entry identifier -- and will return any ACLs with an entry that matches the given scheme and contains the given identifier. =item list_objects(TYPE, SEARCH) -Returns a list of all objects matching a search type and string in the -database, or all objects in the database if no search information is -given. The return value is a list of references to pairs of type and -name. For example, if two objects existed in the database, both of type -"keytab" and with values "host/example.com" and "foo", list_objects() +Returns a list of all objects matching a search type and string in the +database, or all objects in the database if no search information is +given. The return value is a list of references to pairs of type and +name. For example, if two objects existed in the database, both of type +"keytab" and with values "host/example.com" and "foo", list_objects() with no arguments would return: ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) @@ -516,8 +516,8 @@ if there was no error. There are four types of searches currently. 'type' (with a given type) will return only those entries where the type matches the given type. 'owner', with a given owner, will only return those objects owned by the -given acl name. 'flag', with a given flag name, will only return those -items with a flag set to the given value. 'acl' operates like 'owner', +given acl name. 'flag', with a given flag name, will only return those +items with a flag set to the given value. 'acl' operates like 'owner', but will return only those objects that have the given acl name on any of the possible acl settings, not just owner. diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 501bc37..b3a630e 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -32,15 +32,14 @@ $VERSION = '0.03'; sub new { my ($class) = @_; my ($kadmin); - if (!defined $Wallet::Config::KEYTAB_KRBTYPE - || !$Wallet::Config::KEYTAB_KRBTYPE) { + if (not $Wallet::Config::KEYTAB_KRBTYPE) { die "keytab object implementation not configured\n"; } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { require Wallet::Kadmin::MIT; - $kadmin = Wallet::Kadmin::MIT->new (); + $kadmin = Wallet::Kadmin::MIT->new; } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { require Wallet::Kadmin::Heimdal; - $kadmin = Wallet::Kadmin::Heimdal->new (); + $kadmin = Wallet::Kadmin::Heimdal->new; } else { die "keytab krb server type not set to a valid value\n"; } diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index b0010a5..d046162 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -98,40 +98,27 @@ sub addprinc { my $exists = eval { $self->exists ($principal) }; if ($@) { $self->error ("error adding principal $principal: $@"); - return undef; + return; } return 1 if $exists; # The way Heimdal::Kadm5 works, we create a principal object, create the # actual principal set inactive, then randomize it and activate it. + # # TODO - Paranoia makes me want to set the password to something random # on creation even if it is inactive until after randomized by # module. my $kadmin = $self->{client}; - my $princdata = eval { $kadmin->makePrincipal ($principal) }; - if ($@) { - $self->error ("error adding principal $principal: $@"); - return; - } - - # Disable the principal before creating, until we've randomized the - # password. - my $attrs = eval { $princdata->getAttributes }; - if ($@) { - $self->error ("error adding principal $principal: $@"); - return; + eval { + my $princdata = $kadmin->makePrincipal ($principal); + my $attrs = $princdata->getAttributes; + $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; + $princdata->setAttributes ($attrs); + my $password = 'inactive'; + $kadmin->createPrincipal ($princdata, $password, 0); + $kadmin->randKeyPrincipal ($principal); + $kadmin->enablePrincipal ($principal); } - $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; - eval { $princdata->setAttributes ($attrs) }; - if ($@) { - $self->error ("error adding principal $principal: $@"); - return; - } - - my $password = 'inactive'; - my $test = eval { $kadmin->createPrincipal ($princdata, $password, 0) }; - eval { $kadmin->randKeyPrincipal ($principal) } unless $@; - eval { $kadmin->enablePrincipal ($principal) } unless $@; if ($@) { $self->error ("error adding principal $principal: $@"); return; @@ -156,8 +143,8 @@ sub ktadd { my $kadmin = $self->{client}; eval { $kadmin->randKeyPrincipal ($principal) }; if ($@) { - $self->error ("error creating keytab for $principal: could not " - ."reinit enctypes: $@"); + $self->error ("error creating keytab for $principal: could not" + . " reinit enctypes: $@"); return; } my $princdata = eval { $kadmin->getPrincipal ($principal) }; @@ -165,23 +152,22 @@ sub ktadd { $self->error ("error creating keytab for $principal: $@"); return; } elsif (!$princdata) { - $self->error ("error creating keytab for $principal: principal does " - ."not exist"); + $self->error ("error creating keytab for $principal: principal does" + . " not exist"); return; } # Now actually remove any non-requested enctypes, if we requested any. if (@enctypes) { - my (%wanted); - my $alltypes = $princdata->getKeytypes (); - foreach (@enctypes) { $wanted{$_} = 1 } - foreach my $key (@{$alltypes}) { - my $keytype = ${$key}[0]; + my $alltypes = $princdata->getKeytypes; + my %wanted = map { $_ => 1 } @enctypes; + for my $key (@{ $alltypes }) { + my $keytype = $key->[0]; next if exists $wanted{$keytype}; eval { $princdata->delKeytypes ($keytype) }; if ($@) { - $self->error ("error removing keytype $keytype from the ". - "keytab: $@"); + $self->error ("error removing keytype $keytype from the" + . " keytab: $@"); return; } } @@ -192,12 +178,12 @@ sub ktadd { } } + # Create the keytab. eval { $kadmin->extractKeytab ($princdata, $file) }; if ($@) { $self->error ("error creating keytab for principal: $@"); return; } - return 1; } @@ -226,20 +212,14 @@ sub delprinc { return 1; } -############################################################################## -# Documentation -############################################################################## - -# Create a new MIT kadmin object. Very empty for the moment, but later it -# will probably fill out if we go to using a module rather than calling -# kadmin directly. +# Create a new Heimdal kadmin object. sub new { my ($class) = @_; my $self = { client => undef, }; bless ($self, $class); - $self->{client} = kadmin_client (); + $self->{client} = $self->kadmin_client; return $self; } diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 22598f1..9fece80 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -497,7 +497,7 @@ sub create { if (not $kadmin->addprinc ($name)) { die $kadmin->error, "\n"; - } + } $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); $self->{kadmin} = $kadmin; return $self; diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 96b249b..18d452e 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -29,7 +29,7 @@ use Util; # We test a Wallet::Kadmin::* module's actual workings in the keytab.t tests. # The only things we want to test here are that each module is found, that -# Wallet::Kadmin itself delegates to them, and that the private MIT principal +# Wallet::Kadmin itself delegates to them, and that the private MIT principal # validation works as it should. for my $bad (qw{service\* = host/foo+bar host/foo/bar /bar bar/ rcmd.foo}) { @@ -44,7 +44,7 @@ for my $good (qw{service service/foo bar foo/bar host/example.org # Test creating an MIT object and seeing if the callback works. $Wallet::Config::KEYTAB_KRBTYPE = 'MIT'; -my $kadmin = Wallet::Kadmin->new (); +my $kadmin = Wallet::Kadmin->new; ok (defined ($kadmin), 'MIT kadmin object created'); my $callback = sub { return 1 }; $kadmin->fork_callback ($callback); @@ -64,6 +64,6 @@ SKIP: { undef $Wallet::Config::KEYTAB_REALM; undef $kadmin; $Wallet::Config::KEYTAB_KRBTYPE = 'Heimdal'; - $kadmin = eval { Wallet::Kadmin->new () }; + $kadmin = eval { Wallet::Kadmin->new }; is ($kadmin, undef, 'Heimdal fails properly.'); } diff --git a/perl/t/keytab.t b/perl/t/keytab.t index ab5b19d..d1d5ba6 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -220,7 +220,7 @@ SKIP: { if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { is ($@, "invalid principal name wallet\nf\n", ' with the right error'); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - like ($@, qr/^error adding principal wallet\nf/, + like ($@, qr/^error adding principal wallet\nf/, ' with the right error'); } $object = eval { diff --git a/server/wallet-admin b/server/wallet-admin index 761288d..cd775b6 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -158,7 +158,7 @@ used, the database may also have to be created in advance. =item list (acls | objects) [ [ ... ] ] -Returns a list of ACLs or objects in the database. ACLs will be listed +Returns a list of ACLs or objects in the database. ACLs will be listed in the form: (ACL ID: ) @@ -210,8 +210,8 @@ can be housekept. =item list acls entry -Returns all ACLs containing an entry with given schema and identifier. -The schema is used for an exact search, while the identifier given will +Returns all ACLs containing an entry with given schema and identifier. +The schema is used for an exact search, while the identifier given will match any identifier containing that text, for flexibility. =back -- cgit v1.2.3 From cbdc17af5f7a772188638f0057fffd357acbbd38 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:41:11 -0800 Subject: Use the long enctype name for aes256-cts-hmac-sha1-96 Heimdal requires the full name and doesn't support the short name that MIT has as an alias. Change the documentation to use the long name uniformly. --- client/wallet.pod | 6 +++--- perl/Wallet/Kadmin.pm | 2 +- perl/Wallet/Kadmin/Heimdal.pm | 16 ++++++++-------- perl/Wallet/Kadmin/MIT.pm | 14 ++++++++------ server/wallet-backend | 6 +++--- 5 files changed, 23 insertions(+), 21 deletions(-) (limited to 'server') diff --git a/client/wallet.pod b/client/wallet.pod index 6451e72..9908bb1 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -374,9 +374,9 @@ Keytab objects support the following attributes: Restricts the generated keytab to a specific set of encryption types. The values of this attribute must be enctype strings recognized by Kerberos -(strings like C or C). Note that the salt should -not be included; since the salt is irrelevant for keytab keys, it will -always be set to C by the wallet. +(strings like C or C). Note that +the salt should not be included; since the salt is irrelevant for keytab +keys, it will always be set to C by the wallet. If this attribute is set, the specified enctype list will be passed to ktadd when get() is called for that keytab. If it is not set, the default set in diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 5c01ee3..65ddf4b 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -63,7 +63,7 @@ Wallet::Kadmin - Kadmin module wrapper for wallet keytabs my $kadmin = Wallet::Kadmin->new (); $kadmin->addprinc ("host/shell.example.com"); - $kadmin->ktadd ("host/shell.example.com", "aes256-cts"); + $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96"); my $exists = $kadmin->exists ("host/oldshell.example.com"); $kadmin->delprinc ("host/oldshell.example.com") if $exists; diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 2ca8dcd..428202b 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -1,7 +1,7 @@ # Wallet::Kadmin::Heimdal -- Heimdal Kadmin interactions for the wallet. # # Written by Jon Robertson -# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -238,7 +238,7 @@ Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs my $kadmin = Wallet::Kadmin::MIT->new (); $kadmin->addprinc ("host/shell.example.com"); - $kadmin->ktadd ("host/shell.example.com", "aes256-cts"); + $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96"); my $exists = $kadmin->exists ("host/oldshell.example.com"); $kadmin->delprinc ("host/oldshell.example.com") if $exists; @@ -282,10 +282,11 @@ reality. =item ktadd(PRINCIPAL, FILE, ENCTYPES) -Creates a new keytab for the given principal, as the given file, limited to -the enctypes supplied. The enctype values must be enctype strings recognized -by Kerberos (strings like C or C). An error is -thrown on failure or if the creation fails, otherwise true is returned. +Creates a new keytab for the given principal, as the given file, limited +to the enctypes supplied. The enctype values must be enctype strings +recognized by Kerberos (strings like C or +C). An error is thrown on failure or if the creation fails, +otherwise true is returned. =back @@ -305,7 +306,6 @@ from L. =head1 AUTHORS -Russ Allbery -Jon Robertson +Russ Allbery and Jon Robertson . =cut diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index c3ad901..49691b0 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -2,7 +2,8 @@ # # Written by Russ Allbery # Pulled into a module by Jon Robertson -# Copyright 2007, 2008, 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2009, 2010 +# Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -233,7 +234,7 @@ Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs my $kadmin = Wallet::Kadmin::MIT->new (); $kadmin->addprinc ("host/shell.example.com"); - $kadmin->ktadd ("host/shell.example.com", "aes256-cts"); + $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96"); my $exists = $kadmin->exists ("host/oldshell.example.com"); $kadmin->delprinc ("host/oldshell.example.com") if $exists; @@ -277,10 +278,11 @@ reality. =item ktadd(PRINCIPAL, FILE, ENCTYPES) -Creates a new keytab for the given principal, as the given file, limited to -the enctypes supplied. The enctype values must be enctype strings recognized -by Kerberos (strings like C or C). An error is -thrown on failure or if the creation fails, otherwise true is returned. +Creates a new keytab for the given principal, as the given file, limited +to the enctypes supplied. The enctype values must be enctype strings +recognized by Kerberos (strings like C or +C). An error is thrown on failure or if the creation fails, +otherwise true is returned. =back diff --git a/server/wallet-backend b/server/wallet-backend index 448f175..2b58255 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -558,9 +558,9 @@ Keytab objects support the following attributes: Restricts the generated keytab to a specific set of encryption types. The values of this attribute must be enctype strings recognized by Kerberos -(strings like C or C). Note that the salt should -not be included; since the salt is irrelevant for keytab keys, it will -always be set to C by the wallet. +(strings like C or C). Note that +the salt should not be included; since the salt is irrelevant for keytab +keys, it will always be set to C by the wallet. If this attribute is set, the specified enctype list will be passed to ktadd when get() is called for that keytab. If it is not set, the default set in -- cgit v1.2.3 From 1ec1398452733d861b1b68253e6de0b8cb9f757f Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:42:01 -0800 Subject: Remove the sync documentation from wallet-backend The code to support the attribute is still present in case we add a system with which to synchronize later on. --- server/wallet-backend | 20 -------------------- 1 file changed, 20 deletions(-) (limited to 'server') diff --git a/server/wallet-backend b/server/wallet-backend index 2b58255..0770f97 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -571,26 +571,6 @@ Keytabs retrieved with C set will contain all keys present in the KDC for that Kerberos principal and therefore may contain different enctypes than those requested by this attribute. -=item sync - -Sets the external systems to which the key of a given principal is -synchronized. The only supported value for this attribute is C, -which says to synchronize the key with an AFS Kerberos v4 kaserver. - -If this attribute is set on a keytab, whenever the C command is run for -that keytab, the DES key will be extracted from that keytab and set in the -configured AFS kaserver. The Kerberos v4 principal name will be the same as -the Kerberos v5 principal name except that the components are separated by -C<.> instead of C; the second component is truncated after the first C<.> -if the first component is one of C, C, C, C, or -C; and the first component is C if the Kerberos v5 principal -component is C. The principal name must not contain more than two -components. - -If this attribute is set, calling C will also destroy the -principal from the AFS kaserver, with a principal mapping determined as -above. - =back =head1 SEE ALSO -- cgit v1.2.3 From 5d7f614e88bac459a693f1dcc91aad36ed3d00dd Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 23:57:10 -0800 Subject: Reorganize main POD tests and add a spelling check Add a POD spelling test to the non-Perl-module part of the code and move the documentation tests into a separate directory. Merge the POD syntax tests between client and server into one test. Reformat all of the POD documentation to use 74 columns. Fix a few revealed spelling errors or weird wordings. --- client/wallet.pod | 11 ++++--- server/keytab-backend | 64 +++++++++++++++++++----------------- server/wallet-admin | 17 ++++++---- server/wallet-backend | 83 +++++++++++++++++++++++++---------------------- tests/TESTS | 4 +-- tests/client/pod-t | 22 ------------- tests/docs/pod-spelling-t | 80 +++++++++++++++++++++++++++++++++++++++++++++ tests/docs/pod-t | 21 ++++++++++++ tests/server/pod-t | 22 ------------- 9 files changed, 200 insertions(+), 124 deletions(-) delete mode 100755 tests/client/pod-t create mode 100755 tests/docs/pod-spelling-t create mode 100755 tests/docs/pod-t delete mode 100755 tests/server/pod-t (limited to 'server') diff --git a/client/wallet.pod b/client/wallet.pod index 9908bb1..09fb571 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -2,6 +2,11 @@ wallet - Client for retrieving secure data from a central server +=for stopwords +-hv srvtab arg keytabs metadata keytab ACL PTS kinit klist remctl PKINIT +acl timestamp autocreate backend-specific setacl enctypes enctype ktadd +KDC appdefaults remctld Allbery nul uuencode getacl backend + =head1 SYNOPSIS B [B<-hv>] [B<-c> I] [B<-f> I] @@ -44,9 +49,7 @@ entries, each of which is a scheme and an identifier. A scheme specifies a way of checking whether a user is authorized. An identifier is some data specific to the scheme that specifies which users are authorized. For example, for the C scheme, the identifier is a principal name -and only that principal is authorized by that ACL entry. For the C -scheme, the identifier is a PTS group name, and all members of that PTS -group are authorized by that ACL entry. +and only that principal is authorized by that ACL entry. To run the wallet command-line client, you must already have a Kerberos ticket. You can obtain a Kerberos ticket with B and see your @@ -201,7 +204,7 @@ Display the history of the ACL . Each change to the ACL (not including changes to the name of the ACL) will be represented by two lines. The first line will have a timestamp of the change followed by a description of the change, and the second line will give the user who made -the change and the host from which the change was mde. +the change and the host from which the change was made. =item acl remove diff --git a/server/keytab-backend b/server/keytab-backend index b37fb3a..7b6adb4 100755 --- a/server/keytab-backend +++ b/server/keytab-backend @@ -17,7 +17,8 @@ # The keytab for the extracted principal will be printed to standard output. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2008, 2010 +# Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -155,6 +156,10 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytab-backend keytabs KDC keytab kadmin.local -norandkey ktadd remctld +auth Allbery rekeying + =head1 NAME keytab-backend - Extract keytabs from the KDC without changing the key @@ -165,27 +170,28 @@ B retrieve I =head1 DESCRIPTION -B retrieves a keytab for an existing principal from the KDC -database without changing the current key. It allows generation of a keytab -for a service without rekeying that service. It requires a B -patched to support the B<-norandkey> option to B. +B retrieves a keytab for an existing principal from the +KDC database without changing the current key. It allows generation of a +keytab for a service without rekeying that service. It requires a +B patched to support the B<-norandkey> option to B. -This script is intended to run under B. On success, it prints the -keytab to standard output, logs a success message to syslog (facility auth, -priority info), and exits with status 0. On failure, it prints out an error -message, logs an error to syslog (facility auth, priority err), and exits -with a non-zero status. +This script is intended to run under B. On success, it prints +the keytab to standard output, logs a success message to syslog (facility +auth, priority info), and exits with status 0. On failure, it prints out +an error message, logs an error to syslog (facility auth, priority err), +and exits with a non-zero status. The principal is checked for basic sanity (only accepting alphanumerics, -C<_>, and C<-> with an optional instance and then only alphanumerics, C<_>, -C<->, and C<.> in the realm) and then checked against a configuration file -that lists regexes of principals that can be retrieved. When deploying this -software, limit as tightly as possible which principals can be downloaded in -this fashion. Generally only shared service principals used on multiple -systems should be made available in this way. +C<_>, and C<-> with an optional instance and then only alphanumerics, +C<_>, C<->, and C<.> in the realm) and then checked against a +configuration file that lists regexes of principals that can be retrieved. +When deploying this software, limit as tightly as possible which +principals can be downloaded in this fashion. Generally only shared +service principals used on multiple systems should be made available in +this way. -B does not do any authorization checks. Those should be done -by B before it is called. +B does not do any authorization checks. Those should be +done by B before it is called. =head1 FILES @@ -193,19 +199,19 @@ by B before it is called. =item F -The configuration file that controls which principals can have their keytabs -retrieved. Blank lines and lines starting with C<#>, as well as anything -after C<#> on a line, are ignored. All other lines should be Perl regular -expressions, one per line, that match principals whose keytabs can be -retrieved by B. Any principal that does not match one of -those regular expressions cannot be retrieved. +The configuration file that controls which principals can have their +keytabs retrieved. Blank lines and lines starting with C<#>, as well as +anything after C<#> on a line, are ignored. All other lines should be +Perl regular expressions, one per line, that match principals whose +keytabs can be retrieved by B. Any principal that does +not match one of those regular expressions cannot be retrieved. =item F The temporary directory used for creating keytabs. B will -create the keytab in this directory, make sure that was successful, and then -delete the temporary file after the results have been sent to standard -output. +create the keytab in this directory, make sure that was successful, and +then delete the temporary file after the results have been sent to +standard output. =back @@ -213,8 +219,8 @@ output. kadmin.local(8), remctld(8) -This program is part of the wallet system. The current version is available -from L. +This program is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/server/wallet-admin b/server/wallet-admin index cd775b6..828cfc5 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -1,9 +1,9 @@ #!/usr/bin/perl -w # -# wallet-admin -- Wallet server administrative commands. +# wallet-backend -- Wallet server administrative commands. # # Written by Russ Allbery -# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -110,6 +110,9 @@ __END__ wallet-admin - Wallet server administrative commands +=for stopwords +metadata ACL hostname backend acl acls wildcard SQL Allbery + =head1 SYNOPSIS B I [I ...] @@ -171,8 +174,8 @@ be listed in the form: In both cases, there will be one line per ACL or object. -If no searchtype is given, all the ACLs or objects in the database will -be returned. If a searchtype (and possible search arguments) are given, +If no search type is given, all the ACLs or objects in the database will +be returned. If a search type (and possible search arguments) are given, then the ACLs or objects will be limited to those that match the search. The currently supported object search types are: @@ -206,7 +209,7 @@ The currently supported ACL search types are: =item list acls empty Returns all ACLs which have no entries, generally so that abandoned ACLs -can be housekept. +can be destroyed. =item list acls entry @@ -256,8 +259,8 @@ with duplicates suppressed. Wallet::Admin(3), Wallet::Config(3), wallet-backend(8) -This program is part of the wallet system. The current version is available -from L. +This program is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/server/wallet-backend b/server/wallet-backend index 0770f97..7780758 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -3,7 +3,7 @@ # wallet-backend -- Wallet server for storing and retrieving secure data. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -311,6 +311,11 @@ __END__ # The commands section of this document is duplicated from the documentation # for wallet and should be kept in sync. +=for stopwords +wallet-backend backend backend-specific remctld ACL acl timestamp getacl +setacl metadata nul keytab keytabs enctypes enctype ktadd KDC Allbery +autocreate + =head1 NAME wallet-backend - Wallet server for storing and retrieving secure data @@ -321,20 +326,22 @@ B [B<-q>] I [I ...] =head1 DESCRIPTION -B implements the interface between B and the wallet -system. It is written to run under B and expects the authenticated -identity of the remote user in the REMOTE_USER environment variable. It -uses REMOTE_HOST or REMOTE_ADDR if REMOTE_HOST isn't set for additional -trace information. It accepts the command from B on the command -line, creates a Wallet::Server object, and calls the appropriate methods. - -This program is a fairly thin wrapper around Wallet::Server that translates -command strings into method calls and returns the results. It does check -all arguments except for the argument to the store command and -rejects any argument not matching C<^[\w_/.-]+\z>; in other words, only -alphanumerics, underscore (C<_>), slash (C), period (C<.>), and hyphen -(C<->) are permitted in arguments. This provides some additional security -over and above the checking already done by the rest of the wallet code. +B implements the interface between B and the +wallet system. It is written to run under B and expects the +authenticated identity of the remote user in the REMOTE_USER environment +variable. It uses REMOTE_HOST or REMOTE_ADDR if REMOTE_HOST isn't set for +additional trace information. It accepts the command from B on +the command line, creates a Wallet::Server object, and calls the +appropriate methods. + +This program is a fairly thin wrapper around Wallet::Server that +translates command strings into method calls and returns the results. It +does check all arguments except for the argument to the store +command and rejects any argument not matching C<^[\w_/.-]+\z>; in other +words, only alphanumerics, underscore (C<_>), slash (C), period (C<.>), +and hyphen (C<->) are permitted in arguments. This provides some +additional security over and above the checking already done by the rest +of the wallet code. =head1 OPTIONS @@ -400,7 +407,7 @@ Display the history of the ACL . Each change to the ACL (not including changes to the name of the ACL) will be represented by two lines. The first line will have a timestamp of the change followed by a description of the change, and the second line will give the user who made -the change and the host from which the change was mde. +the change and the host from which the change was made. =item acl remove @@ -447,8 +454,8 @@ The expiration will be displayed in seconds since epoch. If is given, sets the expiration on the object identified by and to and (if given)