Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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.

Good Day,
    Dean


In reply to RFC: SecureString - Obfuscated / masked strings exept when you need them by duelafn

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (4)
As of 2024-03-29 12:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found