#!/usr/bin/perl
#
# Copyright 2009 Graphcomp - ALL RIGHTS RESERVED
#
# Author: Bob Free - bfree@graphcomp.com

our $DEBUG = 0;
our $SiteID = 2;

my $params = $ENV{'QUERY_STRING'};

use CGI;
use MIME::Base64;
use Digest::MD5;

our @EncodeEscapes = split('',q{ !"*'();:@&=+$,/?%#[]});
our $EncodeEscapeCount = scalar(@EncodeEscapes);

# Set up mail gateway and DB
my($gateway,$dbname);
if ($ENV{HTTP_HOST} ne 'graphcomp.org')
{
  use lib "/services/webpages/util/g/c/gc_admin.site.aplus.net/";
  $gateway = '/usr/sbin/sendmail';
}
else
{
  $gateway = 'smtp.sbcglobal.net';
}

my $cgi = new CGI();
my $udid = $cgi->param('udid') || $cgi->url_param('udid');
my $seed = $cgi->param('seed') || $cgi->url_param('seed');
my $appv = $cgi->param('appv') || $cgi->url_param('appv');

my($count,$challenge,$delta,$client,$model,$version,$locale,$deviceName,$rest,$check);
my $from_iphone = isIPhone($udid,$seed,$appv);

# if not from iPhone display instructions
if (!$from_iphone)
{
  displayForm();
  exit 0;
}

my $appVer = $appv;
$appVer =~ s|_| |g;
my($app,$ver) = split('-',$appVer);

# Connect to DB
use gcLib::DBX;
my $db = new gcLib::DBX('graphcomp',1);
if(!$db)
{
  displayError("Unable to access user records at this time - please try again later");
  exit 0;
}
my $dbh = $db->{dbh};

# Check for product
my($prodID) =
  $db->QueryRow("select ID,SKU from Products where Name='$app'");

if (!$prodID)
{
  # Add product, if not already there
  $db->Exec("insert Products set Name='$app'");

  ($prodID) =
  $db->QueryRow("select ID from Products where Name='$app'");
  if (!$prodID)
  {
    displayError("Unable to access product records at this time - please try again later");
    exit 0;
  }
}

# Check for installation
my($instID,$contactID,$devName,$devStatus) =
  $db->QueryRow("select ID,ContactID,DeviceName,Status from Installation where DeviceID='$udid'");

our $is_tester = (defined($devStatus) && ($devStatus & 2));

if (!$instID)
{
  # Add installation, if not already there
  $db->Exec(qq
  {
insert Installation set
DeviceID='$udid',
Model='$model',
OS='MacOS iPhone SDK',
OSVersion='$version',
Locale='$locale',
DeviceName='$deviceName',
Status=1;
  });

  ($instID) =
  $db->QueryRow("select ID from Installation where DeviceID='$udid'");
  if (!$instID)
  {
    displayError("Unable to access installation records at this time - please try again later");
    exit 0;
  }
}
else
{
  # Update installation
  $db->Exec(qq
  {
update Installation set
OSVersion='$version',
Locale='$locale',
DeviceName='$deviceName'
where ID=$instID;
  });
}

# Check for product installation
my($prodInstID) =
  $db->QueryRow(qq
  {
select ID from ProductInstallation
where ProductID=$prodID and InstallationID=$instID;
  });

if (!$prodInstID)
{
  # Add product installation, if not already there
  $db->Exec(qq
  {
insert ProductInstallation set
productID=$prodID,
InstallationID=$instID,
ProductVersion='$ver',
FirstContact=now(),
LastContact=now(),
WanIP='$ENV{REMOTE_ADDR}',
LanIP='$client';
  });
}
else
{
  # Update product installation
  $db->Exec(qq
  {
update ProductInstallation set
ProductVersion='$ver',
LastContact=now(),
WanIP='$ENV{REMOTE_ADDR}',
LanIP='$client'
where ID=$prodInstID;
  });
}

# Get Subscription IDs
our($newsSubID) = $db->QueryRow("select ID from Subscriptions where Name='iPhone News'");
our($betaSubID) = $db->QueryRow("select ID from Subscriptions where Name='iPhone Beta Application'");
our($testSubID) = $db->QueryRow("select ID from Subscriptions where Name='iPhone Beta testers'");

# Has contact ID
my($oldEmail,$verified,$newsID,$optin_news,$betaID,$optin_beta,$updates);
$optin_news = 1;
$optin_beta = 0;
if ($contactID)
{
  # Check email
  ($oldEmail,$verified) = $db->QueryRow("select Email,Validated from Contacts where ID=$contactID");
}

my $news = $cgi->param('news') || $cgi->url_param('news');
my $beta = $cgi->param('beta') || $cgi->url_param('beta');
my $email = lc($cgi->param('email') || $cgi->url_param('email'));
my $submit = $cgi->param('submit') || $cgi->url_param('submit');

# Populate form
if (!$submit)
{
  $email = $oldEmail;
  $news = $optin_news ? 'YES' : '';
  $beta = $optin_beta ? 'YES' : '';

  displayForm();
  exit 0;
}


#print "Content-type: text/html\n\n";


# Check for email
if (!$email)
{
  displayError('You must supply an email address');
  exit 0;
}

# Test email
my($ename,$domain);
if ($email =~ m|([^\@+]\@(.+\..+))|)
{
    $ename = $1;
    $domain = $2;
}
if (!$ename || !$domain)
{
  displayError('You must supply a valid email address');
  exit 0;
}

# Set up email
use gcLib::Send;
my $gw = new gcLib::Send($gateway);

# Check for existing email
my($existID) = $db->QueryRow("select ID from Contacts where Email='$email'");
if ($existID)
{
  if (!$contactID)
  {
    linkAccounts($existID,$instID,$email);
    exit 0;
  }
  elsif ($contactID != $existID)
  {
    switchAccounts($existID,$instID,$oldEmail,$email);
    exit 0;
  }
}

# Create new member
if (!$contactID)
{
  use gcLib::Auth;
  my $auth = new gcLib::Auth();

  newMember($auth,$instID,$ename,$email,$ENV{REMOTE_ADDR});
  exit 0;
}

# Existing member
$updates = updateSubscriptions($contactID);

if ($oldEmail ne $email)
{
  if (!$oldEmail || !$verified)
  {
    updateEmail($contactID,$email);
  }
  else
  {
    changeEmail($contactID,$oldEmail,$email);
  }
}
elsif (!$verified)
{
  verifyEmail($contactID,$email);
  displayStatus("An email has been sent to $email for verification");
}
elsif ($updates)
{
  displayStatus('Your subscription status has been updated');
}
else
{
  displayStatus('No change to subscriptions');
}
exit 0;



sub isIPhone
{
  my($udid,$seed,$appv) = @_;
  debugDie('No UDID') if (!$udid);
  debugDie('No seed') if (!$seed);
  debugDie('No appv') if (!$appv);
  debugDie('Bad UDID format') if (!validateUDID($udid));
 
  my $appVer = $appv;
  $appVer =~ s|_| |g;
  my($app,$ver) = split('-',$appVer);

  my $decode = Swizzle($appv.'graphcomp'.$udid,$seed);
  #print "$decode<p/>\n";

  #my $data = UrlDecode($decode);
  my $data = decode_base64($decode);
  #print "$data<p/>\n";

  ($count,$challenge,$delta,$client,$model,$version,$locale,$deviceName,$rest) =
    split('\|',$data,9);
#  print "Content-type: text/html\n\n<p/><font color=\"#FF0000\"><b>".
#    "$count,$challenge,$delta,$client,$model,$version,$locale,$deviceName,$rest</b></font><p/>\n";

  my $len = length($rest);
  #print "$count, $len<p/>\n";
  debugDie("Invalid seed markers: $count,$len") if ($count != $len);

  # Test challenge
  my $life = 10;
  my $time = time();
  my $stamp = int(($time-$delta)/$life);

  my $md5 = new Digest::MD5();
  $md5->add('graphcomp');
  $md5->add($ENV{HTTP_HOST});
  $md5->add($ENV{REMOTE_ADDR});
  $md5->add($stamp);
  $md5->add($client);
  $check = uc($md5->hexdigest());

  #print "challenge: $challenge, $check<p/>\n";
  return debugDie("Invalid challenge match: $challenge,$check") if ($challenge ne $check);
#if ($challenge ne $check)
#{
#  print qq
#  {Content-type: text/html\n\n
#<font color="#FF0000"><b><p/>
#challenge: $challenge, $check<p/>
#$delta<br/>
#$ENV{HTTP_HOST}<br/>
#$ENV{REMOTE_ADDR}<br/>
#$stamp<br/>
#$client<p/>
#</b></font>
#  };
#  return 0;
#}

  return $model =~ m/^(iPhone|iPod)/;
}

sub validateUDID
{
  my($code) = @_;
  return $code =~ m|^[a-f0-9]{40}$|;
}

sub updateSubscriptions
{
  my($contactID) = @_;
  my $updates = 0;

  # Check News subscription
  ($newsID,$optin_news) = $db->QueryRow(qq
  {
select ID,OptIn
from Subscribers
where ContactID=$contactID and
SubscriptionID=$newsSubID;
  });
  $optin_news = 1 if (!defined($optin_news));

  my $new_news = ($news eq 'YES') ? 1 : 0;
  if (!$newsID)
  {
    # Add subscription, if not already there
    $db->Exec(qq
    {
insert Subscribers set
contactID=$contactID,
SubscriptionID=$newsSubID,
OptIn=$new_news;
    });
    $updates++;
  }
  else
  {
    # Update subscription
    $db->Exec(qq
    {
update Subscribers set
OptIn=$new_news
where ID=$newsID;
    });
    $updates++ if ($optin_news != $new_news);
  }
  $optin_news = $new_news;


  # Check Beta subscription
  ($betaID,$optin_beta) = $db->QueryRow(qq
  {
select ID,OptIn
from Subscribers
where ContactID=$contactID and
SubscriptionID=$betaSubID;
  });
  $optin_beta = 0 if (!defined($optin_beta));

  my $new_beta = ($beta eq 'YES') ? 1 : 0;
  if (!$betaID)
  {
    # Add subscription, if not already there
    $db->Exec(qq
    {
insert Subscribers set
contactID=$contactID,
SubscriptionID=$betaSubID,
OptIn=$new_beta;
    });
    $updates++;
  }
  else
  {
    # Update subscription
    $db->Exec(qq
    {
update Subscribers set
OptIn=$new_beta
where ID=$betaID;
    });
    $updates++ if ($optin_beta != $new_beta);
  }
  $optin_beta = $new_beta;

  return $updates;
}

sub updateEmail
{
  my($contactID,$email,$oldEmail) = @_;

  my $save = "LastValidEmail='$oldEmail'," if ($oldEmail);

  # Update email
  $db->Exec(qq
  {
update Contacts set $save
Email='$email',
Validated=0
where ID=$contactID;
  });

  verifyEmail($contactID,$email);
}

sub verifyEmail
{
  my($contactID,$email) = @_;

  my $params = Package('graphcompiphoneactivate',"$contactID,$email");
  my $url = "http://clydomania.com/activate.cgi?req=$params";

  my $text = MakeUpdateText($url);
  my $html = MakeUpdateHtml($url);

  $gw->Send('iphone@graphcomp.com',$email,'Clydomania Activation',$text,$html);

  displayStatus(qq
  {
An email has been sent to $email for verification; follow the email instructions
in order to activate your Clydomania account.
  });
}

sub oldEmail
{
  my($contactID,$oldEmail,$email) = @_;
  my $params = Package('graphcompiphonebadrequest',"$contactID,$oldEmail,$email");
  my $url = "http://clydomania.com/badrequest.cgi?req=$params";

  my $text = qq
  {
A request has been made from an $model ($deviceName) to update
your Clydomania account from $oldEmail to $email.

You will receive a second email at $email to verify your new email address.


If this request did _not_ originate from you, please browse to the following URL:

    $url

Thank you for notifying us in this matter.
  };

  my $html = qq
  {
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
</head>
<body>
A request has been made from an $model (<b>$deviceName</b>) to update
your Clydomania account from <b>$oldEmail</b> to <b>$email</b>.
<p/>

You will receive a second email at $email to verify your new email address.
<p/>&nbsp;<p/>

If this request did <b><i>not</i><b> originate from you, please
<a href="$url">Notify Us</b></a>.

Thank you for your asistance in this matter.
  };

  $gw->Send('iphone@graphcomp.com',$oldEmail,'Clydomania Email Change',$text,$html);
}

sub displayForm
{
  header();
  form();
  footer();
}

sub displayStatus
{
  my($status) = @_;
  my $msg = qq{<font color="#00FF00">$status</font>};
  header($msg);
  form();
  footer();
}

sub displayError
{
  my($status) = @_;
  my $msg = qq{<font color="#FF0000">$status</font>};
  header($msg);
  form();
  footer();
}

sub displayThanks
{
  my $path = $ENV{SCRIPT_NAME};
  $path =~ s|^/(.*)/[^/]+&|$1/thanks.cgi|;
  print "Location: http://$ENV{HTTP_HOST}/$path?$params\n\n";
}

# Change email for a contact linked to this device
sub changeEmail
{
  my($contactID,$oldEmail,$email) = @_;
  oldEmail($contactID,$oldEmail,$email);
  updateEmail($contactID,$email,$oldEmail);
}

# Create a new member linked to this device
sub newMember
{
  my($auth,$instID,$ename,$email,$ip) = @_;

  my $uname = '';
  my $temp = $ename;
  my $i = 1;
  while (1)
  {
    my($uhash) = $db->QueryRow("select UserHash from Contacts where UserName='$temp'");
    last if (!$uhash);
    $temp = $uname.++$i;
  }
  $uname = $temp;

  $db->Exec(qq
  {
insert Contacts set
UserName='$uname',
Email='$email',
LastIP='$ip',
BlockMail=1,
Validated=0,
ProfilePublic=0,
StartDate=now()
  });

  my($ID,$StartDate) = $db->QueryRow("select ID,StartDate from Contacts where UserName='$uname'");
  if (!$ID)
  {
    displayError('Unable to add new user - try again later');
    exit 0;
  }

  my $sID = 0;
  my($gID) = $db->QueryRow("select ID from Groups where Name='member'");
  if ($gID)
  {
    $db->Exec("insert GroupMembers set ContactID=$ID,GroupID=$gID,SiteID=$SiteID");
  }

  my $uhash = $auth->GenUserHash($ID,$StartDate);
  my $paswd = $auth->GenPassword();
  my $phash = $auth->GenPasswordHash($uhash,$paswd);

  $db->Exec(qq
  {
update Contacts set 
UserHash='$uhash',
PassHash='$phash'
where ID=$ID
  });

  $db->Exec("update Installation set ContactID=$ID where ID=$instID");

  updateSubscriptions($ID);

  my $params = Package('graphcompiphoneactivate',"$ID,$email");
  my $url = "http://clydomania.com/activate.cgi?req=$params";

  my $text = qq
  {
Welcome to Clydomania!

Verifying your email allows you to subscribe to our newsletters, receive
info on updates and apply to receive early betas.

If you have the full version of Clydomania, you can submit and download
animations, as well as browse and vote for your favorite Clydomania animations.


To activate your account, please browse to the following URL:

    $url


Thank you for Joining Clydomania.
Please visit our site at http://clydomania.com/

Clydomania is brought to you by Grafman Productions, a subsidiary of
Graphcomp.  Clydomania, Clydomania Lite and Grafman Productions are
trademarks of Graphcomp.
  };

  my $html = qq
  {
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
</head>
<body>
Welcome to Clydomania!
<p/>

Verifying your email allows you to subscribe to our newsletters, receive
info on updates and apply to receive early betas.
<p/>

If you have the full version of Clydomania, you can submit and download
animations, as well as browse and vote for your favorite Clydomania animations.
<p/>&nbsp;<p/>

To use these services, please <a href="$url">Activate</a> your account.
<p/>&nbsp;<p/>

Thank you for Joining Clydomania.
<p/>
Please visit our site at <a href="http://clydomania.com/">clydomania.com</a>
<p/>

Clydomania is brought to you by Grafman Productions, a subsidiary of
Graphcomp.  Clydomania, Clydomania Lite and Grafman Productions are
trademarks of Graphcomp.
  };

  $gw->Send('iphone@graphcomp.com',$email,'Clydomania Activation',$text,$html);

  displayStatus(qq
  {
An email has been sent to $email for verification; follow the email instructions
in order to activate your Clydomania account.
  });
}

# Link this device to an existing contact
sub linkAccounts
{
  my($existID,$instID,$email) = @_;

  my $new_news = ($news eq 'YES') ? 1 : 0;
  my $new_beta = ($beta eq 'YES') ? 1 : 0;

  my $params = Package('graphcompiphoneswitch',"$existID,$instID,$email,undef,
    $newsSubID,$new_news,$betaSubID,$new_beta");
  my $url = "http://clydomania.com/switch.cgi?req=$params";

  my $text = qq
  {
A request has been made from an $model ($deviceName) to link this
device to your existing Clydomania account $email.

To approve this change, please browse to:

    $url

If this request did not originate from you, please email
the above link to iphone\@graphcomp.com with the subject 'Invalid Change Request',
or simply ignore this message.
  };

  my $mailto = UrlEncode('mailto:iphone@graphcomp.com?subject="Invalid Change Request"&body='.$url);

  my $html = qq
  {
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
</head>
<body>
A request has been made from an $model (<b>$deviceName</b>) to link
this device to your existing Clydomania account <b>$email</b>.
<p/>

If you initiated this change, please:

<ul>
<a href="$url">Approve Link</a> to <b>$email</b>
</ul>

If this request did not originate from you, please
<a href="$mailto">Notify Us</a>,
or simply ignore this message.
  };

  $gw->Send('iphone@graphcomp.com',$email,'Clydomania Email Change Request',$text,$html);

  displayStatus(qq
  {
An email has been sent to <b>$email</b> for verification.<br/>
Follow the email instructions<br/>
to approve this change.
  });
}

# Switch contacts linked to this device
sub switchAccounts
{
  my($existID,$instID,$oldEmail,$email) = @_;
  oldEmail($existID,$oldEmail,$email);

  my $new_news = ($news eq 'YES') ? 1 : 0;
  my $new_beta = ($beta eq 'YES') ? 1 : 0;

  my $params = Package('graphcompiphoneswitch',"$existID,$instID,$email,$oldEmail,
    $newsSubID,$new_news,$betaSubID,$new_beta");
  my $url = "http://clydomania.com/switch.cgi?req=$params";

  my $text = qq
  {
A request has been made from an $model ($deviceName) to update
your Clydomania email from $oldEmail to $email.

To approve this change, please browse to:

    $url

If this request did not originate from you, please email
the above link to iphone\@graphcomp.com with the subject 'Invalid Change Request',
or simply ignore this message.
  };

  my $mailto = UrlEncode('mailto:iphone@graphcomp.com?subject="Invalid Change Request"&body='.$url);

  my $html = qq
  {
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
</head>
<body>
A request has been made from an $model (<b>$deviceName</b>) to update
your Clydomania email from $oldEmail to $email.
<p/>

If you initiated this change, please:

<ul>
<a href="$url">Approve Change</a> from <b>$oldEmail</b> to <b>$email</b>
</ul>

If this request did not originate from you, please
<a href="$mailto">Notify Us</a>,
or simply ignore this message.
  };

  $gw->Send('iphone@graphcomp.com',$email,'Clydomania Email Change Request',$text,$html);

  displayStatus(qq
  {
A courtesy notice has been sent to your current email $oldEmail;<br/>
a second email has been sent to <b>$email</b> for verification.<br/>
Follow the email instructions<br/>
to approve this change.
  });
}

sub MakeUpdateText
{
  my($url) = @_;

  my $text = qq
  {
A request has been made from an $model ($deviceName) to update
your Clydomania subscription status.

Please activate this account by browsing to:

    $url

Once activated, you will received news and notifications based on your
selected opt-in status.

When using the full version of Clydomania, activation also allows you to
share, download and vote for your favorite animations from your $model.

Visit our site at http://clydomania.com/

If this request did not originate from you, please email
the above link to iphone\@graphcomp.com with the subject 'Invalid Activation Request',
or simply ignore this message.
  };

  return $text;
}

sub MakeUpdateHtml
{
  my($url) = @_;

  my $mailto = UrlEncode('mailto:iphone@graphcomp.com?subject=Invalid Activation Request&body='.$url);

  my $html = qq
  {
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
</head>
<body>
A request has been made from an $model (<b>$deviceName</b>) to update
your Clydomania subscription status.
<p/>

Please activate your Clydomania account:

<ul>
<a href="$url">Activate <b>$deviceName</b></a>
</ul>

Once activated, you will received news and notifications based on your
selected opt-in status.
<p/>

When using the full version of Clydomania, activation also allows you to
share, download and vote for your favorite animations from your $model.
<p/>

Visit our site at <a href="http://clydomania.com/">clydomania.com</a>
<p/>

If this request did not originate from you, please
<a href="$mailto">Notify Us</a>,
or simply ignore this message.
  };

  return $html;
}

sub header
{
  my($status) = @_;
  $status = '&nbsp;' if (!$status);

  print qq
  {Content-type: text/html; charset=UTF-8

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
<meta name="viewport" content="width=320">
<meta http-equiv="imagetoolbar" content="no">
<title>Clydomania - SignUp</title>
<meta name="description" content="Clydomania - SignUp">
<meta name="keywords" content="Graphcomp,Grafman Productions,iPhone,Clydomania,SignUp,Register">
<style>
a{color:#A5C6EF; text-decoration:none;}
td{color:#FFFFFF;}
</style>
</head>
<body bgcolor="#000000">
<center><table width="320"><tr><td><center>

<img src="clydomania.png" width="57" height="57" border="0" align="middle"/>
<b><font size="+2">Clydomania</font></b>
<img src="clydomania.png" width="57" height="57" border="0" align="middle"/>
<p/>

<b><a href="info.cgi">Info</a> | <a href="help.cgi">Tips</a> | SignUp</b>
</center>
<p/>&nbsp;<p/>

<center><b>$status</b></center>
<p/>
  };
}

sub footer
{
  print qq
  {
<p/>
<center>
<b>Clydomania</b> is brought to you by<br/>
<b><a href="http://graphcomp.com/iPhone/grafman/">Grafman Productions</a></b><p/>
a subsidiary of <b><a href="http://graphcomp.com/iPhone/">Graphcomp</a></b>
<p/>

<a href="http://graphcomp.com/grafman/"><img src="grafman.gif" width="30" height="30" border="0"/></a>

</center></td></tr></table></center>
</body>
</html>
  };
}

sub form
{
  if (!$verified && !$submit)
  {
    print qq
    {
Sign up for Beta releases, or to receive
grafman's newsletter.<p/>
    };
  }

  if ($from_iphone)
  {
    my $news_check = ($optin_news ? 'checked' : '');
    my $beta_check = ($optin_beta ? 'checked' : '');

    my $beta_string;
    if ($is_tester)
    {
      $beta_string = qq
      {
<input name="beta" type="checkbox" value="YES" checked disabled color="#00FF00" />
<font color="#00FF00">Approved</font> Beta Tester<p/>
      };
    }
    else
    {
      $beta_string = qq
      {
<input name="beta" type="checkbox" value="YES" $beta_check/>
Apply to receive early Betas<p/>
      };
    }

    my $email_status = ($verified ? '<font color="#00FF00">verified</font>' :
      '<font color="#FF0000">unverified</font>') if ($email);

    print qq
    {
<center><table><tr><td>
<form method="POST" action="signup.cgi">
<input name="news" type="checkbox" value="YES" $news_check/> Receive news about updates<p/>
$beta_string
email address: $email_status<br/>
<input name="email" type="text" value="$email" width="80"/>&nbsp;<input name="submit" type="submit" value="Update">
</form>
</td></tr></table></center>
    };

    if (!$verified && !$submit)
    {
      print qq
      {
Your email address will be used for no purpose other than to inform you of updates
and give you access to your online account; it will not be shared, distributed
nor sold.<p/>
You may unsubscribe by unchecking the above boxes and pressing Update.
      };
    }
  }
  else
  {
    print qq
    {
In order to sign up, please use <b>Clydomania</b><br/>
from your iPhone or iPod Touch
    };
  }
}


sub Package
{
  my($key,$string) = @_;

  $string = encode_base64($string);
  $string =~ s|[\r\n]+||g;
  $string = Swizzle($key,$string);
  $string = UrlEncode($string);

  return $string;
}

sub UrlEncode
{
  my($string) = @_;

  my @chars = split('',$string);

  my $out = "";
  foreach my $char (@chars)
  {
    my $k = ord($char);
    next if (($k < 0) || ($k > 255));

    my $e = 0;
    if ($k < 128)
    {
      for ($e=0; $e<$EncodeEscapeCount; $e++)
      {
        last if ($k == ord($EncodeEscapes[$e]));
      }
    }
		
    if ($e < $EncodeEscapeCount)
    {
      $out .= sprintf("%%%02X",$k);
    }
    else
    {
      $out .= $char;
    }
  }

  return($out);
}

sub UrlDecode
{
  my($string) = @_;

  my @chars = split('%(..)',$string);

  my $pos = 0;
  my $out = "";
  foreach my $char (@chars)
  {
    if (++$pos & 1)
    {
      $out .= $char;
    }
    else
    {
      $out .= chr(hex($char));
    }
  }

  return $out;
}

sub Swizzle
{
  my($key,$str) = @_;

  my $keyLength = length($key);
  my $strLength = length($str);

  my @keyChars = split('',$key);
  my @strChars = split('',$str);

  my $out = "";
  my $mid = int($strLength / 2);
  for (my $i=0; $i<$strLength; $i++)
  {
    my $code = ord($strChars[$i]) - 32;
    $code = 233 if ($code < 0);
    $code ^= ord($keyChars[($mid+$strLength-$i)%$keyLength]) >> 5;
    $code += 32;
    $out .= chr($code);
  }

  return $out;
}

sub debugDie
{
  my($msg) = @_;
  return 0 if (!$DEBUG);
  print "Content-type: text/html\n\n<font color=#FF0000><b>$msg</b></font>";
  exit 0;
}