Add file object support to the wallet server.

9 files changed, 414 insertions, 14 deletions

diff --git a/Makefile.am b/Makefile.am
index a59c119..91f4dd8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -16,10 +16,10 @@ EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \
 	perl/Wallet/ACL/Krb5.pm perl/Wallet/ACL/NetDB.pm \
 	perl/Wallet/ACL/NetDB/Root.pm perl/Wallet/Admin.pm \
 	perl/Wallet/Config.pm perl/Wallet/Database.pm \
-	perl/Wallet/Object/Base.pm perl/Wallet/Object/Keytab.pm \
-	perl/Wallet/Schema.pm perl/Wallet/Server.pm perl/t/acl.t \
-	perl/t/admin.t perl/t/config.t perl/t/data/README \
-	perl/t/data/keytab-fake perl/t/data/keytab.conf \
+	perl/Wallet/Object/Base.pm perl/Wallet/Object/File.pm \
+	perl/Wallet/Object/Keytab.pm perl/Wallet/Schema.pm \
+	perl/Wallet/Server.pm perl/t/acl.t perl/t/admin.t perl/t/config.t \
+	perl/t/data/README perl/t/data/keytab-fake perl/t/data/keytab.conf \
 	perl/t/data/netdb.conf perl/t/data/netdb-fake perl/t/init.t \
 	perl/t/keytab.t perl/t/lib/Util.pm perl/t/object.t perl/t/pod.t \
 	perl/t/schema.t perl/t/server.t perl/t/verifier-netdb.t \
diff --git a/NEWS b/NEWS
index 37d73a7..110ca37 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,8 @@ wallet 0.8 (unreleased)
 
     Fix the wallet client to use check instead of exists.
 
+    Add file object support to the wallet server.
+
     Wallet::Config and hence the wallet server now checks for the
     environment variable WALLET_CONFIG and loads configuration from the
     file specified there instead of /etc/wallet/wallet.conf if it is set.
diff --git a/README b/README
index 11918af..d204416 100644
--- a/README
+++ b/README
@@ -84,6 +84,10 @@ REQUIREMENTS
   translates the actions in that protocol into calls to the Wallet::Server
   Perl object.
 
+  The file object support in the wallet server requires the Digest::MD5
+  Perl module, which comes with recent versions of Perl and is available
+  on CPAN for older versions.
+
   The keytab support in the wallet server requires the kadmin client
   program be installed and currently assumes that it follows the syntax of
   the MIT Kerberos kadmin client.  It also requires that the wallet server
diff --git a/TODO b/TODO
index a2d7744..892c231 100644
--- a/TODO
+++ b/TODO
@@ -48,9 +48,6 @@ Release 1.0:
   underlying remctl support, may have to ban nul characters in the
   uploaded data.
 
-* Implement a simple file wallet object.  Document a naming convention for
-  those files (group-service, perhaps).
-
 * Write the LDAP entitlement ACL verifier.
 
 * Write the PTS ACL verifier.
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;