File Coverage

blib/lib/Dancer2/Plugin/EncryptID.pm
Criterion Covered Total %
statement 45 45 100.0
branch 11 18 61.1
condition n/a
subroutine 8 8 100.0
pod 3 3 100.0
total 67 74 90.5


line stmt bran cond sub pod time code
1             package Dancer2::Plugin::EncryptID;
2              
3 3     3   932912 use 5.006;
  3         8  
4 3     3   17 use strict;
  3         3  
  3         54  
5 3     3   9 use warnings FATAL => 'all';
  3         6  
  3         89  
6              
7 3     3   1470 use Dancer2::Plugin;
  3         160551  
  3         18  
8 3     3   28140 use Crypt::Blowfish;
  3         2058  
  3         1354  
9              
10             =head1 NAME
11              
12             Dancer2::Plugin::EncryptID - Obfuscate IDs/string in URLs
13              
14             =head1 VERSION
15              
16             Version 0.01
17              
18             =cut
19              
20             our $VERSION = '0.03';
21              
22             =head1 DESCRIPTION
23              
24             This module makes easy to obfuscate internal IDs when using them in a URL given to users.
25             Instead of seeing L
26             users will see L .
27             This will prevent nosy users from trying to iterate all items based on a simple ID in the URL.
28              
29             =head1 CONFIGURATION
30              
31             Configuration requires a secret key at a minimum.
32              
33             Either put this in your F file:
34              
35             plugins:
36             EncryptID:
37             secret: 'my_secret_password'
38              
39             Or set the secret key at run time, with:
40              
41             BEGIN {
42             set plugins => {
43             EncryptID => {
44             secret => 'abc123xyz',
45             padding_character => '!'
46             },
47             };
48             }
49              
50             =cut
51              
52             has secret => (
53             is => 'ro',
54             default => sub {
55             my $self = shift;
56             my $secret = $self->config->{secret} || ':-) - :-)';
57             die "Key must be 8 byte long" if length($secret) < 8;
58             return $secret;
59             }
60             );
61              
62             has padding_character => (
63             is => 'ro',
64             default => sub {
65             my $self = shift;
66             return $self->config->{padding_character} || '!';
67             }
68             );
69              
70             has cipher => (
71             is => 'ro',
72             lazy => 1,
73             default => sub {
74             my $self = shift;
75             return Crypt::Blowfish->new($self->secret);
76             }
77             );
78              
79             =head1 SYNOPSIS
80              
81             package MyApp;
82              
83             use strict;
84             use warnings;
85              
86             use Dancer2;
87              
88             BEGIN { # would usually be in config.yml
89             set plugins => {
90             EncryptID => {
91             secret => 'abc123xyz',
92             padding_character => '!'
93             },
94             };
95             }
96              
97             use Dancer2::Plugin::EncryptID;
98              
99             get '/' => sub {
100              
101             # Any ID (numeric or alpha-numeric) you want to obfuscate
102             my $someid = int(rand(42)+1);
103              
104             my $encoded_id = dancer_encrypt($someid);
105             my $url = request->uri_for("/item/$encoded_id");
106             };
107              
108             get '/item/:encoded_id' => sub {
109              
110             # Decode the ID back to clear-text
111             my $item_id = dancer_decrypt( params->{encoded_id} ) ;
112              
113             return "Showing item '$item_id'";
114             };
115              
116             1;
117              
118             =head1 SUBROUTINES/METHODS
119              
120             =head2 dancer_encrypt
121              
122             C - Encrypt the given ID, returns the encoded hash value.
123             If "PREFIX" is given, it will be added to the ID before encoding.
124             It can be used when decoding to verify the decoded value is valid.
125              
126             =cut
127              
128             plugin_keywords 'dancer_encrypt';
129              
130             sub dancer_encrypt {
131 16     16 1 516 my( $plugin, $text, $prefix ) = @_;
132              
133 16 50       33 warn "Missing Clear text ID parameter" unless defined $text;
134 16 50       21 return unless defined $text;
135              
136             ## Prefix is optional, can be undef
137 16 50       29 $text = $prefix . $text if defined $prefix;
138              
139 16         13 my $min_length = 8;
140 16         21 my $ciphertext_hash = '';
141              
142             #encode an empty string
143 16 100       28 $text = $plugin->padding_character x $min_length if length($text) < 1;
144              
145 16         24 while ( length($text) > 0 ) {
146 20         33 my $sub_text = substr($text,0,$min_length,'');
147 20 100       25 if ( length($sub_text) < 8 ) {
148 8         6 my $left = $min_length - length($sub_text);
149 8         27 $sub_text = ( $plugin->padding_character x ($left % $min_length) ). $sub_text;
150             };
151              
152 20         359 my $ciphertext = $plugin->cipher->encrypt($sub_text);
153 20         340 $ciphertext_hash .= unpack('H16', $ciphertext ) ;
154             }
155 16         57 return $ciphertext_hash;
156             }
157              
158             =head2 dancer_decrypt
159              
160             C - Decrypt the given ID, returns the original (text) ID value.
161              
162             =cut
163              
164             plugin_keywords 'dancer_decrypt';
165              
166             sub dancer_decrypt {
167 15     15 1 536 my( $plugin, $encrypted_hash ) = @_;
168              
169 15 50       29 return unless $plugin->is_valid_encrypt_hash($encrypted_hash);
170              
171 15         29 my $padding_character = $plugin->padding_character;
172 15         13 my $ciphertext = '';
173              
174 15         23 while ( length($encrypted_hash) > 0 ) {
175 19         31 my $sub_text = substr($encrypted_hash,0,16,'');
176 19         46 my $cipherhash = pack('H16', $sub_text );
177 19         307 my $text = $plugin->cipher->decrypt($cipherhash);
178              
179 19         286 $text =~ s/^$padding_character+//;
180 19         73 $ciphertext .= $text;
181             };
182 15         54 return $ciphertext
183             }
184              
185             =head2 is_valid_encrypt_hash
186              
187             C - Return true if given encrypt has is valid
188              
189             =cut
190              
191             plugin_keywords 'is_valid_encrypt_hash';
192              
193             sub is_valid_encrypt_hash {
194 15     15 1 12 my( $plugin, $encrypted_hash ) = @_;
195 15 50       28 return 0 unless length($encrypted_hash);
196 15 50       24 return 0 unless length($encrypted_hash)%16 == 0;
197 15 50       54 return 0 unless $encrypted_hash =~ /^[0-9A-F]+$/i;
198 15         25 return 1;
199             }
200              
201             =head1 AUTHOR
202              
203             Rakesh Kumar Shardiwal, C<< >>
204              
205             =head1 BUGS
206              
207             Please report any bugs or feature requests to C, or through
208             the web interface at L. I will be notified, and then you'll
209             automatically be notified of progress on your bug as I make changes.
210              
211              
212              
213              
214             =head1 SUPPORT
215              
216             You can find documentation for this module with the perldoc command.
217              
218             perldoc Dancer2::Plugin::EncryptID
219              
220              
221             You can also look for information at:
222              
223             =over 4
224              
225             =item * RT: CPAN's request tracker (report bugs here)
226              
227             L
228              
229             =item * AnnoCPAN: Annotated CPAN documentation
230              
231             L
232              
233             =item * CPAN Ratings
234              
235             L
236              
237             =item * Search CPAN
238              
239             L
240              
241             =back
242              
243              
244             =head1 ACKNOWLEDGEMENTS
245              
246              
247             =head1 LICENSE AND COPYRIGHT
248              
249             Copyright 2016 Rakesh Kumar Shardiwal.
250              
251             This program is free software; you can redistribute it and/or modify it
252             under the terms of the the Artistic License (2.0). You may obtain a
253             copy of the full license at:
254              
255             L
256              
257             Any use, modification, and distribution of the Standard or Modified
258             Versions is governed by this Artistic License. By using, modifying or
259             distributing the Package, you accept this license. Do not use, modify,
260             or distribute the Package, if you do not accept this license.
261              
262             If your Modified Version has been derived from a Modified Version made
263             by someone other than you, you are nevertheless required to ensure that
264             your Modified Version complies with the requirements of this license.
265              
266             This license does not grant you the right to use any trademark, service
267             mark, tradename, or logo of the Copyright Holder.
268              
269             This license includes the non-exclusive, worldwide, free-of-charge
270             patent license to make, have made, use, offer to sell, sell, import and
271             otherwise transfer the Package with respect to any patent claims
272             licensable by the Copyright Holder that are necessarily infringed by the
273             Package. If you institute patent litigation (including a cross-claim or
274             counterclaim) against any party alleging that the Package constitutes
275             direct or contributory patent infringement, then this Artistic License
276             to you shall terminate on the date that such litigation is filed.
277              
278             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
279             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
280             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
281             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
282             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
283             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
284             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
285             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
286              
287              
288             =cut
289              
290             1; # End of Dancer2::Plugin::EncryptID