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

package Mojolicious::Plugin::TagHelpers::MailToChiffre;
use Mojo::Base 'Mojolicious::Plugin';
use Mojo::ByteStream 'b';
use Mojo::Collection 'c';
use Mojo::URL;

our $VERSION = '0.13';

# Cache for generated CSS and JavaScript
has [qw/js css pattern_rotate/];

# Register Plugin
sub register {
  my ($plugin, $app, $plugin_param) = @_;

  # Load random string plugin with specific profile
  $app->plugin('Util::RandomString' => {
    mail_to_chiffre => {
      alphabet => 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ',
      entropy => 128
    }
  });

  delete $plugin->{js};
  delete $plugin->{css};

  # Load parameters from Config file
  if (my $config_param = $app->config('TagHelpers-MailToChiffre')) {
    $plugin_param = { %$config_param, %$plugin_param };
  };

  # Generate method name in case it is not given
  my $method_name = $plugin_param->{method_name} // $app->random_string('mail_to_chiffre');

  # Set pattern shift in case it is not given
  my $pattern_rotate = 2;
  if ($plugin_param->{pattern_rotate} && $plugin_param->{pattern_rotate} =~ /^\d+$/) {
    $pattern_rotate = $plugin_param->{pattern_rotate};
  };
  $plugin->pattern_rotate($pattern_rotate);

  $plugin->{no_inline} = $plugin_param->{no_inline} // undef;

  # Add pseudo condition for manipulating the stash for the fallback
  my $routes = $app->routes;

  # Add fallback shortcut
  $routes->add_shortcut(
    mail_to_chiffre => sub {
      my $r = shift;

      state $name = 'mailToChiffre';

      # In case method name is given, set asset paths
      if ($plugin_param->{method_name}) {

        # Styles
        $r->get('/style.css')->to(
          cb => sub {
            my $c = shift;
            $c->render(
              text   => $c->mail_to_chiffre_css,
              format => 'css'
            );
          }
        )->name($name . 'CSS');

        # Styles
        $r->get('/script.js')->to(
          cb => sub {
            my $c = shift;
            $c->render(
              text   => $c->mail_to_chiffre_js,
              format => 'js'
            );
          }
        )->name($name . 'JS');
      };

      # Fallback path
      $r->under('/:xor/:host')->to(
        cb => sub {
          $plugin->_chiffre_to_mail(shift)
        }
      )->get('/')->name($name)->to(@_);
    }
  );


  # Add obfuscation tag helper
  $app->helper(
    mail_to_chiffre => sub {
      my $c = shift;

      my $address = shift or return b('');

      # Create one time pad
      my $xor = substr($c->random_string('mail_to_chiffre'), 0, length($address));

      # Get embedded code
      my $text;
      if (ref($_[-1]) && ref($_[-1]) eq 'CODE') {
        $text = pop;
      };

      my %param = @_;

      # Split the address and do some encodings
      my $obf_address = b($address)->xml_escape->split('@');
      my $account = $obf_address->first;

      my $host = join '@', @{$obf_address}[1 .. $obf_address->size - 1];

      # Reget the pattern rotate (maybe)
      my $pattern_rotate = $plugin->pattern_rotate;

      # Obfuscate address parts
      $host = $plugin->to_sequence(
        $host,
        $xor,
        $pattern_rotate
      );

      $account = $plugin->to_sequence(
        $account,
        $xor,
        $pattern_rotate
      );

      # Create Mojo::URL for path
      my ($url, $no_fallback);
      if ($routes->lookup('mailToChiffre')) {
        $url = $c->url_for('mailToChiffre', xor => $xor, host => $host);
      }
      else {
        $url = $c->url_for("/$xor/$host");
        $no_fallback = 1;
      };

      # Encrypt certain mail parameters
      foreach (qw/to cc bcc/) {

        # No parameter
        next unless exists $param{$_};

        # Parameter invalid
        unless ($param{$_}) {
          delete $param{$_};
          next;
        };

        # Array for this parameter
        if (ref $param{$_}) {
          my @temp;
          foreach (@{$param{$_}}) {
            push(@temp, $plugin->to_sequence($_, $xor, $pattern_rotate)) if $_;
          };

          # Check if there are converted parameters
          if (@temp) {
            $param{$_} = \@temp;
          }
          # Remove parameter from list
          else {
            delete $param{$_};
          };
        }

        # Single value
        else {
          $param{$_} = $plugin->to_sequence(
            $param{$_},
            $xor,
            $pattern_rotate
          );
        };
      };

      # Return path
      $url->query({sid => $account, %param});

      # Create anchor link
      my $str = qq!

      # No fallback is established
      if ($no_fallback) {

        # Do not establish a URL at all
        if ($plugin->{no_inline}) {
          $str .= qq!href="#" data-href="$url" !;
        }

        # Use javascript fallback
        else {
          $str .= qq!href="javascript:$method_name(false,'$url')" !;
        };
      }

      else {
        $str .= qq!href="$url" !;
      };

      if ($plugin->{no_inline}) {
        $str .= 'class="' . $method_name;
      } else {
        $str .= 'onclick="';
        $str .= 'return true;' if $no_fallback;
        $str .= 'return ' . $method_name . '(this,false)';
      };

      # Obfuscate display string using css
      unless ($text) {
        my ($pre, @post) = split('@', reverse($address));
        $str .= '">' .
          '' . b($pre)->xml_escape . '' .
          '' . b($xor)->split('')->reverse->join . '' .
          c(@post)->join->xml_escape;
      }
      else {
        unless ($plugin->{no_inline}) {
          $str .= ';' . int(rand(50));
        };
        $str .= '">' . $text->();
      };

      $str .= '';

      return b($str);
    }
  );

  # Create css code helper
  $app->helper(
    mail_to_chiffre_css => sub {
      return $plugin->css if $plugin->css;
      my $css;
      if ($plugin->{no_inline}) {
        $css = qq!a.$method_name!;
      } else {
        $css = qq!a[onclick\$='return $method_name(this,false)']!;
      };
      $css = $css . '{direction:rtl;unicode-bidi:bidi-override;text-align:left}'.
        $css . '>span:nth-child(1n+2){display:none}' .
       $css . '>span:nth-child(1):after{content:\'@\'}';
      $plugin->css(b($css));
      return $plugin->css;
    }
  );


  # Create javascript code helper
  $app->helper(
    mail_to_chiffre_js => sub {
      my $c = shift;

      return $plugin->js if $plugin->js;

      # Replacement variables
      my $v = c(qw/o s u c p n t r g f a x e d q b l m k/)->shuffle;

      # Template variables
      my ($i, %v) = (0);
      foreach (qw/obj seq url char pos num str regex string_obj
      from_char_code param_array temp to_seq
      path_array query padded str_len pow bool/) {
        $v{$_} = $v->[$i++];
      };

      # Obfuscate pattern rotate
      my $factor_pattern_rotate = _factorize($plugin->pattern_rotate, $v{pow});

      # Create javascript code
      my $js = qq!function ${method_name}($v{obj},$v{bool}){
  if($v{bool}){
    $v{obj}=document.createElement('a');$v{obj}.href=$v{bool}
  }
  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;
  $v{path_array}=$v{obj}.pathname.match(/([^\\/]+)\\/([^\\/]+)\$/);
  $v{to_seq}=function($v{seq}){
    var $v{pos}=0,$v{num},$v{str}='',$v{char};
    while($v{pos}<$v{seq}.length){
      $v{char}=$v{seq}.charAt($v{pos}++);
      if($v{char}.match(/[A-Za-z]/)){
        $v{str}+=$v{from_char_code}(($v{char}<='Z'?90:122)>=($v{char}=$v{char}.charCodeAt(0)+13)?$v{char}:$v{char}-26)
      }
      else if($v{char}=='-'){
        $v{num}='';
        $v{char}=$v{seq}.charAt($v{pos}++);
        while($v{char}.match(/\\d/)){
      $v{num}+=$v{char};
    $v{char}=$v{seq}.charAt($v{pos}++)
        }
        $v{pos}--;
        $v{str}+=$v{from_char_code}(parseInt($v{num}))
      }
      else return
    }
    $v{str_len}=$v{str}.length;
    $v{padded}=Math.abs(${factor_pattern_rotate}%$v{str_len}-$v{str_len});
    $v{str}=$v{str}.substr($v{padded})+$v{str}.substr(0,$v{padded});
    $v{temp}='';
    for(i=0;i<$v{str_len};i++){
      $v{temp}+=$v{from_char_code}($v{str}.charCodeAt(i)^$v{path_array}\[1\].charCodeAt($v{path_array}\[1\].length%(i+1)))
    }
    return $v{temp}
  };
  while($v{query}){
    $v{query}=$v{query}.replace(/^[\\?\\&]([^\\&]+)/,'');
    $v{temp}=$v{regex}.\$1;
    if($v{temp}.match(/^(sid|b?cc|to)=(.+)\$/)){
      if($v{regex}.\$1=='sid')
        $v{param_array}.push('to='+$v{to_seq}($v{regex}.\$2)+'\@'+$v{to_seq}($v{path_array}\[2\]));
      else $v{param_array}.push($v{regex}.\$1+'='+$v{to_seq}($v{regex}.\$2));
    }else $v{param_array}.push($v{temp}.replace(/\\+/g,' '))
  }
  location.href='ma'+$v{url}+'to:?'+$v{param_array}.join('&');
  return false
}!;
      # csp compliant variant
      if ($plugin->{no_inline}) {
        $js .= qq!
;document.addEventListener("DOMContentLoaded",
  function(){
    document.querySelectorAll(".${method_name}").forEach(
      i=>i.addEventListener(
        "click",function(e){
          e.preventDefault();
          ${method_name}(false,this.href=='#'?this.getAttribute('data-href'):this.href)
        }
      )
    )
  }
)!;
      };

      $js =~ s/\s*\n\s*//g;
      $plugin->js(b($js));
      return $plugin->js;
    }
  );
};


