8a3a76e0d0
Done in the _write routine, which means tokens will not expire the exact moment they should, but the first transaction after that. And if that transaction is done by the user, they're in luck as expiry checking happens after using them tokens.
270 lines
7.6 KiB
Perl
270 lines
7.6 KiB
Perl
#!perl
|
|
|
|
use List::Util;
|
|
|
|
HELP void => "Destroy deposit tokens";
|
|
|
|
my $ttl = 100 * 86400; # expiry time in seconds
|
|
my $filename = "revbank.statiegeld";
|
|
|
|
# Token format: token_type,time,expiry_time,product_id,transaction_id,seq
|
|
# - token_type (also just "type") is the id of the product addon.
|
|
# - expiry_time < 0 means the token does not expire.
|
|
# - time and product_id is recorded but only used for debugging.
|
|
# - seq is a 0 based counter per transaction to make tokens unique,
|
|
# although the uniqueness of tokens is currently neither used nor enforced.
|
|
#
|
|
# Tokens are spent in FIFO order, by type rather than product_id. This
|
|
# effectively extends the TTL for active consumers. The product_ids of
|
|
# a user's remaining tokens may not correspond to those of the empty containers
|
|
# in their possession.
|
|
|
|
sub _addon_accounts {
|
|
my @accounts = @RevBank::Plugin::statiegeld::addon_accounts
|
|
or die "statiegeld_tokens plugin requires statiegeld plugin";
|
|
return @accounts;
|
|
}
|
|
|
|
sub _time_is_reliable() {
|
|
state $cache;
|
|
state $cached_at;
|
|
undef $cache if defined $cached_at and $cached_at <= (time() - 10);
|
|
|
|
return $cache if defined $cache;
|
|
|
|
$cache = sub {
|
|
return 1 if system('ntpstat >/dev/null 2>/dev/null') == 0;
|
|
return 1 if `timedatectl show -p NTPSynchronized 2>/dev/null` =~ /=yes/;
|
|
|
|
warn "Time/NTP status unknown or bad; deposit tokens will not expire.\n";
|
|
return 0;
|
|
}->();
|
|
$cached_at = time;
|
|
|
|
return $cache;
|
|
}
|
|
|
|
sub _read {
|
|
spurt $filename if not -e $filename;
|
|
|
|
my %users_tokens;
|
|
for (slurp $filename) {
|
|
/\S/ or next;
|
|
|
|
my ($username, @tokens) = split " ", $_;
|
|
if (exists $users_tokens{$username}) {
|
|
die "Corrupt data file $filename, $username listed twice";
|
|
}
|
|
|
|
my %by_type;
|
|
for my $token (@tokens) {
|
|
my ($token_type) = (split /,/, $token)[0];
|
|
push @{ $by_type{$token_type} }, $token;
|
|
}
|
|
|
|
$users_tokens{$username} = \%by_type;
|
|
}
|
|
return \%users_tokens;
|
|
}
|
|
|
|
sub _expire_tokens($line, $time) {
|
|
$time > 0 or return $line;
|
|
defined $line or return $line;
|
|
$line =~ / / or return $line;
|
|
|
|
# Rewrite line with only non-tokens, invalid tokens, and non-expired tokens
|
|
return join(" ", grep {
|
|
my ($type, undef, $expiry) = split /,/;
|
|
|
|
!defined($expiry) or $expiry < 0 or $expiry > $time
|
|
} split " ", $line) . "\n";
|
|
}
|
|
|
|
sub _write($username, $tokens_by_type, $create) {
|
|
my @tokens = map @{ $tokens_by_type->{$_} }, sort keys %$tokens_by_type;
|
|
my $new_line = @tokens == 0 ? undef : join(" ", $username, @tokens) . "\n";
|
|
|
|
my $time = _time_is_reliable ? time() : -1;
|
|
|
|
if ($create) {
|
|
append $filename, $new_line if defined $new_line;
|
|
} else {
|
|
rewrite $filename, sub ($old_line) {
|
|
$old_line =~ /\S/ or return $old_line; # keep whitespace-only lines
|
|
|
|
# removes line from file if $new_line is undef
|
|
my $line = /(\S+)/ && $1 eq $username ? $new_line : $old_line;
|
|
return _expire_tokens($line, $time);
|
|
};
|
|
}
|
|
}
|
|
|
|
sub _warn($message) {
|
|
warn "\e[31;1mSorry,\e[0m $message\n";
|
|
}
|
|
|
|
sub _handle_undo($cart) {
|
|
# Undoing properly is hard. We can easily void tokens, but we can't restore
|
|
# them. That would requires duplicating all of the undo logic that exists
|
|
# for account balances, but for tokens. Too much work for something that I
|
|
# suspect would hardly be used anyway, so instead we'll just prohibit
|
|
# undoing refunds.
|
|
for my $entry ($cart->entries) {
|
|
# Undo deposit refund: prohibit
|
|
for my $contra ($entry->contras) {
|
|
next if $contra->{amount} < 0;
|
|
next if List::Util::none { $contra->{user} eq $_ } _addon_accounts;
|
|
|
|
_warn "deposit refunds cannot be undone.";
|
|
die "ROLLBACK_UNDO";
|
|
}
|
|
|
|
# Undo buying: void specific tokens
|
|
my $undo_tid = $entry->attribute('undo_transaction_id')
|
|
or die "Plugin error: broken '-undo' transaction";
|
|
|
|
rewrite $filename, sub ($line) {
|
|
my ($username, @tokens) = split " ", $line;
|
|
@tokens = grep {
|
|
my ($token_type, undef, undef, undef, $tid) = split /,/, $_;
|
|
|
|
$tid ne $undo_tid
|
|
} @tokens;
|
|
|
|
return @tokens ? join(" ", $username, @tokens) : undef;
|
|
};
|
|
}
|
|
}
|
|
|
|
sub hook_checkout_prepare($class, $cart, $username, $transaction_id, @) {
|
|
if ($username eq '-undo') {
|
|
_handle_undo($cart);
|
|
return;
|
|
}
|
|
|
|
# Read data
|
|
my $tokens_by_type = _read->{$username};
|
|
my $is_new = !defined $tokens_by_type;
|
|
$tokens_by_type = {} if $is_new;
|
|
my $time_is_reliable = _time_is_reliable;
|
|
|
|
my $tokens_changed = 0;
|
|
|
|
# Products bought: add tokens
|
|
my $seq = 0;
|
|
for my $entry ($cart->entries('product')) {
|
|
my $sg = RevBank::Plugin::statiegeld::statiegeld_product($entry->attribute('product'))
|
|
or next;
|
|
|
|
for my $addon (@{ $sg->{statiegeld_addons} }) {
|
|
# These should never contain commas in vanilla revbank, but custom
|
|
# plugins may be less well behaved.
|
|
/,/ and die "Internal error"
|
|
for $addon->{id}, $entry->attribute('product_id'), $transaction_id;
|
|
|
|
for (1 .. $entry->quantity) {
|
|
my $token = join(",",
|
|
$addon->{id}, # token_type
|
|
time(),
|
|
($time_is_reliable ? time() + $ttl : -1),
|
|
$entry->attribute('product_id'),
|
|
$transaction_id,
|
|
$seq++,
|
|
);
|
|
push @{ $tokens_by_type->{$addon->{id}} }, $token;
|
|
}
|
|
$tokens_changed++;
|
|
}
|
|
}
|
|
|
|
# Products (containers) returned: void tokens in FIFO order
|
|
my $cart_changed = 0;
|
|
my %warnings_by_type;
|
|
my %had_num_tokens_by_type = map { $_ => scalar @{ $tokens_by_type->{$_} } } keys %$tokens_by_type;
|
|
|
|
ENTRY: for my $entry ($cart->entries('plugin')) {
|
|
$entry->attribute('plugin') eq 'statiegeld' or next;
|
|
|
|
my $type = $entry->attribute('addon_id');
|
|
my $available = @{ $tokens_by_type->{$type} // [] };
|
|
|
|
if ($available < $entry->quantity) {
|
|
if ($available == 0) {
|
|
$cart->delete($entry);
|
|
$warnings_by_type{$type}++;
|
|
next ENTRY;
|
|
}
|
|
$entry->quantity($available);
|
|
$warnings_by_type{$type}++;
|
|
}
|
|
if ($entry->attribute('statiegeld_VOID_TOKENS')) {
|
|
$cart->delete($entry);
|
|
}
|
|
|
|
splice @{ $tokens_by_type->{$type} }, 0, $entry->quantity;
|
|
$tokens_changed++;
|
|
}
|
|
for my $type (keys %warnings_by_type) {
|
|
my $products = RevBank::Plugin::products::read_products();
|
|
my $addon = $products->{"+$type"} // $products->{$type};
|
|
my $avail = $had_num_tokens_by_type{$type} // 0;
|
|
my $only =
|
|
+ $avail == 0 ? "0 deposit tokens"
|
|
: $avail == 1 ? "only 1 deposit token"
|
|
: "only $avail deposit tokens";
|
|
|
|
_warn "you have $only of type $type ($addon->{description}).";
|
|
}
|
|
|
|
# Store data
|
|
_write $username, $tokens_by_type, $is_new if $tokens_changed;
|
|
|
|
return ABORT if %warnings_by_type and not $cart->size;
|
|
|
|
if (%warnings_by_type and $cart->changed(1)) {
|
|
print "\n"; # Between warnings and transaction overview
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub hook_user_info ($class, $username, @) {
|
|
my $tokens_by_type = _read->{$username};
|
|
my @info;
|
|
for my $type (sort keys %$tokens_by_type) {
|
|
my @tokens = @{ $tokens_by_type->{$type} // [] };
|
|
push @info, sprintf("%dx %s", scalar @tokens, $type);
|
|
}
|
|
@info = ("none") if not @info;
|
|
print "Deposit tokens: ", join(", ", @info), "\n";
|
|
}
|
|
|
|
sub command($self, $cart, $command, @) {
|
|
$command eq 'void' or return NEXT;
|
|
|
|
my $found =0;
|
|
for my $entry ($cart->entries('plugin')) {
|
|
next if $entry->attribute('plugin') ne 'statiegeld';
|
|
$found++;
|
|
}
|
|
$found or return REJECT, "Add deposit returns first.";
|
|
|
|
return "\e[31;1mDeposit token destruction mode.\e[0m\n\n"
|
|
. "The tokens will be deleted irrevokably and you will NOT RECEIVE THE MONEY.\n"
|
|
. "Type 'yes' if you are sure", \&void;
|
|
}
|
|
|
|
sub void :Tab(yes,no) ($self, $cart, $input, @) {
|
|
if ($input ne 'yes') {
|
|
print "Destruction cancelled.\n";
|
|
return ACCEPT;
|
|
}
|
|
|
|
for my $entry ($cart->entries('plugin')) {
|
|
next if $entry->attribute('plugin') ne 'statiegeld';
|
|
$entry->attribute('statiegeld_VOID_TOKENS', 1);
|
|
}
|
|
|
|
print "\e[31;1mDeposit token destruction mode activated.\e[0m\n";
|
|
return ACCEPT;
|
|
}
|