diff options
Diffstat (limited to 'perl/lib/Wallet/Admin.pm')
| -rw-r--r-- | perl/lib/Wallet/Admin.pm | 389 |
1 files changed, 389 insertions, 0 deletions
diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm new file mode 100644 index 0000000..8481979 --- /dev/null +++ b/perl/lib/Wallet/Admin.pm @@ -0,0 +1,389 @@ +# Wallet::Admin -- Wallet system administrative interface. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Admin; +require 5.006; + +use strict; +use warnings; +use vars qw($VERSION); + +use Wallet::ACL; +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.07'; + +# The last non-DBIx::Class version of Wallet::Schema. If a database has no +# DBIx::Class versioning, we artificially install this version number before +# starting the upgrade process so that the automated DBIx::Class upgrade will +# work properly. +our $BASE_VERSION = '0.07'; + +############################################################################## +# Constructor, destructor, and accessors +############################################################################## + +# Create a new wallet administrator object. Opens a connection to the +# database that will be used for all of the wallet configuration information. +# Throw an exception if anything goes wrong. +sub new { + my ($class) = @_; + my $schema = Wallet::Schema->connect; + my $self = { schema => $schema }; + bless ($self, $class); + return $self; +} + +# Returns the database handle (used mostly for testing). +sub dbh { + my ($self) = @_; + return $self->{schema}->storage->dbh; +} + +# Returns the DBIx::Class-based database schema object. +sub schema { + my ($self) = @_; + return $self->{schema}; +} + +# Set or return the error stashed in the object. +sub error { + my ($self, @error) = @_; + if (@error) { + my $error = join ('', @error); + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + $self->{error} = $error; + } + return $self->{error}; +} + +# Disconnect the database handle on object destruction to avoid warnings. +sub DESTROY { + my ($self) = @_; + $self->{schema}->storage->dbh->disconnect; +} + +############################################################################## +# Database initialization +############################################################################## + +# Initializes the database by populating it with our schema and then creates +# and returns a new wallet server object. This is used only for initial +# database creation. Takes the Kerberos principal who will be the default +# administrator so that we can create an initial administrator ACL. Returns +# true on success and false on failure, setting the object error. +sub initialize { + my ($self, $user) = @_; + + # Deploy the database schema from DDL files, if they exist. If not then + # we automatically get the database from the Schema modules. + $self->{schema}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY); + if ($@) { + $self->error ($@); + return; + } + $self->default_data; + + # Create a default admin ACL. + eval { + my $guard = $self->{schema}->txn_scope_guard; + $self->{schema}->resultset ('Acl')->populate ([ + [ qw/ac_id ac_name/ ], + [ 1, 'ADMIN' ], + ]); + $self->{schema}->resultset ('AclEntry')->populate ([ + [ qw/ae_id ae_scheme ae_identifier/ ], + [ 1, 'krb5', $user ], + ]); + $guard->commit; + }; + if ($@) { + $self->error ("cannot add ADMIN ACL: $@"); + return; + } + return 1; +} + +# Load default data into various tables. We'd like to do this more directly +# in the schema definitions, but not yet seeing a good way to do that. +sub default_data { + my ($self) = @_; + + # acl_schemes default rows. + my ($r1) = $self->{schema}->resultset('AclScheme')->populate ([ + [ qw/as_name as_class/ ], + [ 'krb5', 'Wallet::ACL::Krb5' ], + [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], + [ 'ldap-attr', 'Wallet::ACL::LDAP::Attribute' ], + [ 'netdb', 'Wallet::ACL::NetDB' ], + [ 'netdb-root', 'Wallet::ACL::NetDB::Root' ], + ]); + warn "default AclScheme not installed" unless defined $r1; + + # types default rows. + my @record = ([ qw/ty_name ty_class/ ], + [ 'file', 'Wallet::Object::File' ], + [ 'keytab', 'Wallet::Object::Keytab' ], + [ 'wa-keyring', 'Wallet::Object::WAKeyring' ]); + ($r1) = $self->{schema}->resultset('Type')->populate (\@record); + warn "default Type not installed" unless defined $r1; + + # enctypes default rows. + @record = ([ qw/en_name/ ], + [ 'aes128-cts-hmac-sha1-96' ], + [ 'aes256-cts-hmac-sha1-96' ], + [ 'arcfour-hmac-md5' ], + [ 'des-cbc-crc' ], + [ 'des3-cbc-sha1' ]); + ($r1) = $self->{schema}->resultset('Enctype')->populate (\@record); + warn "default Enctype not installed" unless defined $r1; + + return 1; +} + +# The same as initialize, but also drops any existing tables first before +# creating the schema. Takes the same arguments. Returns true on success and +# false on failure. +sub reinitialize { + my ($self, $user) = @_; + return unless $self->destroy; + return $self->initialize ($user); +} + +# Drop the database, including all of its data. Returns true on success and +# false on failure. +sub destroy { + my ($self) = @_; + + # Get an actual DBI handle and use it to delete all tables. + my $dbh = $self->dbh; + my @tables = qw/acl_entries object_history objects acls acl_history + acl_schemes enctypes flags keytab_enctypes keytab_sync sync_targets + duo types dbix_class_schema_versions/; + for my $table (@tables) { + my $sql = "DROP TABLE IF EXISTS $table"; + $dbh->do ($sql); + } + + return 1; +} + +# Save a DDL of the database in every supported database server. Returns +# true on success and false on failure. +sub backup { + my ($self, $oldversion) = @_; + + my @dbs = qw/MySQL SQLite PostgreSQL/; + my $version = $Wallet::Schema::VERSION; + $self->{schema}->create_ddl_dir (\@dbs, $version, + $Wallet::Config::DB_DDL_DIRECTORY, + $oldversion); + + return 1; +} + +# Upgrade the database to the latest schema version. Returns true on success +# and false on failure. +sub upgrade { + my ($self) = @_; + + # Check to see if the database is versioned. If not, install the + # versioning table and default version. + if (!$self->{schema}->get_db_version) { + $self->{schema}->install ($BASE_VERSION); + } + + # Suppress warnings that actually are just informational messages. + local $SIG{__WARN__} = sub { + my ($warn) = @_; + return if $warn =~ m{Upgrade not necessary}; + return if $warn =~ m{Attempting upgrade}; + warn $warn; + }; + + # Perform the actual upgrade. + if ($self->{schema}->get_db_version) { + $self->{schema}->upgrade_directory ($Wallet::Config::DB_DDL_DIRECTORY); + eval { $self->{schema}->upgrade; }; + } + if ($@) { + $self->error ($@); + return; + } + + return 1; +} + +############################################################################## +# Object registration +############################################################################## + +# Given an object type and class name, add a new class mapping to that +# database for the given object type. This is used to register new object +# types. Returns true on success, false on failure, and sets the internal +# error on failure. +sub register_object { + my ($self, $type, $class) = @_; + eval { + my $guard = $self->{schema}->txn_scope_guard; + my %record = (ty_name => $type, + ty_class => $class); + $self->{schema}->resultset('Type')->create (\%record); + $guard->commit; + }; + if ($@) { + $self->error ("cannot register $class for $type: $@"); + return; + } + return 1; +} + +# Given an ACL verifier scheme and class name, add a new class mapping to that +# database for the given ACL verifier scheme. This is used to register new +# ACL schemes. Returns true on success, false on failure, and sets the +# internal error on failure. +sub register_verifier { + my ($self, $scheme, $class) = @_; + eval { + my $guard = $self->{schema}->txn_scope_guard; + my %record = (as_name => $scheme, + as_class => $class); + $self->{schema}->resultset('AclScheme')->create (\%record); + $guard->commit; + }; + if ($@) { + $self->error ("cannot register $class for $scheme: $@"); + return; + } + return 1; +} + +1; +__DATA__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Admin - Wallet system administrative interface + +=for stopwords +ACL hostname Allbery verifier + +=head1 SYNOPSIS + + use Wallet::Admin; + my $admin = Wallet::Admin->new; + unless ($admin->initialize ('user/admin@EXAMPLE.COM')) { + die $admin->error; + } + +=head1 DESCRIPTION + +Wallet::Admin implements the administrative interface to the wallet server +and database. It is normally instantiated and used by B<wallet-admin>, a +thin wrapper around this object that provides a command-line interface to +its actions. + +To use this object, several configuration variables must be set (at least +the database configuration). For information on those variables and how +to set them, see L<Wallet::Config>. For more information on the normal +user interface to the wallet server, see L<Wallet::Server>. + +=head1 CLASS METHODS + +=over 4 + +=item new() + +Creates a new wallet administrative object and connects to the database. +On any error, this method throws an exception. + +=back + +=head1 INSTANCE METHODS + +For all methods that can fail, the caller should call error() after a +failure to get the error message. + +=over 4 + +=item destroy () + +Destroys the database, deleting all of its data and all of the tables used +by the wallet server. Returns true on success and false on failure. + +=item error () + +Returns the error of the last failing operation or undef if no operations +have failed. Callers should call this function to get the error message +after an undef return from any other instance method. + +=item initialize(PRINCIPAL) + +Initializes the database as configured in Wallet::Config and loads the +wallet database schema. Then, creates an ACL with the name ADMIN and adds +an ACL entry of scheme C<krb5> and instance PRINCIPAL to that ACL. This +bootstraps the authorization system and lets that Kerberos identity make +further changes to the ADMIN ACL and the rest of the wallet database. +Returns true on success and false on failure. + +initialize() uses C<localhost> 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 register_object (TYPE, CLASS) + +Register in the database a mapping from the object type TYPE to the class +CLASS. Returns true on success and false on failure (including when the +verifier is already registered). + +=item register_verifier (SCHEME, CLASS) + +Register in the database a mapping from the ACL scheme SCHEME to the class +CLASS. Returns true on success and false on failure (including when the +verifier is already registered). + +=item reinitialize (PRINCIPAL) + +Performs the same actions as initialize(), but first drops any existing +wallet database tables from the database, allowing this function to be +called on a prior wallet database. All data stored in the database will +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 upgrade () + +Upgrades the database to the latest schema version, preserving data as +much as possible. Returns true on success and false on failure. + +=back + +=head1 SEE ALSO + +wallet-admin(8) + +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. + +=head1 AUTHOR + +Russ Allbery <eagle@eyrie.org> + +=cut |