Generate unreadable Perl code to send messages in a nerdy way

birthday.sh

#!/bin/bash
echo Happy Birthday!!
echo Have some perl:
{ error=$(php ~/scripts/scriptgen.php Happy Birthday $@!! 2>&1 1>&$out); } {out}>&1
echo https://linuxcoffee.com/perl/
if [ -n "$error" ]; then
  echo $error
fi

birthdaymsg.sh

#!/bin/sh
echo Happy Birthday!!
echo Have some perl:
echo '```'
php ~/scripts/scriptgen.php Happy Birthday $@!!
echo '```'
echo https://linuxcoffee.com/perl/

scriptgen.php

<?php

ini_set('default_charset', 'iso-8859-1');

// utf8ize, isoize ideas from: https://stackoverflow.com/q/19361282
function utf8ize($d) {
  $o = [];
  if (is_array($d)) {
    foreach ($d as $k => $v) {
      $o[utf8_encode($k)] = utf8ize($v);
    }
  } else if (is_string ($d)) {
    return utf8_encode($d);
  }
  return $o;
}
function isoize($d) {
  $o = [];
  if (is_array($d)) {
    foreach ($d as $k => $v) {
      $o[utf8_decode($k)] = isoize($v);
    }
  } else if (is_string ($d)) {
    return utf8_decode($d);
  }
  return $o;
}

function makescript ($text) {
  $jochars    = '!"#$%&()*+,-./:;<=>?@[]^_`{|}~\\\'';
  $jocharsext = $jochars.'VlISZoXy';
  $extchars2 = array(161, 166, 168, 171, 175, 176, 177, 178, 179, 180, 183, 184, 185, 186, 187, 215, 247);
  $jocharsext2 = $jochars.implode('', array_map('chr', $extchars2));

  $file = $_SERVER['HOME'] . '/.' . sha1($jochars . $jocharsext . $jocharsext2) . '.json';

  if (file_exists($file)) {
    // Read array if it exists
    $charmap = isoize(json_decode(file_get_contents($file), true));
  } else {

    $jocharmap    = array();
    $jocharmapext = array();
    $charmap      = array();

    foreach (str_split($jochars) as $c) { $jocharmap[$c]=1; }
    foreach (str_split($jocharsext) as $c) { $jocharmapext[$c]=1; }
    foreach (str_split($jocharsext2) as $c) { $jocharmapext2[$c]=1; }

    foreach (array_merge(range(' ', '~'), range(chr(192), chr(255))) as $c) {
      $goodkey = array();
      // catches most
      foreach ($jocharmap as $key=>$v) {
        $encoded = $c^$key;
        if (array_key_exists($encoded, $jocharmap)) $goodkey[] = $key;
      }
      // needed for ascii 40 - 58, ( -> :
      if (empty($goodkey)) {
        foreach ($jocharmapext as $key=>$v) {
          $encoded = $c^$key;
          if (array_key_exists($encoded, $jocharmapext)) $goodkey[] = $key;
        }
      }
      // needed for ascii 192 - 255, À -> ÿ
      if (empty($goodkey)) {
        foreach ($jocharmapext2 as $key=>$v) {
          $encoded = $c^$key;
          if (array_key_exists($encoded, $jocharmapext2)) $goodkey[] = $key;
        }
      }
      $charmap[$c] = $goodkey;
    }

    // Save array
    file_put_contents($file, json_encode(utf8ize($charmap)));
  }

  list($print1, $print2)     = encode('print \'', $charmap);
  list($encoded1, $encoded2) = encode($text."'", $charmap);

  return "''=~('(?{'.('$print1'^'$print2').('$encoded1'^'$encoded2').',\$/})')\n";
}

function encode($in, $map) {
  $out1 = '';
  $out2 = '';
  foreach (str_split($in) as $c) {
    $i = array_rand($map[$c]);
    $out1 .= $map[$c][$i];
    $out2 .= ($c ^ $map[$c][$i]);
  }

  $bs = array('\\' => '\\\\', '\'' => '\\\'');
  return array(strtr($out1, $bs), strtr($out2, $bs));
}

