summaryrefslogtreecommitdiff
path: root/perl
diff options
context:
space:
mode:
Diffstat (limited to 'perl')
-rw-r--r--perl/Wallet/Config.pm61
-rw-r--r--perl/Wallet/Object/WAKeyring.pm249
2 files changed, 310 insertions, 0 deletions
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index 3f53f74..1a74506 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -378,6 +378,67 @@ our $KEYTAB_REMCTL_PORT;
=back
+=head1 WEBAUTH KEYRING OBJECT CONFIGURATION
+
+These configuration variables only need to be set if you intend to use the
+C<wakeyring> object type (the Wallet::Object::WAKeyring class).
+
+=over 4
+
+=item WAKEYRING_BUCKET
+
+The directory into which to store WebAuth keyring objects. WebAuth
+keyring objects will be stored in subdirectories of this directory. See
+L<Wallet::Object::WAKeyring> 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.
+
+WAKEYRING_BUCKET must be set to use file objects.
+
+=cut
+
+our $WAKEYRING_BUCKET;
+
+=item WAKEYRING_REKEY_INTERVAL
+
+The interval, in seconds, at which new keys are generated in a keyring.
+The object implementation will try to arrange for there to be keys added
+to the keyring separated by this interval.
+
+It's useful to provide some interval to install the keyring everywhere
+that it's used before the key becomes inactive. Every keyring will
+therefore normally have at least three keys: one that's currently active,
+one that becomes valid in the future but less than
+WAKEYRING_REKEY_INTERVAL from now, and one that becomes valid between one
+and two of those intervals into the future. This means that one has twice
+this interval to distribute the keyring everywhere it is used.
+
+Internally, this is implemented by adding a new key that becomes valid in
+twice this interval from the current time if the newest key becomes valid
+at or less than this interval in the future.
+
+The default value is 60 * 60 * 24 (one day).
+
+=cut
+
+our $WAKEYRING_REKEY_INTERVAL = 60 * 60 * 24;
+
+=item WAKEYRING_PURGE_INTERVAL
+
+The interval, in seconds, from the key creation date after which keys are
+removed from the keyring. This is used to clean up old keys and finish
+key rotation. Keys won't be removed unless there are more than three keys
+in the keyring to try to keep a misconfiguration from removing all valid
+keys.
+
+The default value is 60 * 60 * 24 * 90 (90 days).
+
+=cut
+
+our $WAKEYRING_PURGE_INTERVAL = 60 * 60 * 24 * 90;
+
+=back
+
=head1 LDAP ACL CONFIGURATION
These configuration variables are only needed if you intend to use the
diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm
new file mode 100644
index 0000000..20d3047
--- /dev/null
+++ b/perl/Wallet/Object/WAKeyring.pm
@@ -0,0 +1,249 @@
+# Wallet::Object::WAKeyring -- WebAuth keyring object implementation.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2012
+# The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package Wallet::Object::WAKeyring;
+require 5.006;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+use Digest::MD5 qw(md5_hex);
+use Fcntl qw(LOCK_EX);
+use Wallet::Config ();
+use Wallet::Object::Base;
+use WebAuth qw(WA_KEY_AES WA_AES_128);
+
+@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 keyring 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::WAKEYRING_BUCKET) {
+ $self->error ('WebAuth keyring support not configured');
+ return;
+ }
+ unless ($name) {
+ $self->error ('WebAuth keyring 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::WAKEYRING_BUCKET/$hash";
+ unless (-d $parent || mkdir ($parent, 0700)) {
+ $self->error ("cannot create file bucket $hash: $!");
+ return;
+ }
+ return "$Wallet::Config::WAKEYRING_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);
+}
+
+# Update the keyring if needed, and then return the contents of the current
+# keyring.
+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;
+
+ # Create a WebAuth context and ensure we can load the relevant modules.
+ my $wa = eval { WebAuth->new };
+ if ($@) {
+ $self->error ("cannot initialize WebAuth: $@");
+ return;
+ }
+
+ # Check if the keyring already exists. If not, create a new one with a
+ # single key that's immediately valid and two more that will become valid
+ # in the future.
+ #
+ # If the keyring does already exist, get a lock on the file. At the end
+ # of this process, we'll do an atomic update and then drop our lock.
+ #
+ # FIXME: There are probably better ways to do this. There are some race
+ # conditions here, particularly with new keyrings.
+ unless (open (FILE, '+<', $path)) {
+ my $data;
+ eval {
+ my $key = $wa->key_create (WA_KEY_AES, WA_AES_128);
+ my $ring = $wa->keyring_new ($key);
+ $key = $wa->key_create (WA_KEY_AES, WA_AES_128);
+ my $valid = time + $Wallet::Config::WAKEYRING_REKEY_INTERVAL;
+ $ring->add (time, $valid, $key);
+ $key = $wa->key_create (WA_KEY_AES, WA_AES_128);
+ $valid += $Wallet::Config::WAKEYRING_REKEY_INTERVAL;
+ $ring->add (time, $valid, $key);
+ $data = $ring->encode;
+ $ring->write ($path);
+ };
+ if ($@) {
+ $self->error ("cannot create new keyring");
+ return;
+ };
+ $self->log_action ('get', $user, $host, $time);
+ return $data;
+ }
+ unless (flock (FILE, LOCK_EX)) {
+ $self->error ("cannot get lock on keyring: $!");
+ return;
+ }
+
+ # Read the keyring.
+ my $ring = eval { WebAuth::Keyring->read ($path) };
+ if ($@) {
+ $self->error ("cannot read keyring: $@");
+ return;
+ }
+
+ # If the most recent key has a valid-after older than now +
+ # WAKEYRING_REKEY_INTERVAL, we generate a new key with a valid_after of
+ # now + 2 * WAKEYRING_REKEY_INTERVAL.
+ my ($count, $newest) = (0, 0);
+ for my $entry ($ring->entries) {
+ $count++;
+ if ($entry->valid_after > $newest) {
+ $newest = $entry->valid_after;
+ }
+ }
+ eval {
+ if ($newest <= time + $Wallet::Config::WAKEYRING_REKEY_INTERVAL) {
+ my $valid = time + 2 * $Wallet::Config::WAKEYRING_REKEY_INTERVAL;
+ my $key = $wa->key_create (WA_KEY_AES, WA_AES_128);
+ $ring->add (time, $valid, $key);
+ }
+ };
+ if ($@) {
+ $self->error ("cannot add new key: $@");
+ return;
+ }
+
+ # If there are any keys older than the purge interval, remove them, but
+ # only do so if we have more than three keys (the one that's currently
+ # active, the one that's going to come active in the rekey interval, and
+ # the one that's going to come active after that.
+ my $cutoff = time - $Wallet::Config::WAKEYRING_PURGE_INTERVAL;
+ my $i = 0;
+ my @purge;
+ if ($count > 3) {
+ for my $entry ($ring->entries) {
+ if ($entry->creation < $cutoff) {
+ push (@purge, $i);
+ }
+ $i++;
+ }
+ }
+ if (@purge) {
+ eval {
+ for my $key (reverse @purge) {
+ $ring->remove ($key);
+ }
+ };
+ if ($@) {
+ $self->error ("cannot remove old keys: $@");
+ return;
+ }
+ }
+
+ # Encode the key.
+ my $data = eval { $ring->encode };
+ if ($@) {
+ $self->error ("cannot encode keyring: $@");
+ return;
+ }
+
+ # Write the new keyring to the path.
+ eval { $ring->write ($path) };
+ if ($@) {
+ $self->error ("cannot store new keyring: $@");
+ return;
+ }
+ close FILE;
+ $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;
+ }
+ if ($Wallet::Config::FILE_MAX_SIZE) {
+ my $max = $Wallet::Config::FILE_MAX_SIZE;
+ if (length ($data) > $max) {
+ $self->error ("data exceeds maximum of $max bytes");
+ 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::WAKeyring - WebAuth keyring object implementation for wallet
+
+=head1 DESCRIPTION
+
+To be written.
+
+=cut
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 06:28:45 +0000