diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/Config.pm | 37 | ||||
| -rw-r--r-- | perl/Wallet/Object/File.pm | 232 | ||||
| -rw-r--r-- | perl/Wallet/Schema.pm | 6 | ||||
| -rwxr-xr-x | perl/t/file.t | 132 | ||||
| -rwxr-xr-x | perl/t/schema.t | 4 |
5 files changed, 404 insertions, 7 deletions
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 735e799..6c72781 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -163,12 +163,43 @@ our $DB_PASSWORD; =back +=head1 FILE OBJECT CONFIGURATION + +These configuration variables only need to be set if you intend to use the +C<file> object type (the Wallet::Object::File class). + +=over 4 + +=item FILE_BUCKET + +The directory into which to store file objects. File objects will be +stored in subdirectories of this directory. See Wallet::Object::File(3) +for the full details of the naming scheme. This directory must be +writable by the wallet server and the wallet server must be able to create +subdirectories of it. + +FILE_BUCKET must be set to use file objects. + +=cut + +our $FILE_BUCKET; + +=item FILE_MAX_SIZE + +The maximum size of data that can be stored in a file object in bytes. If +this configuration variable is set, an attempt to store data larger than +this limit will be rejected. + +=cut + +our $FILE_MAX_SIZE; + +=back + =head1 KEYTAB OBJECT CONFIGURATION These configuration variables only need to be set if you intend to use the -C<keytab> object type (the Wallet::Object::Keytab class). They point the -keytab object implementation at the right Kerberos server and B<kadmin> -client. +C<keytab> object type (the Wallet::Object::Keytab class). =over 4 diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm new file mode 100644 index 0000000..2b18bb2 --- /dev/null +++ b/perl/Wallet/Object/File.pm @@ -0,0 +1,232 @@ +# Wallet::Object::File -- File object implementation for the wallet. +# $Id$ +# +# Written by Russ Allbery <rra@stanford.edu> +# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Object::File; +require 5.006; + +use strict; +use vars qw(@ISA $VERSION); + +use Digest::MD5 qw(md5_hex); +use Wallet::Config (); +use Wallet::Object::Base; + +@ISA = qw(Wallet::Object::Base); + +# 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.01'; + +############################################################################## +# File naming +############################################################################## + +# Returns the path into which that file object will be stored or undef on +# error. On error, sets the internal error. +sub file_path { + my ($self) = @_; + my $name = $self->{name}; + unless ($Wallet::Config::FILE_BUCKET) { + $self->error ('file support not configured'); + return; + } + unless ($name) { + $self->error ('file objects may not have empty names'); + return; + } + my $hash = substr (md5_hex ($name), 0, 2); + $name =~ s/([^\w-])/sprintf ('%%%02X', ord ($1))/ge; + my $parent = "$Wallet::Config::FILE_BUCKET/$hash"; + unless (-d $parent || mkdir ($parent, 0700)) { + $self->error ("cannot create file bucket $hash: $!"); + return; + } + return "$Wallet::Config::FILE_BUCKET/$hash/$name"; +} + +############################################################################## +# Core methods +############################################################################## + +# Override destroy to delete the file as well. +sub destroy { + my ($self, $user, $host, $time) = @_; + my $id = $self->{type} . ':' . $self->{name}; + my $path = $self->file_path; + if (defined ($path) && -f $path && !unlink ($path)) { + $self->error ("cannot delete $id: $!"); + return; + } + return $self->SUPER::destroy ($user, $host, $time); +} + +# Return the contents of the file. +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 $path = $self->file_path; + return unless $path; + unless (open (FILE, '<', $path)) { + $self->error ("cannot get $id: object has not been stored"); + return; + } + local $/; + my $data = <FILE>; + unless (close FILE) { + $self->error ("cannot get $id: $!"); + return; + } + $self->log_action ('get', $user, $host, $time); + return $data; +} + +# Store the file on the wallet server. +sub store { + my ($self, $data, $user, $host, $time) = @_; + $time ||= time; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot store $id: object is locked"); + return; + } + my $path = $self->file_path; + return unless $path; + unless (open (FILE, '>', $path)) { + $self->error ("cannot store $id: $!"); + return; + } + unless (print FILE ($data) and close FILE) { + $self->error ("cannot store $id: $!"); + close FILE; + return; + } + $self->log_action ('store', $user, $host, $time); + return 1; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Object::File - File object implementation for wallet + +=head1 SYNOPSIS + + my @name = qw(file mysql-lsdb) + my @trace = ($user, $host, time); + my $object = Wallet::Object::Keytab->create (@name, $dbh, @trace); + unless ($object->store ("the-password\n")) { + die $object->error, "\n"; + } + my $password = $object->get (@trace); + $object->destroy (@trace); + +=head1 DESCRIPTION + +Wallet::Object::File is a representation of simple file objects in the +wallet. It implements the wallet object API and provides the necessary +glue to store a file on the wallet server, retrieve it later, and delete +it when the file object is deleted. A file object must be stored before +it can be retrieved with get. + +To use this object, the configuration option specifying where on the +wallet server to store file objects must be set. See Wallet::Config(3) +for details on this configuration parameter and information about how to +set wallet configuration. + +=head1 METHODS + +This object mostly inherits from Wallet::Object::Base. See the +documentation for that class for all generic methods. Below are only those +methods that are overridden or behave specially for this implementation. + +=over 4 + +=item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) + +Destroys a file object by removing it from the database and deleting the +corresonding file on the wallet server. Returns true on success and false +on failure. The caller should call error() to get the error message after +a failure. PRINCIPAL, HOSTNAME, and DATETIME are stored as history +information. PRINCIPAL should be the user who is destroying the object. +If DATETIME isn't given, the current time is used. + +=item get(PRINCIPAL, HOSTNAME [, DATETIME]) + +Retrieves the current contents of the file object or undef on error. +store() must be called before get() will be successful. The caller should +call error() to get the error message if get() returns undef. PRINCIPAL, +HOSTNAME, and DATETIME are stored as history information. PRINCIPAL +should be the user who is downloading the keytab. If DATETIME isn't +given, the current time is used. + +=item store(DATA, PRINCIPAL, HOSTNAME [, DATETIME]) + +Store DATA as the current contents of the file object. Any existing data +will be overwritten. Returns true on success and false on failure. The +caller should call error() to get the error message after a failure. +PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. +PRINCIPAL should be the user who is destroying the object. If DATETIME +isn't given, the current time is used. + +If FILE_MAX_SIZE is set in the wallet configuration, a store() of DATA +larger than that configuration setting will be rejected. + +=back + +=head1 FILES + +=over 4 + +=item FILE_BUCKET/<hash>/<file> + +Files are stored on the wallet server under the directory FILE_BUCKET as +set in the wallet configuration. <hash> is the first two characters of +the hex-encoded MD5 hash of the wallet file object name, used to not put +too many files in the same directory. <file> is the name of the file +object with all characters other than alphanumerics, underscores, and +dashes replaced by C<%> and the hex code of the character. + +=back + +=head1 LIMITATIONS + +The wallet implementation itself can handle arbitrary file object names +and arbitrary content. However, due to limitations in the B<remctld> +server usually used to run B<wallet-backend>, file object names and +contents containing nul characters (ASCII 0) may not be permitted. The +file system used for storing file objects may impose a length limitation +on the file object name. + +=head1 SEE ALSO + +remctld(8), Wallet::Config(3), Wallet::Object::Base(3), wallet-backend(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 <rra@stanford.edu> + +=cut diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 2f62da7..5fb6618 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -2,7 +2,7 @@ # $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -21,7 +21,7 @@ use DBI; # 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'; ############################################################################## # Data manipulation @@ -261,6 +261,8 @@ Holds the supported object types and their corresponding Perl classes: (ty_name varchar(16) primary key, ty_class varchar(64)); insert into types (ty_name, ty_class) + values ('file', 'Wallet::Object::File'); + insert into types (ty_name, ty_class) values ('keytab', 'Wallet::Object::Keytab'); Holds the supported ACL schemes and their corresponding Perl classes: diff --git a/perl/t/file.t b/perl/t/file.t new file mode 100755 index 0000000..8783d7b --- /dev/null +++ b/perl/t/file.t @@ -0,0 +1,132 @@ +#!/usr/bin/perl -w +# $Id$ +# +# t/file.t -- Tests for the file object implementation. +# +# Written by Russ Allbery <rra@stanford.edu> +# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use POSIX qw(strftime); +use Test::More tests => 50; + +use Wallet::Admin; +use Wallet::Config; +use Wallet::Object::File; + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $user = 'admin@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($user, $host, time); + +# Flush all output immediately. +$| = 1; + +# Use Wallet::Admin to set up the database. +system ('rm -rf test-files') == 0 or die "cannot remove test-files\n"; +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); +my $dbh = $admin->dbh; + +# Use this to accumulate the history traces so that we can check history. +my $history = ''; +my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); + +# Test error handling in the absence of configuration. +$object = eval { + Wallet::Object::File->create ('file', 'test', $dbh, @trace) + }; +ok (defined ($object), 'Creating a basic file object succeeds'); +ok ($object->isa ('Wallet::Object::File'), ' and is the right class'); +is ($object->get (@trace), undef, ' and get fails'); +is ($object->error, 'file support not configured', ' with the right error'); +is ($object->store (@trace), undef, ' and store fails'); +is ($object->error, 'file support not configured', ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroy succeeds'); + +# Set up our configuration. +mkdir 'test-files' or die "cannot create test-files: $!\n"; +$Wallet::Config::FILE_BUCKET = 'test-files'; + +# Okay, now we can test. First, the basic object without store. +$object = eval { + Wallet::Object::File->create ('file', 'test', $dbh, @trace) + }; +ok (defined ($object), 'Creating a basic file object succeeds'); +ok ($object->isa ('Wallet::Object::File'), ' and is the right class'); +is ($object->get (@trace), undef, ' and get fails'); +is ($object->error, 'cannot get file:test: object has not been stored', + ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroying the object succeeds'); + +# Now store something and be sure that we get something reasonable. +$object = eval { + Wallet::Object::File->create ('file', 'test', $dbh, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); +ok (-d 'test-files/09', ' and the hash bucket was created'); +ok (-f 'test-files/09/test', ' and the file exists'); +is (contents ('test-files/09/test'), 'foo', ' with the right contents'); +is ($object->get (@trace), "foo\n", ' and get returns correctly'); +unlink 'test-files/09/test'; +is ($object->get (@trace), undef, ' and get fails if we delete it'); +is ($object->error, 'cannot get file:test: object has not been stored', + ' as if it had not been stored'); +is ($object->store ("bar\n\0baz\n", @trace), 1, ' but storing again works'); +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'); +is ($object->destroy (@trace), 1, 'Destroying the object works'); +ok (! -f 'test-files/09/test', ' and the file is gone'); + +# Now try some aggressive names. +$object = eval { + Wallet::Object::File->create ('file', '../foo', $dbh, @trace) + }; +ok (defined ($object), 'Creating ../foo succeeds'); +is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); +ok (-d 'test-files/39', ' and the hash bucket was created'); +ok (-f 'test-files/39/%2E%2E%2Ffoo', ' and the file exists'); +is (contents ('test-files/39/%2E%2E%2Ffoo'), 'foo', + ' with the right contents'); +is ($object->get (@trace), "foo\n", ' and get returns correctly'); +is ($object->destroy (@trace), 1, 'Destroying the object works'); +ok (! -f 'test-files/39/%2E%2E%2Ffoo', ' and the file is gone'); +$object = eval { + Wallet::Object::File->create ('file', "\0", $dbh, @trace) + }; +ok (defined ($object), 'Creating nul succeeds'); +is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); +ok (-d 'test-files/93', ' and the hash bucket was created'); +ok (-f 'test-files/93/%00', ' and the file exists'); +is (contents ('test-files/93/%00'), 'foo', + ' with the right contents'); +is ($object->get (@trace), "foo\n", ' and get returns correctly'); +is ($object->destroy (@trace), 1, 'Destroying the object works'); +ok (! -f 'test-files/93/%00', ' and the file is gone'); + +# Test error handling in the file store. +system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; +$object = eval { + Wallet::Object::File->create ('file', 'test', $dbh, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +is ($object->store ("foo\n", @trace), undef, + ' and storing data in it fails'); +like ($object->error, qr/^cannot create file bucket 09: /, + ' with the right error'); +is ($object->get (@trace), undef, ' and get fails'); +like ($object->error, qr/^cannot create file bucket 09: /, + ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroying the object succeeds'); + +# Clean up. +$admin->destroy; +unlink ('wallet-db'); diff --git a/perl/t/schema.t b/perl/t/schema.t index 8ee8a02..c7e9133 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -4,7 +4,7 @@ # t/schema.t -- Tests for the wallet schema class. # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -22,7 +22,7 @@ ok (defined $schema, 'Wallet::Schema creation'); ok ($schema->isa ('Wallet::Schema'), ' and class verification'); my @sql = $schema->sql; ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 28, ' and returns the right number of statements'); +is (scalar (@sql), 29, ' and returns the right number of statements'); # Connect to a database and test create. db_setup; |