File Coverage

blib/lib/String/Redactable.pm
Criterion Covered Total %
statement 53 64 82.8
branch 3 4 75.0
condition 1 3 33.3
subroutine 15 20 75.0
pod 5 5 100.0
total 77 96 80.2


line stmt bran cond sub pod time code
1 5     5   625202 use v5.20;
  5         24  
2 5     5   2034 use utf8;
  5         1261  
  5         44  
3              
4             package String::Redactable;
5 5     5   2320 use experimental qw(signatures);
  5         10069  
  5         31  
6 5     5   950 use warnings::register;
  5         11  
  5         427  
7              
8 5     5   38 use Carp qw(carp);
  5         9  
  5         312  
9 5     5   716 use Encode ();
  5         17837  
  5         1134  
10              
11             our $VERSION = '0.901';
12              
13             =encoding utf8
14              
15             =head1 NAME
16              
17             String::Redactable - A string that automatically redacts itself
18              
19             =head1 SYNOPSIS
20              
21             use String::Redactable;
22              
23             my $string = String::Redactable->new( $sensitive_text );
24              
25             say $string; # ''
26             say $string->to_str_unsafe; # unredacted text
27              
28             =head1 DESCRIPTION
29              
30             C tries to prevent you from accidentally exposing
31             a sensitive string, such as a password, in a larger string, such as a
32             log message or data dump.
33              
34             When you carelessly use this as a simple string, you get back the
35             literal string C<*redacted data*>. To get the actual string, you call
36             C:
37              
38             $password->to_str_unsafe;
39              
40             This is not designed to completely protect the sensitive data from
41             prying eyes. This is simply the UTF-8 encoded version of the value that
42             is XOR-ed by an object-specific key that is not stored with the object.
43             All of that is undone by C.
44              
45             Beyond that, this module uses L and other tricks to prevent
46             the actual string from showing up in output and other strings.
47              
48             =head2 Notes on serializers
49              
50             C objects resist serialization to the best of
51             their ability. At worst, the serialization shows the internal string
52             for the object, which does not expose the key used to XOR the UTF-8
53             encoded string.
54              
55             Since the XOR keys are not stored in the object (and those keys are
56             removed when the object goes out of scope), these values cannot be
57             serialized and re-inflated. But, that's what you want.
58              
59             =over 4
60              
61             =item * L - cannot use C<$Data::Dump::Freezer> because that
62             requires the
63              
64             =item * L -
65              
66             =item * JSON modules - this supports C
67              
68             =item * YAML -
69              
70              
71             =back
72              
73             =head2 Methods
74              
75             =over 4
76              
77             =item new
78              
79             =cut
80              
81             use overload
82 48     48   12463 q("") => sub { $_[0]->placeholder },
83 0     0   0 '0+' => sub { 0 },
84 0     0   0 '-X' => sub { () },
85              
86 5     0   39 map { $_ => sub { () } } qw(
  45         202  
  0         0  
87             <=> cmp
88             lt le gt ge eq ne
89             ~~
90             )
91 5     5   520 ;
  5         1290  
92              
93             my %keys = ();
94              
95             my $new_key = sub ($class, $length = 512) {
96             state $rc = require List::Util;
97             substr(
98             join( '',
99             List::Util::shuffle(
100             map { List::Util::shuffle( 'A' .. 'Z', 'a' .. 'z', qw(= ! : ;) ) } 1 .. 25
101             )
102             ),
103             0, $length
104             )
105             ;
106             };
107              
108             =item new( STRING )
109              
110             Creates an object that hides that string by XOR-ing it with another string that
111             is not stored in the object, and is not a package variable.
112              
113             This does not mean that the original string can't be recovered in other ways if
114             someone wanted to try hard enough, but it keeps you from unintentionally dumping
115             it into output where it shouldn't be.
116              
117             =cut
118              
119 7     7 1 18517 sub new ($class, $string, $opts={}) {
  7         17  
  7         14  
  7         13  
  7         36  
120 7 50       26 unless( length $string ) {
121 0         0 carp sprintf "Argument to %s::new is zero length", __PACKAGE__;
122 0         0 return;
123             }
124              
125 7   33     43 my $key = $opts->{key} // $new_key->( 5 * length $string );
126              
127 7         105 my $encoded = Encode::encode( 'UTF-8', $string );
128 7         389 my $hidden = ($encoded ^ $key);
129 7         21 my $self = bless \$hidden, $class;
130 7     1   12 { local $SIG{__WARN__} = sub {}; $keys{$self} = $key };
  7         60  
  7         124  
131 7         47 $self;
132             }
133              
134 7     7   20597 sub DESTROY ($self) {
  7         16  
  7         16  
135 7     5   51 local $SIG{__WARN__} = sub {};
136 7         24 delete $keys{$self};
137             }
138              
139             =item placeholder
140              
141             The value that is substituted for the actual string.
142              
143             =cut
144              
145 78     78 1 208630 sub placeholder ( $class ) {
  78         103  
  78         91  
146 78         112 state $rc = require Carp;
147 78 100       17907 Carp::cluck(
148             "Possible unintended interpolation of a redactable string",
149             ) if warnings::enabled();
150 78         779 ''
151             }
152              
153             =item STORABLE_freeze
154              
155             Redact strings used in L.
156              
157             =cut
158              
159 0     0 1 0 sub STORABLE_freeze ($self, $cloning) {
  0         0  
  0         0  
  0         0  
160 0         0 $self->placeholder;
161             }
162              
163             =item TO_JSON
164              
165             Redact the string in serializers that respect C.
166              
167             =cut
168              
169             sub TO_JSON {
170 0     0 1 0 $_[0]->placeholder;
171             }
172              
173             =item to_str_unsafe
174              
175             Returns the string that you are trying to hide.
176              
177             =cut
178              
179 10     10 1 12739 sub to_str_unsafe ($self) {
  10         21  
  10         14  
180 10     2   66 local $SIG{__WARN__} = sub {};
181 10         34 my $encoded = ($$self ^ $keys{$self}) =~ s/\000+\z//r;
182 10         128 Encode::decode( 'UTF-8', $encoded );
183             }
184              
185             =back
186              
187             =head1 TO DO
188              
189              
190             =head1 SEE ALSO
191              
192              
193             =head1 SOURCE AVAILABILITY
194              
195             This source is on Github:
196              
197             http://github.com/briandfoy/string-redactable
198              
199             =head1 AUTHOR
200              
201             brian d foy, C<< >>
202              
203             =head1 COPYRIGHT AND LICENSE
204              
205             Copyright © 2025-2026, brian d foy, All Rights Reserved.
206              
207             You may redistribute this under the terms of the Artistic License 2.0.
208              
209             =cut
210              
211             __PACKAGE__;