sub _chiffre_to_mail {
  my ($plugin, $c) = @_;
  my $xor = $c->stash('xor');
  my $p = $c->req->url->query;

  # Set header for searc engines
  $c->res->headers->header('X-Robots-Tag' => 'noindex,nofollow');

  # Deobfuscate host
  my $host = $plugin->to_string(
    $c->stash('host'),
    $xor,
    $plugin->pattern_rotate
  );

  # Deobfuscate account
  my $account = $plugin->to_string(
    scalar $p->param('sid'),
    $xor,
    $plugin->pattern_rotate
  );
  $p->remove('sid');

  # Something went wrong
  unless ($host && $account) {
    $c->app->log->warn('Path doesn\'t contain a valid email address');
    return;
  };

  # Create url
  my $url = Mojo::URL->new;
  $url->scheme('mailto');
  $url->path($account . '@' . $host);

  # Deobfuscate further address parameters
  foreach my $type (qw/to cc bcc/) {
    if (my @val = @{$p->every_param($type)}) {

      # Delete obfuscated parameters
      $p->remove($type);

      # Append new deobfuscated parameters
      $p->append($type => [map {
        $plugin->to_string(
          $_,
          $xor,
          $plugin->pattern_rotate
        )
      } @val]);
    };
  };

  $url->query->append($p);

  # Store the deobfuscated mail in the stash
  $c->stash(mail_to_chiffre => $url);

  return 1;
};


