1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
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
|
