After reading Debug values encrypt as XXXX and having had similar thoughts before, I have thrown together a candidate solution to the problem of safely passing sensitive data to debugging code, logging code, and external modules. First some code samples:
Update: Revised the usage based on initial reactions (code and original synopsis below readmore remains unchanged). Further revisions to usage and revised code will be uploaded to github within the next couple days (I will add a link here). Further comments on the original or revised usage welcome!
Basic usage
Returns masked value on stringification, returns unmasked value only when
explicitly requested.
my $ccn = Text::Hidden->new( "1234567887654321" );
say STDERR "DEBUG: Got a CCN ($ccn)"; # DEBUG: Got a CCN (XXX
+XXXXXXXXXXXXX)
say "The real CCN: ", $ccn->unhidden_value; # The real CCN: 1234567
+887654321
You may also set a custom obfuscator:
my $ccn = Text::Hidden->new( "1234567887654321",
obfuscator => sub { "XXXXXXXXXXXX".substr($_[0], -4) },
);
Creating pinholes
If your sensitive data needs to be processed by external modules you may,
of course, pass the unhidden value directly to these modules. However, any
logging done or errors thrown by that external module may contain the
unhidden sensitive value.
You may instead create a list of exceptional situations where
stringification of the Text::Hidden object returns the unmasked text. Such
exceptions may be made at the package, sub, or even line level. More
complicated situations can be addressed if you provide a CODE reference
which may then examine the full call stack.
Basic pinholes are matched against the immediate caller's
"PACKAGE::SUB_NAME(LINE_NUMBER)", "PACKAGE::SUB_NAME()", or just "PACKAGE".
my $passwd = Text::Hidden->new( "12345",
auto_unhide => [
"Some::Class::Authentication", # anywhere in Authentic
+ation package
"Some::OtherClass::authenticate()", # anywhere in authentic
+ate method
"Some::OtherClass::foo(43)", # line 43 in method foo
+ (FRAGILE!)
],
# similar, but search call stack (not just immediate caller) for
+ a match
auto_unhide_recursive => [ ... ],
);
As an aid to creating pinhole rules, set the C<debug> option to print a
message whenever the object is accessed. Here, we may also wish to
temporarily pass the C<default =E<gt> "unhidden"> option so that we can
trace the code path for a successful authentication.
my $passwd = Text::Hidden->new( "12345",
debug => 1,
trace => 0, # set to 1 to show entire call stack
);
Then,
say $passwd;
say $passwd->unhidden_value;
Some::Module->login( $user, $passwd );
may print to STDERR:
Stringification to hidden value at main::(5)
Explicit cast to unhidden value at main::(6)
Stringification to hidden value at Some::Module::Authentication::log
+ger(14)
Stringification to hidden value at Some::Module::Authentication::aut
+henticate(43)
Default Unhidden
While not generally reccommended, this module supports a "default unhidden"
mode of operation which will stringify to the unhidden value except when
blocked.
my $ccn = Text::Hidden->new( "1234567887654321",
default => "unhidden",
hide_from_recursive => [ qr/^DB[ID]/ ],
);
TODO: Decide "order" policy: fixed?; depends on "default"? (no probably
not); configurable?
Localized default policy
Localizing the default policy can be done on-the-fly which provides a
middle ground between pre-declaring all unhidden access points and a
default unhidden policy.
Localized default policies still provide an advantage over working with a
plain string in that the policy may still be overridden via "hide_from",
"auto_unhide", or the global C<$Text::Hidden::Force> variable described in
the next section.
{ my $key = $ccn->localized_default_unhidden;
# All uses return unmasked value unless hide_from patterns match
print "$ccn";
Some::Module->charge_money( $name, $ccn );
}
# Return to default hidden policy now that key is dropped
{ my $key = $ccn->localized_default_hidden;
# ...
}
Forcing masking (or unmasking)
Masking may be forced by locally setting C<$Text::Hidden::Force>. For
instance, a C<__DIE__> or C<__WARN__> handler might want to force a hidden
policy to reduce the danger of leakage. Setting this variable overrides all
"hide_from", "auto_unhide", or default policies.
$SIG{__DIE__} = sub {
local $Text::Hidden::Force = "hidden";
# ...
};
I am not entirely convinced myself that a module such as this is a good idea / necessary. For instance, perhaps it is just a better idea to be more careful with your data. However, I have seen the question arise a couple times before and have myself occasionally wished (in passing) for such a module. Are there existing modules which implement this or a similar scheme? (previous searches and a quick search now did not turn up anything.) Is an approach like this even a good idea? Is there a better way?... Should I clean this up and publish this approach to CPAN? If so, is there a better name for it (String::Obfuscate, String::AutoObfuscate, String::Mask, Data::Mask, Text::Mask...)?
Update: Move POD to bottom of module
package SecureString;
use 5.010;
use strict; use warnings; use re 'taint'; use autodie;
our $VERSION = 0.0000;# Created: 2011-07-18
use Carp qw/ confess cluck /;
use overload
'bool' => \&_string,
'""' => \&_string,
'0+' => \&_number,
;
use Hash::Util::FieldHash qw(id register);
my %STRING;
sub new {
my ($class, $value, %opt) = @_;
my $self = bless
{ obfuscator => \&_default_obfuscator,
cache_masked => 1,
recompute_masked => 1,
%opt
}, $class;
register( $self, \%STRING );
$self->set( $value );
return $self;
}
sub set {
my $self = shift;
$STRING{id $self} = shift;
delete $$self{masked} if $$self{recompute_masked} and $$self{obfusca
+tor};
return $self;
}
sub get {
my $self = shift;
return $self unless $self->_match_caller( $$self{allow} );# Default
+allow all
return $STRING{id $self};
}
sub get_masked {
my $self = shift;
return $$self{masked} if $$self{masked};
my $masked;
$masked = $$self{obfuscator}->($STRING{id $self}) if $$self{obfuscat
+or};
$masked //= 'XXXXX';
$$self{masked} = $masked if $$self{cache_masked};
return $masked;
}
## Completely untested:
sub STORABLE_freeze {
my ($self, $cloning) = @_;
# Allow cloning, but do not save value when storing
my $value = $cloning ? $STRING{id $self} : $self->get_masked;
return ($value, $self);
}
sub STORABLE_thaw {
my ($self, $cloning, $value, $obj) = @_;
%$self = %$obj;
$STRING{id $self} = $value;
}
## Doesn't work:
sub yaml_dump {
my $self = shift;
YAML::Node->new( $self->get_masked );
}
sub _string {
my $self = shift;
if ($$self{cluck} and (1 eq $$self{cluck} or $self->_match_caller( $
+$self{cluck} ))) {
$self->_show_caller("Attempt to access string value of ".$self->ge
+t_masked);
cluck "\n";
}
return $self->get_masked unless $self->_match_caller( $$self{auto_ge
+t} || [] );# Default do not match
return $STRING{id $self};
}
sub _number {
confess "Attempted to use SecureString as a number";
}
sub _show_caller {
my ($self, $msg, $level) = @_;
$level = $level ? $level + 1 : 2;
my ($pkg, $file, $line, $sub) = $self->_caller($level);
print STDERR "$msg at $sub($line)";
}
sub _caller {
my ($self, $level) = @_;
my ($pkg, $file, $line) = caller($level);
my (undef, undef, undef, $sub) = caller($level+1);
$_ //= "" for $pkg, $file, $line, $sub;
$sub ||= "${pkg}::";
return ($pkg, $file, $line, $sub);
}
sub _match_caller {
my ($self, $match, $level) = @_;
return 1 unless $match;
$level = $level ? $level + 1 : 2;
my @caller = $self->_caller($level);
for ('ARRAY' eq ref($match) ? @$match : $match) {
return 1 if $self->_match_caller_item( $_, $level+1, @caller );
}
return 0;
}
sub _match_caller_item {
my ($self, $match, $level, $pkg, $file, $line, $sub) = @_;
given (ref($match)) {
when ('') { return 1 if $match eq $pkg or $match eq "$sub()
+" or $match eq "$sub($line)" }
when ('Regexp') { return 1 if "$sub($line)" =~ $match }
when ('CODE') { return 1 if $match->($level+1, $pkg, $file, $li
+ne, $sub) }
defult { die "Do not know how to match caller against item of type
+ $_" }
}
return 0;
}
sub _default_obfuscator { "X"x(length($_[0])) }
1;
__END__
=pod
=head1 NAME
SecureString - Obfuscated strings exept when you need them
=head1 SYNOPSIS
use strict;
use SecureString;
# for simple cases (beware passing value from -get() to external modu
+les!):
my $CreditCardNumber = SecureString->new( "1234567887654321" );
say STDERR "DEBUG: Got a CCN ($CreditCardNumber)"; # DEBUG: Got a C
+CN (XXXXXXXXXXXXXXXX)
say "The real CCN: ", $CreditCardNumber->get; # The real CCN:
+1234567887654321
# more complex:
use YAML;
my $CreditCardNumber = SecureString->new( "1234567887654321",
auto_get => qr/^Business::OnlinePayment/, # probably a bit
+ too permissive
allow => "My::Secure::Module",
obfuscator => sub { "XXXXXXXXXXXX".substr($_[0], -4) },
);
my %tx_info = ( card_number => $CreditCardNumber, ... );
print Dump \%tx_info; # "card_number:
+XXXXXXXXXXXX4321"
my $tx = new Business::OnlinePayment("AuthorizeNet");
$tx->content( %tx_info );
$tx->submit; # sends actual c
+ard number to AuthorizeNet
# debugging and diagnosis (stack trace whenever stringified)
# Use stack traces to set appropriate "auto_get" above
my $CreditCardNumber = SecureString->new( "1234567887654321",
cluck => 1,
);
=head1 DESCRIPTION
Creates a value which will be obfuscated unless accessed in a particul
+ar
way. Access can be restricted to specific classes or even specific
subroutines/methods.
There are no methods which unconditionally return the unmasked string
value, thus even code which attempts to walk all defined methods (but
+who
does that!?) will fail to output the unmasked value unless it has been
granted permission.
TODO: Storable and YAML hooks have been defined so that these modules
+can
be safely used with SecureStrings. Patches accepted to support any oth
+er
serialization modules. The unmasked string is stored "inside-out" so t
+hat
at worst, unsupported serialization modules will export only the
non-sensitive configuration data.
=head1 USAGE
=head3 new
=over 4
=item auto_get
ArrayRef or single item describing packages and/or subs for which
stringification should yield the unmasked value. This allows you to pa
+ss
SecureStrings to external dependencies and have them stringify to thei
+r
unmasked value only when necessary.
=item allow
ArrayRef or single item describing packages and/or subs for which call
+ing
the C<get> method will yield the unmasked value. If allow is not speci
+fied,
the C<get> method will always return the unmasked value.
=item obfuscator
CODE reference which takes a sensitive (unmasked) value as its first
argument and returns a safe (masked) value. The default obfuscator ret
+urns
a string of "X"s equal to the length of the sensitive value.
=item masked
Explicitly specify the masked string value.
=item cluck
When "1", stringification will print a stack trace to STDERR for debug
+ging
purposes. May also be an ArrayRef or single item describing packages a
+nd/or
subs for which stringification should print a stack trace.
=back
=head3 set
$str->set( $value )
Set the unmasked string value to C<$value>. ** Note C<$str = $value> i
+s WRONG!
=head3 get
$str->get()
Attempts to get unmasked value. Will silently return the masked value
+if
the C<allow> parameter was set at object construction time and the cur
+rent
caller is not allowed to access the unmasked value.
=head3 get_masked
$str->get_masked()
Unconditionally returns the masked value for all callers.
=head1 CALLER SPECIFICATION
The C<allow>, C<auto_get>, and C<cluck> parameters accept caller
descriptions. These can take the form of:
=over 4
=item string
Must exactly match the immediate caller's C<CLASS>, C<CLASS::SUBNAME()
+>, or
C<CLASS::SUBNAME(LINE_NO)>. For example:
"main" # anywhere in main package
"main::()" # outside any sub in main
"main::foo()" # anywhere in sub foo of package main
"main::(34)" # line 34 outside any sub in main
"main::foo(42)" # line 42 in sub foo of package main
# Similarly for package "My::Class"
"My::Class"
"My::Class::()"
"My::Class::foo()"
"My::Class::(45)"
"My::Class::foo(67)"
Of course, including a line number in the specification is rather frag
+ile
so shouldn't be used in most situations.
=item Regexp
Will be applied to the C<CLASS::SUBNAME(LINE_NO)> form of the caller.
=item CODEREF
Will be passed arguments: $level, $pkg, $file, $line, $sub
from the perspective of the code ref. The level may be used to walk up
+ the
call stack if necessary. Example which matches all authentication meth
+ods
in My::Class:
sub {
my ($level, $pkg, $file, $line, $sub) = @_;
return ( $pkg eq "My::Class" and $sub =~ /^_?authenticate/ );
}
=back
=head3 Inheritance and importing
Class and sub name will always be the class and sub name from the
parent/exporting class. For example:
my $CC = SecureString->new( "12345", cluck => 1 );
package My::Class;
sub foo {
say $CC;
}
foo(); # Attempt to access string value of XXXXX at My
+::Class::foo(62)
package bar;
our @ISA = ("My::Class");
*baz = \&My::Class::foo;
bar->foo(); # Attempt to access string value of XXXXX at My
+::Class::foo(62)
baz(); # Attempt to access string value of XXXXX at My
+::Class::foo(62)
=head1 SERIALIZATION SUPPORT
In general, this module will serialize to the masked value. The one
exception is C<Storable::dclone()> which, like thread cloning, doesn't
really count as serialization and therefore gets a proper copy of the
SecureString object.
When possible, serialization will collapse to a plain (masked) string
though some serialization hooks to not allow changing object type (or
serializing a blessed object to an unblessed scalar) so in these cases
+,
deserialization will construct a SecureString whose masked and unmaske
+d
values are the same (both are the original masked values).
=head2 Stable Support
No serializer hooks are considered stable at this time
=head2 Experimental Support
=head3 Storable
Does not (as far as I can tell) allow changing type to unblessed scala
+r,
thus C<thaw(freeze($secure_string))> will produce a SecureString of th
+e
masked value.
Storable allows dclone to be treated specially. Therefore, since dclon
+e can
not result in accidental information leakage, C<dclone($secure_string)
+>
produces a usable (the unmasked value remains in tact) SecureString.
=head3 YAML
Alas, doesn't work...
=head1 INTERNAL (PRIVATE) METHODS
=head3 _string
Clucks if appropriate then returns masked value unless the auto_get
parameter matches the current caller.
=head3 _number
Simply dies. Numerical overloading calls this so that masked values ar
+e
never used in calculations.
=head3 _show_caller
$self->_show_caller( $message, $level = 1 )
Displays message to STDERR and current caller spec (as would be matche
+d by C<_match_caller>.
=head3 _caller
my ($pkg, $file, $line, $sub) = $self->_caller( $level )
Compute a caller by our definition.
=head3 _match_caller
$self->_match_caller( $match_data, $level = 1 )
Computes caller information and loops over match items attempting to f
+ind
any match. If C<$match_data> is undefined, then match succeeds. If
C<$match_data> is an empty array, the match fails.
=head3 _match_caller_item
$self->_match_caller_item( $match, $level, @caller )
Returns true if C<$match> matches the current C<@caller> (at C<$level>
+).
Can handle scalar, Regexp, or CODE match types. Dies on any other matc
+h
types.
=head3 _default_obfuscator
Returns string of "X"s equal in length to first argument.
=head1 AUTHOR
Dean Serenevy
dean@serenevy.net
http://dean.serenevy.net/
=head1 COPYRIGHT
This module is Copyright (c) 2011 Dean Serenevy. All rights reserved.
You may distribute under the terms of either the GNU General Public Li
+cense
or the Artistic License, as specified in the Perl README file or L<per
+lartistic>.
=head1 DISCLAIMER OF WARRANTY
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+ FOR
THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPR
+ESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK
+AS TO
THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE
SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICI
+NG,
REPAIR, OR CORRECTION.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL
ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTR
+IBUTE
THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR
DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL
DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLU
+DING
BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR L
+OSSES
SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPER
+ATE
WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN
ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.