# Simple string based xor function with looping key
sub _xor {
  my $str = '';
  for (my $i = 0; $i < length($_[0]); $i++) {
    $str .= substr($_[0], $i, 1) ^ substr($_[1], length($_[1]) % ($i + 1), 1);
  };
  return $str;
};


# Rotate with pattern
sub _rotate {
  my $p = $_[1] % length($_[0]);
  substr($_[0], $p) . substr($_[0], 0, $p)
};


# Unrotate with pattern_rotate
sub _unrotate {
  my $p = abs($_[1] % length($_[0]) - length($_[0]));
  substr($_[0], $p) . substr($_[0], 0, $p);
};


# Obfuscate the pattern shift a little bit
# by simple prime factorization
sub _factorize {
  my $x = shift;
  my %factors;
  foreach (qw/2 3 5 7/) {
    while (!($x % $_)) {
      $factors{$_}++;
      $x = $x / $_;
    };
  };
  my @factors;
  foreach (keys %factors) {
    if ($factors{$_} > 1) {
      push(@factors, $_[0] . '(' . $_ . ',' . $factors{$_} . ')');
    }
    else {
      push(@factors, $_);
    };
  };
  push(@factors, $x) unless $x == 1;
  return join('*', @factors);
};


# Serialize to string
sub to_string {
  shift;
  my $seq = shift or return;
  my ($xor, $p) = @_;

  my ($str, $c, $num);
  my $pos = 0;

  my $length = length $seq;

  # parse sequence
  while ($pos < $length) {
    $c = substr($seq, $pos++, 1);

    # Parse alphabetical character (ROT13)
    if ($c =~ tr/n-za-mN-ZA-M/a-zA-Z/) {
      $str .= $c;
    }

    # Parse number
    elsif ($c eq '-') {
      $num = '';
      $c = substr($seq, $pos++, 1);

      # Collect number segments
      while ($c =~ /[0-9]/) {
        $num .= $c;
        $c = substr($seq, $pos++, 1);
      };

      $pos--;
      $str .= chr($num);
    }

    # Error
    else {
      return;
    };
  };
  return _xor(_unrotate($str, $p), $xor);
};


# Serialize to sequence
sub to_sequence {
  shift;
  my ($s, $k, $p) = @_;

  # _xor is not allowed to be null
  my $src = _rotate(_xor($s, $k), $p);
  my $str;

  # Parse string
  foreach my $c (split('', $src)) {

    # Change alphabetical character (ROT13)
    if ($c =~ /[a-zA-Z]/) {
      $c =~ tr/a-zA-Z/n-za-mN-ZA-M/;
      $str .= $c;
    }

    # Add numerical value
    else {
      $str .= '-' . ord($c);
    };
  };

  return $str;
};


1;


__END__