// From https://static.xx.fbcdn.net/rsrc.php/v3iF6G4/y-/l/makehaste_jhash/hdAMjCraxARilFxCjRtJyMBPsztFiorMEUTj4gD32nM82IKcRS8RAGQ4YJAKEtFwK8X7XlZeD7nZYxYnmHecrzcO55gwP2vzvmtl3-5Q2HSlZZoaf_2LWW4FHc7P2kbZZY-9hpveVBZo-f8hEeDO3CzhV_btyorgW382X1nMuwf-13cemDa7fCBBA7TH2OA4ZP0SRurE3kwTpIMWNLRB3Fr-V8kIXlLtFrwGJQeP0_hify2aabXPslfMNiz3TtL6MltGjYB-i7QuGgFiAIiqaM6F51Dy8N.js?_nc_x=7zeYvGhJ2kM
// EmoticonsList -> noncapturingRegexp, remove ^ and $
$fbregex = '/(?:^|[\s\'\".\(])(O:\)(?!\))|O:\-\)(?!\))|0:\)(?!\))|0:\-\)(?!\))|\'\-_\-|:3|o\.O|O_O|o_o|0_0|O\.o|:\'\(|:\'\-\(|3:\)(?!\))|3:\-\)(?!\))|:dog:|\-3\-|:\(|:\-\(|:\[|=\(|\)=|:o|:\-O|:O|:\-o|8\-\)(?!\))|B\-\)(?!\))|=D|:\-D|:D|>:\(|>:\-\(|<3|&lt;3|\^_\^|\^~\^|:\*|:\-\*|\(y\)(?!\))|:like:|\(Y\)(?!\))|T_T|T\-T|ToT|T\.T|:\-\||:\||:v|:V|<\(\"\)(?!\))|>_<|>\.<|:poop:|:\|\]|\(\^\^\^\)(?!\))|:\)(?!\))|:\-\)(?!\))|:\]|\(:|=\)(?!\))|\(=|\-_\-|B\||8\-\||8\||B\-\||8\)(?!\))|\(n\)(?!\))|\(N\)(?!\))|:\+1:|:thumbsup:|:P|:\-P|:\-p|:p|=P|:trans:|:\/|:\-\/|:\\|:\-\\|=\/|=\\|>:o|>:O|>:\-O|>:\-o|;\)(?!\))|;\-\)(?!\))|;\*|;\-\*|;\-P|;P|;\-p|;p|:cheese:|:eyes:|:peek:|:clown:)(?:[\s\'\".,!?\)]|<br>|)/';

array_shift($argv);
$text = implode(' ', $argv);
$text = utf8_decode(strtr($text, array("'" => "\\'")));

//echo makescript($text);

$c = 1;
$perl = '';
while ($perl == '') {
  $perl = makescript($text);
    if (preg_match($fbregex, $perl)) {
    $perl = '';
    $c++;
  }
}

echo utf8_encode($perl);
if ($c > 1) fwrite(STDERR, "$c" . PHP_EOL);

On Facebook, I have been handing out birthday messages via obfuscated Perl for years (2011). They look like this:

Happy Birthday!!
Have some perl:
''=~('(?{'.('.)@._`{'^'^[)@+@\\').('(>,-\'{})[)@[[]~\').*|~|'^'`_\\]^[?@)](?:$^@@]^]_[').',$/})')
https://linuxcoffee.com/perl/

I thought I would publish the code I use to do it.

What's all that weird error= {out} stuff? If the script detects a Facebook smiley, it erases the message and tries again. Just as a curiosity, I have the script tell me how many tries it took.

The name is passed as a parameter to the shell script.

