From a556c732806da87d06bb787565e12240ea39b553 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 21:01:33 -0800 Subject: Stop doing Autoconf substitution on some test suite code Anything that only was using substitution for the paths to the build tree now uses $SOURCE and $BUILD instead. Stop doing substitution. Also fix tests/data/cmd-wrapper to use the environment variables. --- tests/server/backend-t | 502 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 502 insertions(+) create mode 100755 tests/server/backend-t (limited to 'tests/server/backend-t') diff --git a/tests/server/backend-t b/tests/server/backend-t new file mode 100755 index 0000000..2fc6a53 --- /dev/null +++ b/tests/server/backend-t @@ -0,0 +1,502 @@ +#!/usr/bin/perl -w +# +# Tests for the wallet-backend dispatch code. +# +# Written by Russ Allbery +# Copyright 2006, 2007, 2008, 2009, 2010 +# Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use strict; +use Test::More tests => 1263; + +# Create a dummy class for Wallet::Server that prints what method was called +# with its arguments and returns data for testing. +package Wallet::Server; + +use vars qw($error $okay); +$error = 0; +$okay = 0; + +sub error { + if ($okay) { + $okay = 0; + return; + } else { + $error++; + return "error count $error"; + } +} + +sub new { shift; print "new @_\n"; return bless ({}, 'Wallet::Server') } +sub create { shift; print "create @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub destroy { shift; print "destroy @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub store { shift; print "store @_\n"; ($_[0] eq 'error') ? undef : 1 } + +sub acl_add + { shift; print "acl_add @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_create + { shift; print "acl_create @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_destroy + { shift; print "acl_destroy @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_remove + { shift; print "acl_remove @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_rename + { shift; print "acl_rename @_\n"; ($_[0] eq 'error') ? undef : 1 } + +sub acl_history { + shift; + print "acl_history @_\n"; + return if $_[0] eq 'error'; + return 'acl_history'; +} + +sub acl_show { + shift; + print "acl_show @_\n"; + return if $_[0] eq 'error'; + return 'acl_show'; +} + +sub flag_clear + { shift; print "flag_clear @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub flag_set + { shift; print "flag_set @_\n"; ($_[0] eq 'error') ? undef : 1 } + +sub acl { + shift; + print "acl @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'acl'; + } +} + +sub attr { + shift; + print "attr @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } elsif (@_ == 3) { + return ('attr1', 'attr2'); + } else { + return 'attr'; + } +} + +sub autocreate { + shift; + print "autocreate @_\n"; + return ($_[0] eq 'error') ? undef : 1 +} + +sub check { + shift; + print "check @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + return 0; + } else { + return 1; + } +} + +sub expires { + shift; + print "expires @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'expires'; + } +} + +sub get { + shift; + print "get @_\n"; + return if $_[0] eq 'error'; + return 'get'; +} + +sub history { + shift; + print "history @_\n"; + return if $_[0] eq 'error'; + return 'history'; +} + +sub owner { + shift; + print "owner @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'owner'; + } +} + +sub show { + shift; + print "show @_\n"; + return if $_[0] eq 'error'; + return 'show'; +} + +# Back to the main package and the actual test suite. Lie about whether the +# Wallet::Server package has already been loaded. +package main; +$INC{'Wallet/Server.pm'} = 'FAKE'; +my $OUTPUT; +our $SYSLOG = \$OUTPUT; +eval { do "$ENV{SOURCE}/../server/wallet-backend" }; + +# Run the wallet backend. This fun hack takes advantage of the fact that the +# wallet backend is written in Perl so that we can substitute our own +# Wallet::Server class. +sub run_backend { + my (@args) = @_; + my $result = ''; + open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; + select OUTPUT; + local $| = 1; + eval { command (@args) }; + my $error = $@; + select STDOUT; + return ($result, $error); +} + +# Now for the actual tests. First, check for lack of trace information. +my ($out, $err) = run_backend; +is ($err, "REMOTE_USER not set\n", 'REMOTE_USER required'); +is ($OUTPUT, "error: REMOTE_USER not set\n", ' and syslog correct'); +$ENV{REMOTE_USER} = 'admin'; +($out, $err) = run_backend; +is ($err, "neither REMOTE_HOST nor REMOTE_ADDR set\n", + 'REMOTE_HOST or _ADDR required'); +is ($OUTPUT, "error for admin: neither REMOTE_HOST nor REMOTE_ADDR set\n", + ' and syslog correct'); +$ENV{REMOTE_ADDR} = '1.2.3.4'; +my $new = 'new admin 1.2.3.4'; + +# Check unknown commands. +($out, $err) = run_backend ('foo'); +is ($err, "unknown command foo\n", 'Unknown command'); +is ($OUTPUT, "error for admin (1.2.3.4): unknown command foo\n", + ' and syslog correct'); +is ($out, "$new\n", ' and nothing ran'); +($out, $err) = run_backend ('acl', 'foo'); +is ($err, "unknown command acl foo\n", 'Unknown ACL command'); +is ($OUTPUT, "error for admin (1.2.3.4): unknown command acl foo\n", + ' and syslog correct'); +is ($out, "$new\n", ' and nothing ran'); +($out, $err) = run_backend ('flag', 'foo', 'service', 'foo', 'foo'); +is ($err, "unknown command flag foo\n", 'Unknown flag command'); +is ($OUTPUT, "error for admin (1.2.3.4): unknown command flag foo\n", + ' and syslog correct'); +is ($out, "$new\n", ' and nothing ran'); + +# Check too few, too many, and bad arguments for every command. +my %commands = (autocreate => [2, 2], + check => [2, 2], + create => [2, 2], + destroy => [2, 2], + expires => [2, 4], + get => [2, 2], + getacl => [3, 3], + getattr => [3, 3], + history => [2, 2], + owner => [2, 3], + setacl => [4, 4], + setattr => [4, 9], + show => [2, 2], + store => [3, 3]); +my %acl_commands = (add => [3, 3], + create => [1, 1], + destroy => [1, 1], + history => [1, 1], + remove => [3, 3], + rename => [2, 2], + show => [1, 1]); +my %flag_commands = (clear => [3, 3], + set => [3, 3]); +for my $command (sort keys %commands) { + my ($min, $max) = @{ $commands{$command} }; + ($out, $err) = run_backend ($command, ('foo') x ($min - 1)); + is ($err, "insufficient arguments\n", "Too few arguments for $command"); + is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + unless ($max >= 9) { + ($out, $err) = run_backend ($command, ('foo') x ($max + 1)); + is ($err, "too many arguments\n", "Too many arguments for $command"); + is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } + my @base = ('foobar') x $max; + for my $arg (0 .. ($max - 1)) { + my @args = @base; + $args[$arg] = 'foo;bar'; + ($out, $err) = run_backend ($command, @args); + if ($command eq 'store' and $arg == 2) { + is ($err, '', 'Store allows any characters'); + is ($OUTPUT, "command $command @args[0,1] from admin (1.2.3.4)" + . " succeeded\n", ' and success logged'); + is ($out, "$new\nstore foobar foobar foo;bar\n", + ' and calls the right method'); + } else { + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } + } +} +for my $command (sort keys %acl_commands) { + my ($min, $max) = @{ $acl_commands{$command} }; + ($out, $err) = run_backend ('acl', $command, ('foo') x ($min - 1)); + is ($err, "insufficient arguments\n", + "Too few arguments for acl $command"); + is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + ($out, $err) = run_backend ('acl', $command, ('foo') x ($max + 1)); + is ($err, "too many arguments\n", "Too many arguments for acl $command"); + is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + my @base = ('foobar') x $max; + for my $arg (0 .. ($max - 1)) { + my @args = @base; + $args[$arg] = 'foo;bar'; + ($out, $err) = run_backend ('acl', $command, @args); + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for acl $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } +} +for my $command (sort keys %flag_commands) { + my ($min, $max) = @{ $flag_commands{$command} }; + ($out, $err) = run_backend ('flag', $command, ('foo') x ($min - 1)); + is ($err, "insufficient arguments\n", + "Too few arguments for flag $command"); + is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + ($out, $err) = run_backend ('flag', $command, ('foo') x ($max + 1)); + is ($err, "too many arguments\n", "Too many arguments for flag $command"); + is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + my @base = ('foobar') x $max; + for my $arg (0 .. ($max - 1)) { + my @args = @base; + $args[$arg] = 'foo;bar'; + ($out, $err) = run_backend ('flag', $command, @args); + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for flag $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } +} + +# Now, test that we ran the right functions and passed the correct arguments. +my $error = 1; +for my $command (qw/autocreate create destroy setacl setattr store/) { + my $method = { setacl => 'acl', setattr => 'attr' }->{$command}; + $method ||= $command; + my @extra = ('foo') x ($commands{$command}[0] - 2); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ($command, 'type', 'name', @extra); + my $ran; + if ($command eq 'store') { + $ran = "$command type name"; + } else { + $ran = "$command type name" . (@extra ? " @extra" : ''); + } + is ($err, '', "Command $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type name$extra\n", + ' and ran the right method'); + ($out, $err) = run_backend ($command, 'error', 'name', @extra); + if ($command eq 'store') { + $ran = "$command error name"; + } else { + $ran = "$command error name" . (@extra ? " @extra" : ''); + } + is ($err, "error count $error\n", "Command $command ran with errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" + . " $error\n", ' and syslog correct'); + is ($out, "$new\n$method error name$extra\n", + ' and ran the right method'); + $error++; +} +for my $command (qw/check expires get getacl getattr history owner show/) { + my $method = { getacl => 'acl', getattr => 'attr' }->{$command}; + $method ||= $command; + my @extra = ('foo') x ($commands{$command}[0] - 2); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ($command, 'type', 'name', @extra); + my $ran = "$command type name" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + if ($command eq 'getattr') { + is ($out, "$new\n$method type name$extra\nattr1\nattr2\n", + ' and ran the right method with output'); + } elsif ($command eq 'check') { + is ($out, "$new\n$method type name$extra\nyes\n", + ' and ran the right method with output'); + } else { + my $newline = ($command =~ /^(get|history|show)\z/) ? '' : "\n"; + is ($out, "$new\n$method type name$extra\n$method$newline", + ' and ran the right method with output'); + } + if ($command eq 'expires' or $command eq 'owner') { + ($out, $err) = run_backend ($command, 'type', 'name', @extra, 'foo'); + my $ran = "$command type name" . (@extra ? " @extra" : '') . ' foo'; + is ($err, '', "Command $command ran with no errors (setting)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type name$extra foo\n", + ' and ran the right method'); + } + if ($command eq 'expires' or $command eq 'getacl' or $command eq 'owner') { + ($out, $err) = run_backend ($command, 'type', 'empty', @extra); + my $ran = "$command type empty" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors (empty)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + my $desc; + if ($command eq 'expires') { $desc = 'expiration' } + elsif ($command eq 'getacl') { $desc = 'ACL' } + elsif ($command eq 'owner') { $desc = 'owner' } + is ($out, "$new\n$method type empty$extra\nNo $desc set\n", + ' and ran the right method with output'); + $error++; + } elsif ($command eq 'getattr') { + ($out, $err) = run_backend ($command, 'type', 'empty', @extra); + my $ran = "$command type empty" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors (empty)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type empty$extra\n", + ' and ran the right method with output'); + $error++; + } elsif ($command eq 'check') { + ($out, $err) = run_backend ($command, 'type', 'empty', @extra); + my $ran = "$command type empty" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors (empty)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type empty$extra\nno\n", + ' and ran the right method with output'); + } + ($out, $err) = run_backend ($command, 'error', 'name', @extra); + my $ran = "$command error name" . (@extra ? " @extra" : ''); + is ($err, "error count $error\n", "Command $command ran with errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" + . " $error\n", ' and syslog correct'); + is ($out, "$new\n$method error name$extra\n", + ' and ran the right method'); + $error++; +} +for my $command (sort keys %acl_commands) { + my @extra = ('foo') x ($acl_commands{$command}[0] - 1); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ('acl', $command, 'name', @extra); + my $ran = "acl $command name" . (@extra ? " @extra" : ''); + is ($err, '', "Command acl $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + my $expected; + if ($command eq 'show') { + $expected = "$new\nacl_$command name$extra\nacl_show"; + } elsif ($command eq 'history') { + $expected = "$new\nacl_$command name$extra\nacl_history"; + } else { + $expected = "$new\nacl_$command name$extra\n"; + } + is ($out, $expected, ' and ran the right method'); + ($out, $err) = run_backend ('acl', $command, 'error', @extra); + $ran = "acl $command error" . (@extra ? " @extra" : ''); + is ($err, "error count $error\n", "Command acl $command ran with errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" + . " $error\n", ' and syslog correct'); + is ($out, "$new\nacl_$command error$extra\n", + ' and ran the right method'); + $error++; +} +for my $command (sort keys %flag_commands) { + my @extra = ('foo') x ($flag_commands{$command}[0] - 2); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ('flag', $command, 'type', 'name', @extra); + my $ran = "flag $command type name" . (@extra ? " @extra" : ''); + is ($err, '', "Command flag $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\nflag_$command type name$extra\n", + ' and ran the right method'); + ($out, $err) = run_backend ('flag', $command, 'error', 'name', @extra); + $ran = "flag $command error name" . (@extra ? " @extra" : ''); + is ($err, "error count $error\n", + "Command flag $command ran with errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" + . " $error\n", ' and syslog correct'); + is ($out, "$new\nflag_$command error name$extra\n", + ' and ran the right method'); + $error++; +} + +# Almost done. All that remains is to test the robustness of the bad +# character checks against every possible character and test permitting the +# empty argument. +($out, $err) = run_backend ('show', 'type', ''); +is ($err, '', 'Allowed the empty argument'); +is ($OUTPUT, "command show type from admin (1.2.3.4) succeeded\n", + ' and success logged'); +my $ok = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_/.@-'; +($out, $err) = run_backend ('show', 'type', $ok); +is ($err, '', 'Allowed all valid characters'); +is ($OUTPUT, "command show type $ok from admin (1.2.3.4) succeeded\n", + ' and success logged'); +is ($out, "$new\nshow type $ok\nshow", ' and returned the right output'); +for my $n (0 .. 255) { + my $c = chr ($n); + my $name = $ok . $c; + ($out, $err) = run_backend ('show', 'type', $name); + if (index ($ok, $c) == -1) { + is ($err, "invalid characters in argument: $name\n", + "Rejected invalid character $n"); + my $stripped = $name; + $stripped =~ s/[^\x20-\x7e]/_/g; + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: $stripped\n", ' and syslog correct'); + is ($out, "$new\n", ' and did nothing'); + } else { + is ($err, '', "Accepted valid character $n"); + is ($OUTPUT, "command show type $name from admin (1.2.3.4)" + . " succeeded\n", ' and success logged'); + is ($out, "$new\nshow type $name\nshow", ' and ran the method'); + } +} -- cgit v1.2.3 From 4f863ccc9531130be3f4aecea341a0e8a66c6f8c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 20:30:37 -0800 Subject: wallet-backend gets the third store argument from stdin if missing If there is no third argument to store, read it from standard input instead. This is the preferred way of running wallet-backend, using stdin=last support from remctl 2.14 and later. Receiving the third argument as a regular argument continues to be supported for backward compatibility. --- config/wallet | 2 +- docs/setup | 8 ++++---- server/wallet-backend | 11 ++++++++--- tests/server/backend-t | 26 +++++++++++++++++++++++--- 4 files changed, 36 insertions(+), 11 deletions(-) (limited to 'tests/server/backend-t') diff --git a/config/wallet b/config/wallet index 2e0b142..06dc39d 100644 --- a/config/wallet +++ b/config/wallet @@ -3,5 +3,5 @@ # This is a remctld configuration fragment to run wallet-backend, which # implements the server side of the wallet system. -wallet store /usr/sbin/wallet-backend logmask=4 ANYUSER +wallet store /usr/sbin/wallet-backend stdin=4 ANYUSER wallet ALL /usr/sbin/wallet-backend ANYUSER diff --git a/docs/setup b/docs/setup index ac83949..5a0036f 100644 --- a/docs/setup +++ b/docs/setup @@ -64,10 +64,10 @@ Wallet Configuration On the wallet server, install remctld. Then, install the configuration fragment in config/wallet in the remctld configuration. - You can do this either by adding the one non-comment line of that file - to your remctl.conf or, if your remctl.conf includes a directory of - configuration fragments, drop config/wallet into that directory. You - may need to change the path to wallet-backend. + You can do this either by adding the two non-comment lines of that + file to your remctl.conf or, if your remctl.conf includes a directory + of configuration fragments, drop config/wallet into that directory. + You may need to change the path to wallet-backend. Note that the default wallet configuration allows any authenticated user to run the wallet backend and relies on the wallet's ACLs for all diff --git a/server/wallet-backend b/server/wallet-backend index 7780758..453aa79 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -284,7 +284,11 @@ sub command { failure ($server->error, @_); } } elsif ($command eq 'store') { - check_args (3, 3, [3], @args); + check_args (2, 3, [3], @args); + if (@args == 2) { + local $/; + $args[2] = ; + } splice (@_, 3); $server->store (@args) or failure ($server->error, @_); } else { @@ -536,10 +540,11 @@ name, the owner, any specific ACLs set on the object, the expiration if any, and the user, remote host, and time when the object was created, last stored, and last downloaded. -=item store +=item store [] Stores for the object identified by and for later -retrieval with C. Not all object types support this. +retrieval with C. Not all object types support this. If is +not given as an argument, it will be read from standard input. Currently, is limited to not containing nul characters and may therefore not be binary data, and is limited by the maximum command line diff --git a/tests/server/backend-t b/tests/server/backend-t index 2fc6a53..b58d02c 100755 --- a/tests/server/backend-t +++ b/tests/server/backend-t @@ -9,7 +9,7 @@ # See LICENSE for licensing terms. use strict; -use Test::More tests => 1263; +use Test::More tests => 1269; # Create a dummy class for Wallet::Server that prints what method was called # with its arguments and returns data for testing. @@ -163,6 +163,7 @@ package main; $INC{'Wallet/Server.pm'} = 'FAKE'; my $OUTPUT; our $SYSLOG = \$OUTPUT; +my $INPUT = ''; eval { do "$ENV{SOURCE}/../server/wallet-backend" }; # Run the wallet backend. This fun hack takes advantage of the fact that the @@ -173,6 +174,8 @@ sub run_backend { my $result = ''; open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; select OUTPUT; + close STDIN; + open (STDIN, '<', \$INPUT) or die "cannot change stdin: $!\n"; local $| = 1; eval { command (@args) }; my $error = $@; @@ -224,7 +227,7 @@ my %commands = (autocreate => [2, 2], setacl => [4, 4], setattr => [4, 9], show => [2, 2], - store => [3, 3]); + store => [2, 3]); my %acl_commands = (add => [3, 3], create => [1, 1], destroy => [1, 1], @@ -326,6 +329,7 @@ for my $command (qw/autocreate create destroy setacl setattr store/) { $method ||= $command; my @extra = ('foo') x ($commands{$command}[0] - 2); my $extra = @extra ? join (' ', '', @extra) : ''; + $extra = ' ' if $command eq 'store'; ($out, $err) = run_backend ($command, 'type', 'name', @extra); my $ran; if ($command eq 'store') { @@ -413,7 +417,7 @@ for my $command (qw/check expires get getacl getattr history owner show/) { ' and ran the right method with output'); } ($out, $err) = run_backend ($command, 'error', 'name', @extra); - my $ran = "$command error name" . (@extra ? " @extra" : ''); + $ran = "$command error name" . (@extra ? " @extra" : ''); is ($err, "error count $error\n", "Command $command ran with errors"); is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" . " $error\n", ' and syslog correct'); @@ -468,6 +472,22 @@ for my $command (sort keys %flag_commands) { $error++; } +# Special check for store allowing nul characters on standard input. +$INPUT = "Some data\000with a nul character"; +($out, $err) = run_backend ('store', 'type', 'name'); +is ($err, '', 'store with nul data ran with no errors'); +is ($OUTPUT, "command store type name from admin (1.2.3.4) succeeded\n", + ' and success logged'); +is ($out, "$new\nstore type name $INPUT\n", + ' and ran the right method'); +$INPUT = ''; +($out, $err) = run_backend ('store', 'type', 'name'); +is ($err, '', 'store with empty stdin data ran with no errors'); +is ($OUTPUT, "command store type name from admin (1.2.3.4) succeeded\n", + ' and success logged'); +is ($out, "$new\nstore type name \n", + ' and ran the right method'); + # Almost done. All that remains is to test the robustness of the bad # character checks against every possible character and test permitting the # empty argument. -- cgit v1.2.3 From 906f0f88d64c4df501c2b84dbf6b7102de36d491 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 29 Jun 2010 15:38:31 -0700 Subject: Update test suite for the addition of krb5-regex --- perl/t/schema.t | 2 +- perl/t/verifier.t | 20 ++++++++++++++++++-- tests/server/backend-t | 18 +++++++++++++----- 3 files changed, 32 insertions(+), 8 deletions(-) (limited to 'tests/server/backend-t') diff --git a/perl/t/schema.t b/perl/t/schema.t index 7f0aea4..40759db 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -21,7 +21,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; diff --git a/perl/t/verifier.t b/perl/t/verifier.t index 74d7ba8..f56f5fa 100755 --- a/perl/t/verifier.t +++ b/perl/t/verifier.t @@ -3,14 +3,15 @@ # Tests for the basic wallet ACL verifiers. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -use Test::More tests => 47; +use Test::More tests => 57; use Wallet::ACL::Base; use Wallet::ACL::Krb5; +use Wallet::ACL::Krb5::Regex; use Wallet::ACL::NetDB; use Wallet::ACL::NetDB::Root; use Wallet::Config; @@ -39,6 +40,21 @@ is ($verifier->error, 'no principal specified', ' and right error'); is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL'); is ($verifier->error, 'malformed krb5 ACL', ' and right error'); +$verifier = Wallet::ACL::Krb5::Regex->new; +isa_ok ($verifier, 'Wallet::ACL::Krb5::Regex', 'krb5-regex verifier'); +is ($verifier->check ('rra@stanford.edu', '.*@stanford\.edu\z'), 1, + 'Simple check'); +is ($verifier->check ('rra@stanford.edu', '^a.*@stanford\.edu'), 0, + 'Simple failure'); +is ($verifier->error, undef, 'No error set'); +is ($verifier->check (undef, '^rra@stanford\.edu\z'), undef, + 'Undefined principal'); +is ($verifier->error, 'no principal specified', ' and right error'); +is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL'); +is ($verifier->error, 'no ACL specified', ' and right error'); +is ($verifier->check ('rra@stanford.edu', '(rra'), undef, 'Malformed regex'); +is ($verifier->error, 'malformed krb5-regex ACL', ' and right error'); + # Tests for the NetDB verifiers. Skip these if we don't have a keytab or if # we can't find remctld. SKIP: { diff --git a/tests/server/backend-t b/tests/server/backend-t index b58d02c..a618391 100755 --- a/tests/server/backend-t +++ b/tests/server/backend-t @@ -289,11 +289,19 @@ for my $command (sort keys %acl_commands) { my @args = @base; $args[$arg] = 'foo;bar'; ($out, $err) = run_backend ('acl', $command, @args); - is ($err, "invalid characters in argument: foo;bar\n", - "Invalid arguments for acl $command $arg"); - is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" - . " argument: foo;bar\n", ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); + if (($command eq 'add' or $command eq 'remove') and $arg == 2) { + is ($err, '', 'Add/remove allows any characters'); + is ($OUTPUT, "command acl $command @args[0..2] from admin" + . " (1.2.3.4) succeeded\n", ' and success logged'); + is ($out, "$new\nacl_$command @args[0..2]\n", + ' and calls the right method'); + } else { + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for acl $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } } } for my $command (sort keys %flag_commands) { -- cgit v1.2.3 From 74ed6945f9c7839603764327f0187897525db453 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 20 Jun 2011 16:15:35 -0700 Subject: Add a comment field to objects Add a comment field to objects and corresponding commands to wallet-backend and wallet to set and retrieve it. The comment field can only be set by the owner or wallet administrators but can be seen by anyone on the show ACL. --- NEWS | 5 ++++ TODO | 2 -- client/wallet.pod | 25 ++++++++++++++------ perl/Wallet/Object/Base.pm | 39 +++++++++++++++++++++++++++++-- perl/Wallet/Schema.pm | 5 +++- perl/Wallet/Server.pm | 53 +++++++++++++++++++++++++++++++++++------- perl/t/object.t | 32 +++++++++++++++++++++++-- perl/t/schema.t | 31 +++++++++++++++++++++---- perl/t/server.t | 58 +++++++++++++++++++++++++++++++++++++++++++--- server/wallet-backend | 45 +++++++++++++++++++++++++++-------- tests/server/backend-t | 32 +++++++++++++++++++------ 11 files changed, 280 insertions(+), 47 deletions(-) (limited to 'tests/server/backend-t') diff --git a/NEWS b/NEWS index 9e2fa3b..42fb3e7 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,11 @@ wallet 1.0 (unreleased) database to the latest schema version. This command should be run when deploying any new version of the wallet server. + Add a comment field to objects and corresponding commands to + wallet-backend and wallet to set and retrieve it. The comment field + can only be set by the owner or wallet administrators but can be seen + by anyone on the show ACL. + wallet 0.12 (2010-08-25) New client program wallet-rekey that, given a list of keytabs on the diff --git a/TODO b/TODO index 361d242..0323cc9 100644 --- a/TODO +++ b/TODO @@ -45,8 +45,6 @@ Server Interface: * Support limiting returned history information by timestamp. - * Add a comment field for objects that can be set by the owner. - * Provide a REST implementation of the wallet server. * Provide a CGI implementation of the wallet server. diff --git a/client/wallet.pod b/client/wallet.pod index 45969b2..fdfe37f 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -154,11 +154,13 @@ As mentioned above, most commands are only available to wallet administrators. The exceptions are C, C, C, C, C, C, C, C, and C. All of those commands have their own ACLs except C and C, -which use the C ACL, and C, which uses the C ACL. -If the appropriate ACL is set, it alone is checked to see if the user has -access. Otherwise, C, C, C, C, C, and -C access is permitted if the user is authorized by the owner ACL -of the object. +which use the C ACL, C, which uses the C ACL, and +C, which uses the owner or C ACL depending on whether one +is setting or retrieving the comment. If the appropriate ACL is set, it +alone is checked to see if the user has access. Otherwise, C, +C, C, C, C, C, and C +access is permitted if the user is authorized by the owner ACL of the +object. Administrators can run any command on any object or ACL except for C and C. For C and C, they must still be authorized by @@ -167,8 +169,8 @@ either the appropriate specific ACL or the owner ACL. If the locked flag is set on an object, no commands can be run on that object that change data except the C commands, nor can the C command be used on that object. C, C, C, -C, and C or C without an argument can still be -used on that object. +C, and C, C, or C without an argument +can still be used on that object. For more information on attributes, see L. @@ -238,6 +240,15 @@ already exist. Check whether an object of type and name already exists. If it does, prints C; if not, prints C. +=item comment [] + +If is not given, displays the current comment for the object +identified by and , or C if none is set. + +If is given, sets the comment on the object identified by + and to . If is the empty string, clears +the comment. + =item create Create a new object of type with name . With some backends, diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 5097729..28ec6b9 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -1,7 +1,8 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -17,6 +18,7 @@ use vars qw($VERSION); use DBI; use POSIX qw(strftime); +use Text::Wrap qw(wrap); use Wallet::ACL; # This version should be increased on any code change to this module. Always @@ -169,7 +171,7 @@ sub log_set { } my %fields = map { $_ => 1 } qw(owner acl_get acl_store acl_show acl_destroy acl_flags expires - flags type_data); + comment flags type_data); unless ($fields{$field}) { die "invalid history field $field"; } @@ -291,6 +293,19 @@ sub attr_show { return ''; } +# Get or set the comment value of an object. If setting it, trace information +# must also be provided. +sub comment { + my ($self, $comment, $user, $host, $time) = @_; + if ($comment) { + return $self->_set_internal ('comment', $comment, $user, $host, $time); + } elsif (defined $comment) { + return $self->_set_internal ('comment', undef, $user, $host, $time); + } else { + return $self->_get_internal ('comment'); + } +} + # Get or set the expires value of an object. Expects an expiration time in # seconds since epoch. If setting the expiration, trace information must also # be provided. @@ -565,6 +580,7 @@ sub show { [ ob_acl_destroy => 'Destroy ACL' ], [ ob_acl_flags => 'Flags ACL' ], [ ob_expires => 'Expires' ], + [ ob_comment => 'Comment' ], [ ob_created_by => 'Created by' ], [ ob_created_from => 'Created from' ], [ ob_created_on => 'Created on' ], @@ -592,7 +608,14 @@ sub show { # Format the results. We use a hack to insert the flags before the first # trace field since they're not a field in the object in their own right. + # The comment should be word-wrapped at 80 columns. for my $i (0 .. $#data) { + if ($attrs[$i][0] eq 'ob_comment' && length ($data[$i]) > 79 - 17) { + local $Text::Wrap::columns = 80; + local $Text::Wrap::unexpand = 0; + $data[$i] = wrap (' ' x 17, ' ' x 17, $data[$i]); + $data[$i] =~ s/^ {17}//; + } if ($attrs[$i][0] eq 'ob_created_by') { my @flags = $self->flag_list; if (not @flags and $self->error) { @@ -778,6 +801,18 @@ attributes set, this method should return that metadata, formatted as key: value pairs with the keys right-aligned in the first 15 characters, followed by a space, a colon, and the value. +=item comment([COMMENT, PRINCIPAL, HOSTNAME [, DATETIME]]) + +Sets or retrieves the comment associated with an object. If no arguments +are given, returns the current comment or undef if no comment is set. If +arguments are given, change the comment to COMMENT and return true on +success and false on failure. Pass in the empty string for COMMENT to +clear the comment. + +The other arguments are used for logging and history and should indicate +the user and host from which the change is made and the time of the +change. + =item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) Destroys the object by removing all record of it from the database. The diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 0f6c53f..7400776 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -145,7 +145,9 @@ sub upgrade { return; } elsif ($version == 0) { @sql = ('create table metadata (md_version integer)', - 'insert into metadata (md_version) values (1)'); + 'insert into metadata (md_version) values (1)', + 'alter table objects add ob_comment varchar(255) default null' + ); } else { die "unknown database version $version\n"; } @@ -367,6 +369,7 @@ table: ob_downloaded_by varchar(255) default null, ob_downloaded_from varchar(255) default null, ob_downloaded_on datetime default null, + ob_comment varchar(255) default null, primary key (ob_name, ob_type)); create index ob_owner on objects (ob_owner); create index ob_expires on objects (ob_expires); diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 185bf23..7b3fb8f 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -1,7 +1,8 @@ # Wallet::Server -- Wallet system server implementation. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -23,7 +24,7 @@ use Wallet::Schema; # 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.09'; +$VERSION = '0.10'; ############################################################################## # Utility methods @@ -276,7 +277,9 @@ sub object_error { # set the ACL accordingly. sub acl_check { my ($self, $object, $action) = @_; - unless ($action =~ /^(get|store|show|destroy|flags|setattr|getattr)\z/) { + my %actions = map { $_ => 1 } + qw(get store show destroy flags setattr getattr comment); + unless ($actions{$action}) { $self->error ("unknown action $action"); return; } @@ -288,10 +291,10 @@ sub acl_check { $id = $object->acl ('show'); } elsif ($action eq 'setattr') { $id = $object->acl ('store'); - } else { + } elsif ($action ne 'comment') { $id = $object->acl ($action); } - if (! defined ($id) and $action =~ /^(get|(get|set)attr|store|show)\z/) { + if (! defined ($id) and $action ne 'flags' and $action ne 'destroy') { $id = $object->owner; } unless (defined $id) { @@ -365,6 +368,26 @@ sub attr { } } +# Retrieves or sets the comment of an object. +sub comment { + my ($self, $type, $name, $comment) = @_; + undef $self->{error}; + my $object = $self->retrieve ($type, $name); + return unless defined $object; + my $result; + if (defined $comment) { + return unless $self->acl_check ($object, 'comment'); + $result = $object->comment ($comment, $self->{user}, $self->{host}); + } else { + return unless $self->acl_check ($object, 'show'); + $result = $object->comment; + } + if (not defined ($result) and $object->error) { + $self->error ($object->error); + } + return $result; +} + # Retrieves or sets the expiration of an object. sub expires { my ($self, $type, $name, $expires) = @_; @@ -895,6 +918,20 @@ Check whether an object of type TYPE and name NAME exists. Returns 1 if it does, 0 if it doesn't, and undef if some error occurred while checking for the existence of the object. +=item comment(TYPE, NAME, [COMMENT]) + +Gets or sets the comment for the object identified by TYPE and NAME. If +COMMENT is not given, returns the current comment or undef if no comment +is set or on an error. To distinguish between an expiration that isn't +set and a failure to retrieve the expiration, the caller should call +error() after an undef return. If error() also returns undef, no comment +was set; otherwise, error() will return the error message. + +If COMMENT is given, sets the comment to COMMENT. Pass in the empty +string for COMMENT to clear the comment. To set a comment, the current +user must be the object owner or be on the ADMIN ACL. Returns true for +success and false for failure. + =item create(TYPE, NAME) Creates a new object of type TYPE and name NAME. TYPE must be a @@ -933,12 +970,12 @@ Gets or sets the expiration for the object identified by TYPE and NAME. If EXPIRES is not given, returns the current expiration or undef if no expiration is set or on an error. To distinguish between an expiration that isn't set and a failure to retrieve the expiration, the caller should -call error() after an undef return. If error() also returns undef, that -ACL wasn't set; otherwise, error() will return the error message. +call error() after an undef return. If error() also returns undef, the +expiration wasn't set; otherwise, error() will return the error message. If EXPIRES is given, sets the expiration to EXPIRES. EXPIRES must be in the format C, although the time portion may be -omitted. Pass in the empty +string for EXPIRES to clear the expiration +omitted. Pass in the empty string for EXPIRES to clear the expiration date. To set an expiration, the current user must be authorized by the ADMIN ACL. Returns true for success and false for failure. diff --git a/perl/t/object.t b/perl/t/object.t index 3949786..2d60dd2 100755 --- a/perl/t/object.t +++ b/perl/t/object.t @@ -3,12 +3,13 @@ # Tests for the basic object implementation. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 131; +use Test::More tests => 137; use Wallet::ACL; use Wallet::Admin; @@ -99,6 +100,23 @@ if ($object->expires ('', @trace)) { is ($object->expires, undef, ' at which point it is cleared'); is ($object->expires ($now, @trace), 1, ' and setting it again works'); +# Comment. +is ($object->comment, undef, 'Comment is not set to start'); +if ($object->comment ('this is a comment', @trace)) { + ok (1, ' and setting it works'); +} else { + is ($object->error, '', ' and setting it works'); +} +is ($object->comment, 'this is a comment', ' at which point it matches'); +if ($object->comment ('', @trace)) { + ok (1, ' and clearing it works'); +} else { + is ($object->error, '', ' and clearing it works'); +} +is ($object->comment, undef, ' at which point it is cleared'); +is ($object->comment (join (' ', ('this is a comment') x 5), @trace), 1, + ' and setting it again works'); + # ACLs. for my $type (qw/get store show destroy flags/) { is ($object->acl ($type), undef, "ACL $type is not set to start"); @@ -203,6 +221,8 @@ my $output = <<"EOO"; Destroy ACL: ADMIN Flags ACL: ADMIN Expires: $now + Comment: this is a comment this is a comment this is a comment this is + a comment this is a comment Flags: unchanging Created by: $user Created from: $host @@ -223,6 +243,8 @@ $output = <<"EOO"; Destroy ACL: ADMIN Flags ACL: ADMIN Expires: $now + Comment: this is a comment this is a comment this is a comment this is + a comment this is a comment Flags: locked unchanging Created by: $user Created from: $host @@ -267,6 +289,12 @@ $date unset expires (was $now) by $user from $host $date set expires to $now by $user from $host +$date set comment to this is a comment + by $user from $host +$date unset comment (was this is a comment) + by $user from $host +$date set comment to this is a comment this is a comment this is a comment this is a comment this is a comment + by $user from $host $date set acl_get to ADMIN (1) by $user from $host $date unset acl_get (was ADMIN (1)) diff --git a/perl/t/schema.t b/perl/t/schema.t index c66ad59..ce8a62a 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -8,11 +8,12 @@ # # See LICENSE for licensing terms. -use Test::More tests => 15; +use Test::More tests => 16; -use DBI; -use Wallet::Config; -use Wallet::Schema; +use DBI (); +use POSIX qw(strftime); +use Wallet::Config (); +use Wallet::Schema (); use lib 't/lib'; use Util; @@ -45,14 +46,34 @@ is (@$version, 1, 'metadata has correct number of rows'); is (@{ $version->[0] }, 1, ' and correct number of columns'); is ($version->[0][0], 1, ' and the schema version is correct'); -# Test upgrading the database from version 0. +# Test upgrading the database from version 0. SQLite cannot drop table +# columns, so we have to kill the table and then recreate it. $dbh->do ("drop table metadata"); +if (lc ($Wallet::Config::DB_DRIVER) eq 'sqlite') { + ($sql) = grep { /create table objects/ } $schema->sql; + $sql =~ s/ob_comment .*,//; + $dbh->do ("drop table objects") + or die "cannot drop objects table: $DBI::errstr\n"; + $dbh->do ($sql) + or die "cannot recreate objects table: $DBI::errstr\n"; +} else { + $dbh->do ("alter table objects drop column ob_comment") + or die "cannot drop ob_comment column: $DBI::errstr\n"; +} eval { $schema->upgrade ($dbh) }; is ($@, '', "upgrade() doesn't die"); +$sql = "select md_version from metadata"; $version = $dbh->selectall_arrayref ($sql); is (@$version, 1, ' and metadata has correct number of rows'); is (@{ $version->[0] }, 1, ' and correct number of columns'); is ($version->[0][0], 1, ' and the schema version is correct'); +$sql = "insert into objects (ob_type, ob_name, ob_created_by, ob_created_from, + ob_created_on, ob_comment) values ('file', 'test', 'test', + 'test.example.org', ?, 'a test comment')"; +$dbh->do ($sql, undef, strftime ('%Y-%m-%d %T', localtime time)); +$sql = "select ob_comment from objects where ob_name = 'test'"; +my ($comment) = $dbh->selectrow_array ($sql); +is ($comment, 'a test comment', ' and ob_comment was added to objects'); # Test dropping the database. eval { $schema->drop ($dbh) }; diff --git a/perl/t/server.t b/perl/t/server.t index ed92d6e..ad16151 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -3,11 +3,12 @@ # Tests for the wallet server API. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. -use Test::More tests => 355; +use Test::More tests => 377; use POSIX qw(strftime); use Wallet::Admin; @@ -199,6 +200,24 @@ is ($server->check ('base', 'service/test'), 0, is ($server->destroy ('base', 'service/test'), undef, ' but not twice'); is ($server->error, 'cannot find base:service/test', ' with the right error'); +# Test manipulating comments. +is ($server->comment ('base', 'service/test'), undef, + 'Retrieving comment on an unknown object fails'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->comment ('base', 'service/test', 'this is a comment'), undef, + ' and setting it also fails'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->comment ('base', 'service/admin'), undef, + 'Retrieving comment for the right object returns undef'); +is ($server->error, undef, ' but there is no error'); +is ($server->comment ('base', 'service/admin', 'this is a comment'), 1, + ' and we can set it'); +is ($server->comment ('base', 'service/admin'), 'this is a comment', + ' and get the value back'); +is ($server->comment ('base', 'service/admin', ''), 1, ' and clear it'); +is ($server->comment ('base', 'service/admin'), undef, ' and now it is gone'); +is ($server->error, undef, ' and still no error'); + # Test manipulating expires. my $now = strftime ('%Y-%m-%d %T', localtime time); is ($server->expires ('base', 'service/test'), undef, @@ -393,6 +412,10 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, $history = <<"EOO"; DATE create by $admin from $host +DATE set comment to this is a comment + by $admin from $host +DATE unset comment (was this is a comment) + by $admin from $host DATE set expires to $now by $admin from $host DATE unset expires (was $now) @@ -510,12 +533,15 @@ is ($server->store ('base', 'service/user1', 'stuff'), undef, is ($server->error, "cannot store base:service/user1: object type is immutable", ' and the method is called'); +is ($server->comment ('base', 'service/user1', 'this is a comment'), 1, + ' and set a comment'); $show = $server->show ('base', 'service/user1'); $show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/m; $expected = <<"EOO"; Type: base Name: service/user1 Owner: user1 + Comment: this is a comment Created by: $admin Created from: $host Created on: 0 @@ -529,6 +555,8 @@ DATE create by $admin from $host DATE set owner to user1 (2) by $admin from $host +DATE set comment to this is a comment + by $user1 from $host EOO $seen = $server->history ('base', 'service/user1'); $seen =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; @@ -566,6 +594,11 @@ is ($server->attr ('base', 'service/user2', 'foo', ''), undef, is ($server->error, "$user1 not authorized to set attributes for base:service/user2", ' with the right error'); +is ($server->comment ('base', 'service/user2', 'this is a comment'), undef, + ' and set comment'); +is ($server->error, + "$user1 not authorized to set comment for base:service/user2", + ' with the right error'); # And only some things on an object we own with some ACLs. $result = eval { $server->get ('base', 'service/both') }; @@ -702,8 +735,27 @@ is ($server->history ('base', 'service/user1'), undef, ' or see history for it'); is ($server->error, "$user2 not authorized to show base:service/user1", ' with the right error'); +is ($server->comment ('base', 'service/user1', 'this is a comment'), undef, + ' or set a comment for it'); +is ($server->error, + "$user2 not authorized to set comment for base:service/user1", + ' with the right error'); -# And only some things on an object we own with some ACLs. +# Test that setting a comment is controlled by the owner but retrieving it is +# controlled by the show ACL. +$result = eval { $server->get ('base', 'service/both') }; +is ($result, undef, 'We can get an object we jointly own'); +is ($@, "Do not instantiate Wallet::Object::Base directly\n", + ' and the method is called'); +is ($server->comment ('base', 'service/both', 'this is a comment'), 1, + ' and can set a comment on it'); +is ($server->error, undef, ' with no error'); +is ($server->comment ('base', 'service/both'), undef, + ' but cannot see the comment on it'); +is ($server->error, "$user2 not authorized to show base:service/both", + ' with the right error'); + +# And can only do some things on an object we own with some ACLs. $result = eval { $server->get ('base', 'service/both') }; is ($result, undef, 'We can get an object we jointly own'); is ($@, "Do not instantiate Wallet::Object::Base directly\n", diff --git a/server/wallet-backend b/server/wallet-backend index 52e9857..9850c0e 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -3,7 +3,8 @@ # wallet-backend -- Wallet server for storing and retrieving secure data. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -191,6 +192,20 @@ sub command { } else { print $status ? "yes\n" : "no\n"; } + } elsif ($command eq 'comment') { + check_args (2, 3, [], @args); + if (@args > 2) { + $server->comment (@args) or failure ($server->error, @_); + } else { + my $output = $server->comment (@args); + if (defined $output) { + print $output, "\n"; + } elsif (not $server->error) { + print "No comment set\n"; + } else { + failure ($server->error, @_); + } + } } elsif ($command eq 'create') { check_args (2, 2, [], @args); $server->create (@args) or failure ($server->error, @_); @@ -364,13 +379,14 @@ Most commands are only available to wallet administrators (users on the C ACL). The exceptions are C, C, C, C, C, C, C, C, C, and C. All of those commands have their own ACLs except -C and C, which use the C ACL, and C, -which uses the C ACL. If the appropriate ACL is set, it alone is -checked to see if the user has access. Otherwise, C, C, -C, C, C, and C access is permitted if the -user is authorized by the owner ACL of the object. C is -permitted if the user is listed in the default ACL for an object for that -name. +C and C, which use the C ACL, C, which +uses the C ACL, and C, which uses the owner or C +ACL depending on whether one is setting or retrieving the comment. If the +appropriate ACL is set, it alone is checked to see if the user has access. +Otherwise, C, C, C, C, C, C, +and C access is permitted if the user is authorized by the owner +ACL of the object. C is permitted if the user is listed in +the default ACL for an object for that name. Administrators can run any command on any object or ACL except for C and C. For C and C, they must still be authorized by @@ -379,8 +395,8 @@ either the appropriate specific ACL or the owner ACL. If the locked flag is set on an object, no commands can be run on that object that change data except the C commands, nor can the C command be used on that object. C, C, C, -C, and C or C without an argument can still be -used on that object. +C, and C, C, or C without an argument +can still be used on that object. For more information on attributes, see L. @@ -437,6 +453,15 @@ object will be created with that default ACL set as the object owner. Check whether an object of type and name already exists. If it does, prints C; if not, prints C. +=item comment [] + +If is not given, displays the current comment for the object +identified by and , or C if none is set. + +If is given, sets the comment on the object identified by + and to . If is the empty string, clears +the comment. + =item create Create a new object of type with name . With some backends, diff --git a/tests/server/backend-t b/tests/server/backend-t index a618391..3e377a1 100755 --- a/tests/server/backend-t +++ b/tests/server/backend-t @@ -3,13 +3,13 @@ # Tests for the wallet-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008, 2009, 2010 -# Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2008, 2009, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. use strict; -use Test::More tests => 1269; +use Test::More tests => 1296; # Create a dummy class for Wallet::Server that prints what method was called # with its arguments and returns data for testing. @@ -110,6 +110,19 @@ sub check { } } +sub comment { + shift; + print "comment @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'comment'; + } +} + sub expires { shift; print "expires @_\n"; @@ -216,6 +229,7 @@ is ($out, "$new\n", ' and nothing ran'); # Check too few, too many, and bad arguments for every command. my %commands = (autocreate => [2, 2], check => [2, 2], + comment => [2, 3], create => [2, 2], destroy => [2, 2], expires => [2, 4], @@ -363,7 +377,8 @@ for my $command (qw/autocreate create destroy setacl setattr store/) { ' and ran the right method'); $error++; } -for my $command (qw/check expires get getacl getattr history owner show/) { +for my $command (qw/check comment expires get getacl getattr history owner + show/) { my $method = { getacl => 'acl', getattr => 'attr' }->{$command}; $method ||= $command; my @extra = ('foo') x ($commands{$command}[0] - 2); @@ -384,7 +399,8 @@ for my $command (qw/check expires get getacl getattr history owner show/) { is ($out, "$new\n$method type name$extra\n$method$newline", ' and ran the right method with output'); } - if ($command eq 'expires' or $command eq 'owner') { + if ($command eq 'expires' or $command eq 'owner' + or $command eq 'comment') { ($out, $err) = run_backend ($command, 'type', 'name', @extra, 'foo'); my $ran = "$command type name" . (@extra ? " @extra" : '') . ' foo'; is ($err, '', "Command $command ran with no errors (setting)"); @@ -393,14 +409,16 @@ for my $command (qw/check expires get getacl getattr history owner show/) { is ($out, "$new\n$method type name$extra foo\n", ' and ran the right method'); } - if ($command eq 'expires' or $command eq 'getacl' or $command eq 'owner') { + if ($command eq 'expires' or $command eq 'getacl' + or $command eq 'owner' or $command eq 'comment') { ($out, $err) = run_backend ($command, 'type', 'empty', @extra); my $ran = "$command type empty" . (@extra ? " @extra" : ''); is ($err, '', "Command $command ran with no errors (empty)"); is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", ' and success logged'); my $desc; - if ($command eq 'expires') { $desc = 'expiration' } + if ($command eq 'comment') { $desc = 'comment' } + elsif ($command eq 'expires') { $desc = 'expiration' } elsif ($command eq 'getacl') { $desc = 'ACL' } elsif ($command eq 'owner') { $desc = 'owner' } is ($out, "$new\n$method type empty$extra\nNo $desc set\n", -- cgit v1.2.3 From 357532f312aea30ab5b3e459ccf19f1580b29262 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 4 Nov 2012 10:38:29 -0800 Subject: Add new acl check command Add a new acl check command which, given an ACL ID, prints yes if that ACL already exists and no otherwise. This is parallel to the check command for objects. Also fix some documentation errors in the wallet client documentation, saying that the check command doesn't require any ACL and fixing one place where "show" was used instead of "store". --- NEWS | 4 ++++ TODO | 3 --- client/wallet.pod | 30 ++++++++++++++++++------------ perl/Wallet/Server.pm | 40 ++++++++++++++++++++++++++++------------ perl/t/server.t | 10 +++++++--- server/wallet-backend | 31 ++++++++++++++++++++++--------- tests/server/backend-t | 30 +++++++++++++++++++++++++++--- 7 files changed, 106 insertions(+), 42 deletions(-) (limited to 'tests/server/backend-t') diff --git a/NEWS b/NEWS index 6f20133..b948d91 100644 --- a/NEWS +++ b/NEWS @@ -15,6 +15,10 @@ wallet 1.0 (unreleased) this ACL type for an existing wallet database, use wallet-admin to register the new verifier. + Add a new acl check command which, given an ACL ID, prints yes if that + ACL already exists and no otherwise. This is parallel to the check + command for objects. + Add a comment field to objects and corresponding commands to wallet-backend and wallet to set and retrieve it. The comment field can only be set by the owner or wallet administrators but can be seen diff --git a/TODO b/TODO index fd49abc..2fc17b5 100644 --- a/TODO +++ b/TODO @@ -29,9 +29,6 @@ Client: Server Interface: - * WALLET-12: Add check command for ACLs similar to the check command for - objects. - * WALLET-13: Provide a way to get history for deleted objects and ACLs. * WALLET-14: Provide an interface to mass-change all instances of one ACL diff --git a/client/wallet.pod b/client/wallet.pod index a0785a5..23e4e7c 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -151,19 +151,20 @@ options and commands are ignored. =head1 COMMANDS As mentioned above, most commands are only available to wallet -administrators. The exceptions are C, C, C, C, -C, C, C, C, and C. All -of those commands have their own ACLs except C and C, -which use the C ACL, C, which uses the C ACL, and -C, which uses the owner or C ACL depending on whether one -is setting or retrieving the comment. If the appropriate ACL is set, it -alone is checked to see if the user has access. Otherwise, C, -C, C, C, C, C, and C -access is permitted if the user is authorized by the owner ACL of the -object. +administrators. The exceptions are C, C, C, +C, C, C, C, C, C, +C, and C. C and C can be run by +anyone. All of the rest of those commands have their own ACLs except +C and C, which use the C ACL, C, which +uses the C ACL, and C, which uses the owner or C ACL +depending on whether one is setting or retrieving the comment. If the +appropriate ACL is set, it alone is checked to see if the user has access. +Otherwise, C, C, C, C, C, C, +and C access is permitted if the user is authorized by the owner +ACL of the object. Administrators can run any command on any object or ACL except for C -and C. For C and C, they must still be authorized by +and C. For C and C, they must still be authorized by either the appropriate specific ACL or the owner ACL. If the locked flag is set on an object, no commands can be run on that @@ -178,9 +179,14 @@ For more information on attributes, see L. =item acl add -Adds an entry with and to the ACL . may be +Add an entry with and to the ACL . may be either the name of an ACL or its numeric identifier. +=item acl check + +Check whether an ACL with the ID already exists. If it does, prints +C; if not, prints C. + =item acl create Create a new, empty ACL with name . When setting an ACL on an diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index b2bae2c..dfb7dbb 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -275,7 +275,7 @@ sub object_error { # the internal error message. Note that we do not allow any special access to # admins for get and store; if they want to do that with objects, they need to # set the ACL accordingly. -sub acl_check { +sub acl_verify { my ($self, $object, $action) = @_; my %actions = map { $_ => 1 } qw(get store show destroy flags setattr getattr comment); @@ -349,7 +349,7 @@ sub attr { my $user = $self->{user}; my $host = $self->{host}; if (@values) { - return unless $self->acl_check ($object, 'setattr'); + return unless $self->acl_verify ($object, 'setattr'); if (@values == 1 and $values[0] eq '') { @values = (); } @@ -357,7 +357,7 @@ sub attr { $self->error ($object->error) unless $result; return $result; } else { - return unless $self->acl_check ($object, 'getattr'); + return unless $self->acl_verify ($object, 'getattr'); my @result = $object->attr ($attr); if (not @result and $object->error) { $self->error ($object->error); @@ -376,10 +376,10 @@ sub comment { return unless defined $object; my $result; if (defined $comment) { - return unless $self->acl_check ($object, 'comment'); + return unless $self->acl_verify ($object, 'comment'); $result = $object->comment ($comment, $self->{user}, $self->{host}); } else { - return unless $self->acl_check ($object, 'show'); + return unless $self->acl_verify ($object, 'show'); $result = $object->comment; } if (not defined ($result) and $object->error) { @@ -456,7 +456,7 @@ sub get { my ($self, $type, $name) = @_; my $object = $self->retrieve ($type, $name); return unless defined $object; - return unless $self->acl_check ($object, 'get'); + return unless $self->acl_verify ($object, 'get'); my $result = $object->get ($self->{user}, $self->{host}); $self->error ($object->error) unless defined $result; return $result; @@ -471,7 +471,7 @@ sub store { my ($self, $type, $name, $data) = @_; my $object = $self->retrieve ($type, $name); return unless defined $object; - return unless $self->acl_check ($object, 'store'); + return unless $self->acl_verify ($object, 'store'); if (not defined ($data)) { $self->{error} = "no data supplied to store"; return; @@ -488,7 +488,7 @@ sub show { my ($self, $type, $name) = @_; my $object = $self->retrieve ($type, $name); return unless defined $object; - return unless $self->acl_check ($object, 'show'); + return unless $self->acl_verify ($object, 'show'); my $result = $object->show; $self->error ($object->error) unless defined $result; return $result; @@ -501,7 +501,7 @@ sub history { my ($self, $type, $name) = @_; my $object = $self->retrieve ($type, $name); return unless defined $object; - return unless $self->acl_check ($object, 'show'); + return unless $self->acl_verify ($object, 'show'); my $result = $object->history; $self->error ($object->error) unless defined $result; return $result; @@ -513,7 +513,7 @@ sub destroy { my ($self, $type, $name) = @_; my $object = $self->retrieve ($type, $name); return unless defined $object; - return unless $self->acl_check ($object, 'destroy'); + return unless $self->acl_verify ($object, 'destroy'); my $result = $object->destroy ($self->{user}, $self->{host}); $self->error ($object->error) unless defined $result; return $result; @@ -529,7 +529,7 @@ sub flag_clear { my ($self, $type, $name, $flag) = @_; my $object = $self->retrieve ($type, $name); return unless defined $object; - return unless $self->acl_check ($object, 'flags'); + return unless $self->acl_verify ($object, 'flags'); my $result = $object->flag_clear ($flag, $self->{user}, $self->{host}); $self->error ($object->error) unless defined $result; return $result; @@ -541,7 +541,7 @@ sub flag_set { my ($self, $type, $name, $flag) = @_; my $object = $self->retrieve ($type, $name); return unless defined $object; - return unless $self->acl_check ($object, 'flags'); + return unless $self->acl_verify ($object, 'flags'); my $result = $object->flag_set ($flag, $self->{user}, $self->{host}); $self->error ($object->error) unless defined $result; return $result; @@ -551,6 +551,22 @@ sub flag_set { # ACL methods ############################################################################## +# Checks for the existence of an ACL. Returns 1 if it does, 0 if it doesn't, +# and undef if there was an error in checking the existence of the object. +sub acl_check { + my ($self, $id) = @_; + my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + if ($@) { + if ($@ =~ /^ACL .* not found/) { + return 0; + } else { + $self->error ($@); + return; + } + } + return 1; +} + # Create a new empty ACL in the database. Returns true on success and undef # on failure, setting the internal error. sub acl_create { diff --git a/perl/t/server.t b/perl/t/server.t index ad16151..8e0a30d 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -3,12 +3,12 @@ # Tests for the wallet server API. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2011 +# Copyright 2007, 2008, 2010, 2011, 2012 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. -use Test::More tests => 377; +use Test::More tests => 381; use POSIX qw(strftime); use Wallet::Admin; @@ -66,7 +66,9 @@ is ($result, $history, ' including by number'); is ($server->acl_create (3), undef, 'Cannot create ACL with a numeric name'); is ($server->error, 'ACL name may not be all numbers', ' and returns the right error'); +is ($server->acl_check ('user1'), 0, 'user1 ACL does not exist'); is ($server->acl_create ('user1'), 1, 'Can create regular ACL'); +is ($server->acl_check ('user1'), 1, 'user1 now exists'); is ($server->acl_show ('user1'), "Members of ACL user1 (id: 2) are:\n", ' and show works'); is ($server->acl_create ('user1'), undef, ' but not twice'); @@ -95,8 +97,10 @@ is ($server->acl_history ('test'), undef, ' and history fails'); is ($server->error, 'ACL test not found', ' and returns the right error'); is ($server->acl_destroy ('test'), undef, 'Destroying the old name fails'); is ($server->error, 'ACL test not found', ' and returns the right error'); -is ($server->acl_destroy ('test2'), 1, ' but destroying another one works'); +is ($server->acl_check ('test2'), 1, ' but the other ACL exists'); +is ($server->acl_destroy ('test2'), 1, ' and destroying it works'); is ($server->acl_destroy ('test2'), undef, ' but not twice'); +is ($server->acl_check ('test2'), 0, ' and now it does not exist'); is ($server->error, 'ACL test2 not found', ' and returns the right error'); is ($server->acl_add ('user1', 'krb4', $user1), undef, 'Adding with a bad scheme fails'); diff --git a/server/wallet-backend b/server/wallet-backend index 9850c0e..948b47c 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -3,7 +3,7 @@ # wallet-backend -- Wallet server for storing and retrieving secure data. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2011 +# Copyright 2007, 2008, 2010, 2011, 2012 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -150,6 +150,14 @@ sub command { if ($action eq 'add') { check_args (3, 3, [3], @args); $server->acl_add (@args) or failure ($server->error, @_); + } elsif ($action eq 'check') { + check_args (1, 1, [], @args); + my $status = $server->acl_check (@args); + if (!defined ($status)) { + failure ($server->error, @_); + } else { + print $status ? "yes\n" : "no\n"; + } } elsif ($action eq 'create') { check_args (1, 1, [], @args); $server->acl_create (@args) or failure ($server->error, @_); @@ -376,17 +384,17 @@ syslog. =head1 COMMANDS Most commands are only available to wallet administrators (users on the -C ACL). The exceptions are C, C, C, -C, C, C, C, C, C, -and C. All of those commands have their own ACLs except +C ACL). The exceptions are C, C, C, +C, C, C, C, C, C, +C, and C. C and C can be run by +anyone. All of the rest of those commands have their own ACLs except C and C, which use the C ACL, C, which -uses the C ACL, and C, which uses the owner or C -ACL depending on whether one is setting or retrieving the comment. If the +uses the C ACL, and C, which uses the owner or C ACL +depending on whether one is setting or retrieving the comment. If the appropriate ACL is set, it alone is checked to see if the user has access. Otherwise, C, C, C, C, C, C, and C access is permitted if the user is authorized by the owner -ACL of the object. C is permitted if the user is listed in -the default ACL for an object for that name. +ACL of the object. Administrators can run any command on any object or ACL except for C and C. For C and C, they must still be authorized by @@ -404,9 +412,14 @@ For more information on attributes, see L. =item acl add -Adds an entry with and to the ACL . may be +Add an entry with and to the ACL . may be either the name of an ACL or its numeric identifier. +=item acl check + +Check whether an ACL with the ID already exists. If it does, prints +C; if not, prints C. + =item acl create Create a new, empty ACL with name . When setting an ACL on an diff --git a/tests/server/backend-t b/tests/server/backend-t index 3e377a1..50131b7 100755 --- a/tests/server/backend-t +++ b/tests/server/backend-t @@ -3,13 +3,13 @@ # Tests for the wallet-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008, 2009, 2010, 2011 +# Copyright 2006, 2007, 2008, 2009, 2010, 2011, 2012 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. use strict; -use Test::More tests => 1296; +use Test::More tests => 1314; # Create a dummy class for Wallet::Server that prints what method was called # with its arguments and returns data for testing. @@ -45,6 +45,18 @@ sub acl_remove sub acl_rename { shift; print "acl_rename @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_check { + shift; + print "acl_check @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[0] eq 'unknown') { + return 0; + } else { + return 1; + } +} + sub acl_history { shift; print "acl_history @_\n"; @@ -243,6 +255,7 @@ my %commands = (autocreate => [2, 2], show => [2, 2], store => [2, 3]); my %acl_commands = (add => [3, 3], + check => [1, 1], create => [1, 1], destroy => [1, 1], history => [1, 1], @@ -460,7 +473,9 @@ for my $command (sort keys %acl_commands) { is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", ' and success logged'); my $expected; - if ($command eq 'show') { + if ($command eq 'check') { + $expected = "$new\nacl_$command name$extra\nyes\n"; + } elsif ($command eq 'show') { $expected = "$new\nacl_$command name$extra\nacl_show"; } elsif ($command eq 'history') { $expected = "$new\nacl_$command name$extra\nacl_history"; @@ -476,6 +491,15 @@ for my $command (sort keys %acl_commands) { is ($out, "$new\nacl_$command error$extra\n", ' and ran the right method'); $error++; + if ($command eq 'check') { + ($out, $err) = run_backend ('acl', $command, 'unknown'); + my $ran = "acl $command unknown"; + is ($err, '', "Command $command ran with no errors (unknown)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\nacl_$command unknown\nno\n", + ' and ran the right method with output'); + } } for my $command (sort keys %flag_commands) { my @extra = ('foo') x ($flag_commands{$command}[0] - 2); -- cgit v1.2.3