#!/usr/bin/perl

=head1 NAME

obfuscate-mailto.pl - generates encrypted mailto: links in a javascript include

=head1 SYNOPSIS

 obfuscate-mailto.pl [options] <mailto> [linktext] > getSignature.js

 <script language="JavaScript" src="http://your.domain.com/getSignature.js">
 </script>


If the linktext isn't provided, the mailto will be used in its place.

 e.g. 
   obfuscate-mailto.pl 'Bob Jones <bob@foo.com>'     > /srv/www/getSignature.js
   obfuscate-mailto.pl 'Bob Jones <bob@foo.com>' 'mail Bobby' 

 Options:
   -h|--help      brief help message
   -m|--man       full man page
   -v|--verbose
   -V|--version

=head1 DESCRIPTION

See Tim Williams' discussion on the "How and Why of obfuscating your address"
at http://www.u.arizona.edu/~trw/spam/index.htm. There he proposes
the idea of converting your email address into a seemingly random string 
of characters using a simple substitution cipher, using a <script>..</script> block. 

The advantages to this approach over a verbatim C<mailto:> link are that spambots
using simple regular expression searching for stuff like C</[a-z._-]+@[a-z._-].(com|net|org)/i> won't find it. Spambots have a lot of work to do and it's unlikely that they're going to parse and run javascript hoping to find an email address.  They might conceivably convert HTML character entities or character codes, which is why this method is preferred for the truly paranoid.

My method is an expansion on Tim Williams' idea in that instead of putting the obfuscation into a <script>..</script>, it uses a javascript include to pull in the obfuscation code.  

So you can have a C<mailto:> link on your page by adding this to your html, which
looks like anything I<but> a C<mailto:> link:

 <script language="JavaScript" src="http://your.domain.com/getSignature.js">
 </script>

That has the advantage of keeping your HTML files cleaner, and of adding one
more step to hide from the spambots, that of their having to fetch an additional
file which isn't even HTML.

This C<obfuscate-mailto.pl> script generates output which looks like this:

  coded = "XKA 2. tKN4r ZAKAoMKN4r.3KCn"
  codedlt = "W9Mp WZ 9a fcfNmcTZD.qcW"

  key = "R>jB5LiVpYwI1<btzeGUcEh0KdmsxnMXO@k8yFfauZAQq4Sv3lWDJTCrHN27goP96"

  var decfn = function(str){
        var shift=str.length
        var plain=""
        for (i=0; i<str.length; i++){
                if (key.indexOf(str.charAt(i))==-1){
                        ltr=str.charAt(i)
                        plain+=(ltr)
                } else {
                        ltr = (key.indexOf(str.charAt(i))-shift+key.length) % key.length
                        plain+=(key.charAt(ltr))
                }
        }
        return plain;
  }
  document.write("<a href='mailto:"+decfn(coded)+"'>"+decfn(codedlt)+"</a>")

Take that and put it in a js file, like getSignature.js, on a web server somewhere. 
Link to it with the C<E<lt>script...E<gt>E<lt>/scriptE<gt>> tags as above and you're good to go.


=head1 DOWNLOAD

=for html
<p>
Pick a link that works for you:
<br>
<a href="obfuscate-mailto.pl">obfuscate-mailto.pl</a>
<br>
<a href="obfuscate-mailto.pl.txt">obfuscate-mailto.pl.txt</a>
<p>


=head1 AUTHOR

This is inspired by Tim Williams,
http://www.u.arizona.edu/~trw/spam/spam4.htm
Who says: As for the code it is freeware, use it as you like. If you like it 
please let me know. If you hate it let me know.

This script was written, and the javascript expanded on and the include feature
added 11/2004 by Kevin M. Goess.

=for html <script language="JavaScript" src="http://www.goess.org/cpanSig.js"></script>


=head1 COPYRIGHT AND LICENSE

Copyright 2004 by Kevin M. Goess

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 CHANGES

=over 4

=item

2005-10-29 encoding link text as well, some cleanup

=item 

2004-11-20 Initial version.

=back

=cut

use strict;
use Pod::Usage;
use Getopt::Long;
Getopt::Long::Configure('no_ignore_case');


my $VERSION='0.01';

my ($verbose, $version, $help, $man, $mailto, $linktext);

GetOptions (
                 'v|verbose'       => \$verbose,
                 'V|version'       => \$version,
                 'h|help'          => \$help,
                 'm|man'           => \$man,
);
$version and print "$0 version $VERSION\n" and exit;
$man and pod2usage(-verbose => 2);
$help and pod2usage;

$mailto = shift;
$linktext = shift;

$mailto     || pod2usage("\nerror: mailto is required\n");
$linktext ||= $mailto;

$linktext =~ s/</&lt;/;
$linktext =~ s/>/&gt;/;


my $key = "aZbYcXdWeVfUgThSiRjQkPlOmNnMoLpKqJrIsHtGuFvEwDxCyBzA1234567890@<>";
$key = scramble_key($key);

my $coded_mailto = encode($mailto, $key);
my $coded_linktext = encode($linktext, $key);

my $reversed = decode($coded_mailto, $key);

die "something failed" unless $reversed eq $mailto;


print <<EOL;
coded = "$coded_mailto"
codedlt = "$coded_linktext"

key = "$key"

//watching namespace pollution here
var decfn = function(str){ 
	var shift=str.length
	var plain=""
	for (i=0; i<str.length; i++){
		if (key.indexOf(str.charAt(i))==-1){
			ltr=str.charAt(i)
			plain+=(ltr)
		} else {
			ltr = (key.indexOf(str.charAt(i))-shift+key.length) % key.length
			plain+=(key.charAt(ltr))
		}
	}
	return plain;
}
document.write("<a href='mailto:"+decfn(coded)+"'>"+decfn(codedlt)+"</a>")
EOL

sub scramble_key {
    my ($key) = shift;
    my @key = split('',$key);
    my $skey = '';
    while (@key){
        $skey .= splice(@key,rand(@key),1);
    }
    return $skey;
}
        
sub encode {
     my ($coded, $key) = @_;
     my $strlen=length($coded);
     my $link="";
     my $ltr;
     for (my  $i=0; $i<length($coded); $i++){
         my $char = charAt($coded, $i);
         if (indexOf($key, $char)==-1){
             $ltr=$char;
             $link .=$ltr;
         } else {
             $ltr = (indexOf($key,$char) + $strlen+length($key)+$ARGV[0]) % length($key);

             $link .= charAt($key, $ltr);
         }
     }
     return $link;
}
sub decode {
     my ($coded, $key) = @_;
     my $shift=length($coded);
     my $link="";
     my $ltr;
     for (my  $i=0; $i<length($coded); $i++){
         my $char = charAt($coded, $i);
         if (indexOf($key, $char)==-1){
             $ltr=$char;
             $link .=$ltr;
         } else {
              #                  58          - 37          63
             $ltr = (indexOf($key, $char)-$shift+length($key)) % length($key);
             $link .= charAt($key, $ltr);
         }
     }
     return $link;
}


sub charAt {
    my ($s, $o) = @_;
    my $rc = substr($s,$o,1);;
    #print STDERR "charAt($s, $o) = $rc\n";
    return $rc;
}

sub indexOf {
    my ($s, $c) = @_;

    my @s = split('', $s);
    my $i = 0;
    foreach my $sc (@s) {
        if ($sc eq $c ) {
            #print STDERR "indexOf($s, $c) = $i\n";;
            return $i;
        }
        ++$i;
    }
    return -1;
}