$ birthday.sh longer test to cause FB smiley collision
Happy Birthday!!
Have some perl:
''=~('(?{'.('/])@/\\\\'^'_/@.[|{').('`!],]||).+(@]^~,@.\\;_|_^,(~)@}_@_\\@@=`^_-@,^"^?@@,@,@@@}_\\'^'(@-\\$\\>@\\_@$<\'^@/@;^-\\+;_\\^]/]<!*/%`{"~,@)@;[~\\/,@)_)/.\\~{').',$/})')
https://linuxcoffee.com/perl/
5

It took that one 5 tries to get a message that is smiley-free. Every so often I update the smiley detection code.

The link at the end takes you to a page that you can use to decode the Perl. This is useful if you send a birthday greeting (or whatever message) to someone that does not run Perl programs.

I got the idea from this page. I liked their script, but they only allow A-Z, a-z, space, and double-quotes. I wanted to put !! at the end of the message. Their code has many options for each letter but picks one set for each run. Encode "aaaaaaaaaaa" a couple of times to see what I mean. This PHP script handles all printable ASCII (dec 32 - 126, space through tilde). It randomly selects an encoding for each letter each time.

''=~('(?{'.('+-@.*{'^'[_)@^[').'"'.('!!!!!!!!!!!_'^'@@@@@@@@@@@}').',$/})')

vs

''=~('(?{'.('\\,)@/{\\'^',^@.[[{').('<@=_^>^@_?!['^']!\\>?_?!>^@|').',$/})')

The first time you run the script it will generate the letter pairings. It will save this in a .json file in your home directory. The current file is named .352a2d35373361c97839dfadd97070c8fa837dd6.json. If you change $jochars or $jocharsext, it will generate a new file. You will have to manually delete the old .json file.

birthdaymsg.sh is really similar, but it is for sending the birthday message via Messenger. The code is escaped to prevent Messenger from trying to format the Perl code: * = bold, _ = italics.

The only bug I know about is in how the .json filename is generated. I append $jochars and $jocharsext together and generate an sha1 sum. If you moved the last character from $jochars and put it at the first character of $jocharsext, it would create the same sum, even though the file needs to be regenerated. If you feel the need to move the characters around like that #1 you could put them in a different order or #2 you could manually delete the .json file. Why not fix it? The last update to that list was to add \ and ' in 2018. I have no plans to update either variable.

Enjoy!

I ran into a problem. I could not use diacritics. I wanted to wish a happy birthday to José and had to wish it to Jose instead.

For all printable 7-bit ASCII characters, there is no problem finding two characters to XOR together.

( XOR ` = H
0010 1000 (
0110 0000 `
0100 1000 H

The diacritics I want are available in UTF-8, but I can't XOR two UTF-8 characters and get a valid UTF-8 character out. A 2-byte character will be in this format: 110xxxxx 10xxxxxx. If I XOR two of those together the first byte will start with 000. Since they have to start with 110, that will not create a valid UTF-8 character.

All of the diacritics are already available in ASCII, they are in 'Upper ASCII'. All of the characters start with a binary 1. Those characters are invalid in UTF-8 and must be translated to 2-byte characters.

é        11     10 1001 in ISO-8859-1
é 1100 0011 _ 1010 1001 in UTF-8

The 8-bit character at the top is spaced out to show how it is just wrapped in a UTF-8 coat in the bottom one.

What now? I went with a hybrid solution. I use the single-byte version for the math to create the characters, then swap to UTF-8 to post to Facebook. This means if there is a UTF-8 character in the output it will not run as a Perl program. Since I am usually posting on Facebook, this is not a problem. If you use my decoding page, it will convert to ISO-8859-1 first and then decode just fine. If I need a working Perl program I can convert it with iconv (and back again since my console is UTF-8).

$ iconv -f utf-8//translit -t ISO-8859-1 -o isobirthday.pl birthday.pl
$ perl -Mre=eval isobirthday.pl | iconv -f ISO-8859-1 -t utf-8//translit -
Happy Birthday José!!

Huzzah! Diacritics.