File Coverage

blib/lib/Mojolicious/Plugin/TagHelpers/MailToChiffre.pm
Criterion Covered Total %
statement 176 186 94.6
branch 48 58 82.7
condition 9 14 64.2
subroutine 16 16 100.0
pod 1 3 33.3
total 250 277 90.2


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::TagHelpers::MailToChiffre;
2 2     2   1826 use Mojo::Base 'Mojolicious::Plugin';
  2         5  
  2         13  
3 2     2   476 use Mojo::ByteStream 'b';
  2         13  
  2         85  
4 2     2   12 use Mojo::Collection 'c';
  2         4  
  2         80  
5 2     2   10 use Mojo::URL;
  2         3  
  2         15  
6              
7             our $VERSION = '0.13';
8              
9             # Cache for generated CSS and JavaScript
10             has [qw/js css pattern_rotate/];
11              
12             # Register Plugin
13             sub register {
14 5     5 1 23003 my ($plugin, $app, $plugin_param) = @_;
15              
16             # Load random string plugin with specific profile
17 5         42 $app->plugin('Util::RandomString' => {
18             mail_to_chiffre => {
19             alphabet => 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ',
20             entropy => 128
21             }
22             });
23              
24 5         7457 delete $plugin->{js};
25 5         14 delete $plugin->{css};
26              
27             # Load parameters from Config file
28 5 50       23 if (my $config_param = $app->config('TagHelpers-MailToChiffre')) {
29 0         0 $plugin_param = { %$config_param, %$plugin_param };
30             };
31              
32             # Generate method name in case it is not given
33 5   66     98 my $method_name = $plugin_param->{method_name} // $app->random_string('mail_to_chiffre');
34              
35             # Set pattern shift in case it is not given
36 5         1387 my $pattern_rotate = 2;
37 5 50 33     55 if ($plugin_param->{pattern_rotate} && $plugin_param->{pattern_rotate} =~ /^\d+$/) {
38 5         12 $pattern_rotate = $plugin_param->{pattern_rotate};
39             };
40 5         23 $plugin->pattern_rotate($pattern_rotate);
41              
42 5   100     46 $plugin->{no_inline} = $plugin_param->{no_inline} // undef;
43              
44             # Add pseudo condition for manipulating the stash for the fallback
45 5         24 my $routes = $app->routes;
46              
47             # Add fallback shortcut
48             $routes->add_shortcut(
49             mail_to_chiffre => sub {
50 2     2   2211 my $r = shift;
51              
52 2         6 state $name = 'mailToChiffre';
53              
54             # In case method name is given, set asset paths
55 2 100       8 if ($plugin_param->{method_name}) {
56              
57             # Styles
58             $r->get('/style.css')->to(
59             cb => sub {
60 0         0 my $c = shift;
61 0         0 $c->render(
62             text => $c->mail_to_chiffre_css,
63             format => 'css'
64             );
65             }
66 1         4 )->name($name . 'CSS');
67              
68             # Styles
69             $r->get('/script.js')->to(
70             cb => sub {
71 0         0 my $c = shift;
72 0         0 $c->render(
73             text => $c->mail_to_chiffre_js,
74             format => 'js'
75             );
76             }
77 1         327 )->name($name . 'JS');
78             };
79              
80             # Fallback path
81             $r->under('/:xor/:host')->to(
82             cb => sub {
83 12         133195 $plugin->_chiffre_to_mail(shift)
84             }
85 2         262 )->get('/')->name($name)->to(@_);
86             }
87 5         61 );
88              
89              
90             # Add obfuscation tag helper
91             $app->helper(
92             mail_to_chiffre => sub {
93 18     18   69491 my $c = shift;
94              
95 18 100       70 my $address = shift or return b('');
96              
97             # Create one time pad
98 17         88 my $xor = substr($c->random_string('mail_to_chiffre'), 0, length($address));
99              
100             # Get embedded code
101 17         1845 my $text;
102 17 100 100     88 if (ref($_[-1]) && ref($_[-1]) eq 'CODE') {
103 1         4 $text = pop;
104             };
105              
106 17         86 my %param = @_;
107              
108             # Split the address and do some encodings
109 17         81 my $obf_address = b($address)->xml_escape->split('@');
110 17         1197 my $account = $obf_address->first;
111              
112 17         199 my $host = join '@', @{$obf_address}[1 .. $obf_address->size - 1];
  17         198  
113              
114             # Reget the pattern rotate (maybe)
115 17         135 my $pattern_rotate = $plugin->pattern_rotate;
116              
117             # Obfuscate address parts
118 17         124 $host = $plugin->to_sequence(
119             $host,
120             $xor,
121             $pattern_rotate
122             );
123              
124 17         50 $account = $plugin->to_sequence(
125             $account,
126             $xor,
127             $pattern_rotate
128             );
129              
130             # Create Mojo::URL for path
131 17         32 my ($url, $no_fallback);
132 17 100       90 if ($routes->lookup('mailToChiffre')) {
133 14         300 $url = $c->url_for('mailToChiffre', xor => $xor, host => $host);
134             }
135             else {
136 3         86 $url = $c->url_for("/$xor/$host");
137 3         999 $no_fallback = 1;
138             };
139              
140             # Encrypt certain mail parameters
141 17         7002 foreach (qw/to cc bcc/) {
142              
143             # No parameter
144 51 100       126 next unless exists $param{$_};
145              
146             # Parameter invalid
147 10 100       32 unless ($param{$_}) {
148 1         3 delete $param{$_};
149 1         2 next;
150             };
151              
152             # Array for this parameter
153 9 100       28 if (ref $param{$_}) {
154 3         6 my @temp;
155 3         5 foreach (@{$param{$_}}) {
  3         8  
156 4 50       20 push(@temp, $plugin->to_sequence($_, $xor, $pattern_rotate)) if $_;
157             };
158              
159             # Check if there are converted parameters
160 3 100       11 if (@temp) {
161 2         9 $param{$_} = \@temp;
162             }
163             # Remove parameter from list
164             else {
165 1         3 delete $param{$_};
166             };
167             }
168              
169             # Single value
170             else {
171             $param{$_} = $plugin->to_sequence(
172 6         21 $param{$_},
173             $xor,
174             $pattern_rotate
175             );
176             };
177             };
178              
179             # Return path
180 17         110 $url->query({sid => $account, %param});
181              
182             # Create anchor link
183 17         2072 my $str = qq!
184              
185             # No fallback is established
186 17 100       42 if ($no_fallback) {
187              
188             # Do not establish a URL at all
189 3 100       10 if ($plugin->{no_inline}) {
190 2         8 $str .= qq!href="#" data-href="$url" !;
191             }
192              
193             # Use javascript fallback
194             else {
195 1         4 $str .= qq!href="javascript:$method_name(false,'$url')" !;
196             };
197             }
198              
199             else {
200 14         60 $str .= qq!href="$url" !;
201             };
202              
203 17 100       6786 if ($plugin->{no_inline}) {
204 2         26 $str .= 'class="' . $method_name;
205             } else {
206 15         35 $str .= 'onclick="';
207 15 100       37 $str .= 'return true;' if $no_fallback;
208 15         58 $str .= 'return ' . $method_name . '(this,false)';
209             };
210              
211             # Obfuscate display string using css
212 17 100       39 unless ($text) {
213 16         83 my ($pre, @post) = split('@', reverse($address));
214 16         53 $str .= '">' .
215             '' . b($pre)->xml_escape . '' .
216             '' . b($xor)->split('')->reverse->join . '' .
217             c(@post)->join->xml_escape;
218             }
219             else {
220 1 50       5 unless ($plugin->{no_inline}) {
221 0         0 $str .= ';' . int(rand(50));
222             };
223 1         4 $str .= '">' . $text->();
224             };
225              
226 17         4252 $str .= '';
227              
228 17         53 return b($str);
229             }
230 5         312 );
231              
232             # Create css code helper
233             $app->helper(
234             mail_to_chiffre_css => sub {
235 6 100   6   2971 return $plugin->css if $plugin->css;
236 4         20 my $css;
237 4 100       13 if ($plugin->{no_inline}) {
238 1         4 $css = qq!a.$method_name!;
239             } else {
240 3         13 $css = qq!a[onclick\$='return $method_name(this,false)']!;
241             };
242 4         16 $css = $css . '{direction:rtl;unicode-bidi:bidi-override;text-align:left}'.
243             $css . '>span:nth-child(1n+2){display:none}' .
244             $css . '>span:nth-child(1):after{content:\'@\'}';
245 4         31 $plugin->css(b($css));
246 4         83 return $plugin->css;
247             }
248 5         401 );
249              
250              
251             # Create javascript code helper
252             $app->helper(
253             mail_to_chiffre_js => sub {
254 4     4   2534 my $c = shift;
255              
256 4 50       18 return $plugin->js if $plugin->js;
257              
258             # Replacement variables
259 4         44 my $v = c(qw/o s u c p n t r g f a x e d q b l m k/)->shuffle;
260              
261             # Template variables
262 4         146 my ($i, %v) = (0);
263 4         16 foreach (qw/obj seq url char pos num str regex string_obj
264             from_char_code param_array temp to_seq
265             path_array query padded str_len pow bool/) {
266 76         157 $v{$_} = $v->[$i++];
267             };
268              
269             # Obfuscate pattern rotate
270 4         22 my $factor_pattern_rotate = _factorize($plugin->pattern_rotate, $v{pow});
271              
272             # Create javascript code
273 4         133 my $js = qq!function ${method_name}($v{obj},$v{bool}){
274             if($v{bool}){
275             $v{obj}=document.createElement('a');$v{obj}.href=$v{bool}
276             }
277             var $v{query}=$v{obj}.search,$v{regex}=RegExp,$v{from_char_code}=String.fromCharCode,$v{url}='il',$v{param_array}=[],$v{temp},$v{pow}=Math.pow;
278             $v{path_array}=$v{obj}.pathname.match(/([^\\/]+)\\/([^\\/]+)\$/);
279             $v{to_seq}=function($v{seq}){
280             var $v{pos}=0,$v{num},$v{str}='',$v{char};
281             while($v{pos}<$v{seq}.length){
282             $v{char}=$v{seq}.charAt($v{pos}++);
283             if($v{char}.match(/[A-Za-z]/)){
284             $v{str}+=$v{from_char_code}(($v{char}<='Z'?90:122)>=($v{char}=$v{char}.charCodeAt(0)+13)?$v{char}:$v{char}-26)
285             }
286             else if($v{char}=='-'){
287             $v{num}='';
288             $v{char}=$v{seq}.charAt($v{pos}++);
289             while($v{char}.match(/\\d/)){
290             $v{num}+=$v{char};
291             $v{char}=$v{seq}.charAt($v{pos}++)
292             }
293             $v{pos}--;
294             $v{str}+=$v{from_char_code}(parseInt($v{num}))
295             }
296             else return
297             }
298             $v{str_len}=$v{str}.length;
299             $v{padded}=Math.abs(${factor_pattern_rotate}%$v{str_len}-$v{str_len});
300             $v{str}=$v{str}.substr($v{padded})+$v{str}.substr(0,$v{padded});
301             $v{temp}='';
302             for(i=0;i<$v{str_len};i++){
303             $v{temp}+=$v{from_char_code}($v{str}.charCodeAt(i)^$v{path_array}\[1\].charCodeAt($v{path_array}\[1\].length%(i+1)))
304             }
305             return $v{temp}
306             };
307             while($v{query}){
308             $v{query}=$v{query}.replace(/^[\\?\\&]([^\\&]+)/,'');
309             $v{temp}=$v{regex}.\$1;
310             if($v{temp}.match(/^(sid|b?cc|to)=(.+)\$/)){
311             if($v{regex}.\$1=='sid')
312             $v{param_array}.push('to='+$v{to_seq}($v{regex}.\$2)+'\@'+$v{to_seq}($v{path_array}\[2\]));
313             else $v{param_array}.push($v{regex}.\$1+'='+$v{to_seq}($v{regex}.\$2));
314             }else $v{param_array}.push($v{temp}.replace(/\\+/g,' '))
315             }
316             location.href='ma'+$v{url}+'to:?'+$v{param_array}.join('&');
317             return false
318             }!;
319             # csp compliant variant
320 4 100       15 if ($plugin->{no_inline}) {
321 1         5 $js .= qq!
322             ;document.addEventListener("DOMContentLoaded",
323             function(){
324             document.querySelectorAll(".${method_name}").forEach(
325             i=>i.addEventListener(
326             "click",function(e){
327             e.preventDefault();
328             ${method_name}(false,this.href=='#'?this.getAttribute('data-href'):this.href)
329             }
330             )
331             )
332             }
333             )!;
334             };
335              
336 4         157 $js =~ s/\s*\n\s*//g;
337 4         25 $plugin->js(b($js));
338 4         61 return $plugin->js;
339             }
340 5         339 );
341             };
342              
343              
344             sub _chiffre_to_mail {
345 12     12   45 my ($plugin, $c) = @_;
346 12         49 my $xor = $c->stash('xor');
347 12         141 my $p = $c->req->url->query;
348              
349             # Set header for searc engines
350 12         248 $c->res->headers->header('X-Robots-Tag' => 'noindex,nofollow');
351              
352             # Deobfuscate host
353 12         579 my $host = $plugin->to_string(
354             $c->stash('host'),
355             $xor,
356             $plugin->pattern_rotate
357             );
358              
359             # Deobfuscate account
360 12         45 my $account = $plugin->to_string(
361             scalar $p->param('sid'),
362             $xor,
363             $plugin->pattern_rotate
364             );
365 12         51 $p->remove('sid');
366              
367             # Something went wrong
368 12 50 33     300 unless ($host && $account) {
369 0         0 $c->app->log->warn('Path doesn\'t contain a valid email address');
370 0         0 return;
371             };
372              
373             # Create url
374 12         48 my $url = Mojo::URL->new;
375 12         127 $url->scheme('mailto');
376 12         108 $url->path($account . '@' . $host);
377              
378             # Deobfuscate further address parameters
379 12         2190 foreach my $type (qw/to cc bcc/) {
380 36 100       431 if (my @val = @{$p->every_param($type)}) {
  36         83  
381              
382             # Delete obfuscated parameters
383 8         155 $p->remove($type);
384              
385             # Append new deobfuscated parameters
386             $p->append($type => [map {
387 8         109 $plugin->to_string(
  10         30  
388             $_,
389             $xor,
390             $plugin->pattern_rotate
391             )
392             } @val]);
393             };
394             };
395              
396 12         195 $url->query->append($p);
397              
398             # Store the deobfuscated mail in the stash
399 12         454 $c->stash(mail_to_chiffre => $url);
400              
401 12         225 return 1;
402             };
403              
404              
405             # Simple string based xor function with looping key
406             sub _xor {
407 78     78   169 my $str = '';
408 78         229 for (my $i = 0; $i < length($_[0]); $i++) {
409 894         2389 $str .= substr($_[0], $i, 1) ^ substr($_[1], length($_[1]) % ($i + 1), 1);
410             };
411 78         343 return $str;
412             };
413              
414              
415             # Rotate with pattern
416             sub _rotate {
417 44     44   85 my $p = $_[1] % length($_[0]);
418 44         131 substr($_[0], $p) . substr($_[0], 0, $p)
419             };
420              
421              
422             # Unrotate with pattern_rotate
423             sub _unrotate {
424 34     34   91 my $p = abs($_[1] % length($_[0]) - length($_[0]));
425 34         114 substr($_[0], $p) . substr($_[0], 0, $p);
426             };
427              
428              
429             # Obfuscate the pattern shift a little bit
430             # by simple prime factorization
431             sub _factorize {
432 4     4   25 my $x = shift;
433 4         25 my %factors;
434 4         27 foreach (qw/2 3 5 7/) {
435 16         40 while (!($x % $_)) {
436 10         22 $factors{$_}++;
437 10         24 $x = $x / $_;
438             };
439             };
440 4         9 my @factors;
441 4         14 foreach (keys %factors) {
442 4 50       14 if ($factors{$_} > 1) {
443 4         23 push(@factors, $_[0] . '(' . $_ . ',' . $factors{$_} . ')');
444             }
445             else {
446 0         0 push(@factors, $_);
447             };
448             };
449 4 50       16 push(@factors, $x) unless $x == 1;
450 4         17 return join('*', @factors);
451             };
452              
453              
454             # Serialize to string
455             sub to_string {
456 34     34 0 1921 shift;
457 34 50       97 my $seq = shift or return;
458 34         97 my ($xor, $p) = @_;
459              
460 34         65 my ($str, $c, $num);
461 34         56 my $pos = 0;
462              
463 34         74 my $length = length $seq;
464              
465             # parse sequence
466 34         81 while ($pos < $length) {
467 392         667 $c = substr($seq, $pos++, 1);
468              
469             # Parse alphabetical character (ROT13)
470 392 100       786 if ($c =~ tr/n-za-mN-ZA-M/a-zA-Z/) {
    50          
471 17         32 $str .= $c;
472             }
473              
474             # Parse number
475             elsif ($c eq '-') {
476 375         498 $num = '';
477 375         522 $c = substr($seq, $pos++, 1);
478              
479             # Collect number segments
480 375         896 while ($c =~ /[0-9]/) {
481 690         978 $num .= $c;
482 690         1591 $c = substr($seq, $pos++, 1);
483             };
484              
485 375         489 $pos--;
486 375         883 $str .= chr($num);
487             }
488              
489             # Error
490             else {
491 0         0 return;
492             };
493             };
494 34         86 return _xor(_unrotate($str, $p), $xor);
495             };
496              
497              
498             # Serialize to sequence
499             sub to_sequence {
500 44     44 0 69 shift;
501 44         107 my ($s, $k, $p) = @_;
502              
503             # _xor is not allowed to be null
504 44         103 my $src = _rotate(_xor($s, $k), $p);
505 44         82 my $str;
506              
507             # Parse string
508 44         166 foreach my $c (split('', $src)) {
509              
510             # Change alphabetical character (ROT13)
511 502 100       893 if ($c =~ /[a-zA-Z]/) {
512 22         56 $c =~ tr/a-zA-Z/n-za-mN-ZA-M/;
513 22         46 $str .= $c;
514             }
515              
516             # Add numerical value
517             else {
518 480         783 $str .= '-' . ord($c);
519             };
520             };
521              
522 44         126 return $str;
523             };
524              
525              
526             1;
527              
528              
529             __END__