However, I always thought it might be possible to extend the program to hide
2 separate "hidden messages" within the program, so I procrastinated until I could get the motivation to work on it further.
The program is called 'latent.pl', and it requires the Image::Magick module. When run using just a .jpg or .gif image, only a simple html webpage
is written (with the same basename as the image file). If given one or two text files, containing "images" of space vs. non-space characters, it "hides" the image(s) within an output Perl script (also with the same basename as the image file, but with a '.pl' extension).
Here is an example of one of the text files I created for the "Happy New Year" obfuscation:
#!/usr/bin/perl -w
#
# Takes 2 files, a jpeg picture and one or two "hidden" bitmask-pictu
+res
# (containing '@' and spaces), and creates an obfuscated-perl program
+ which,
# when run, displays either of the bitmask-pictures, or the original
+picture,
# depending on the argument given.
#
# 050922 liverpole -- created
# 060101 liverpole -- modified to accommodate 0, 1 or 2 hidden images
# 060102 liverpole -- fixed a bug in the interpretation of xpm shades
#
####################
### User-defined ###
####################
my $black_limit = 30; # Less than this value is assumed black
my $white_limit = 225; # Greater than this value is assumed whi
+te
my $rows_per_pixel = 3; # Increase this to make picture shorter
my $cols_per_pixel = 2; # Increase this to make picture narrower
# Variable which affect what information is displayed to the user
my $verbose = 1; # Display verbose information?
my $timing = 1; # Display timing information?
my $progress = 1; # Display progress meter?
#
# The 'shades' arrays, which contain the ascii characters for
# (respectively) 0, 1 or 2 hidden images. Note that characters
# go from darker to lighter. Note also that the last character
# in each darkest group should be a '@'.
#
my $ppshades = [
[ # No latent images
[ '@' ],
[ '#' ],
[ 'M' ],
[ 'E' ],
[ '(' ],
[ 'p' ],
[ 'x' ],
[ '<' ],
[ '!' ],
[ ';' ],
[ "," ],
[ "`" ],
[ " " ],
],
[ # For 1 latent image
[ '#', '@' ],
[ 'M', 'W' ],
[ 'E', 'F' ],
[ '(', ')' ],
[ 'p', 'b' ],
[ 'x', 'o' ],
[ '<', '>' ],
[ '!', '|' ],
[ ';', ':' ],
[ ",", "." ],
],
[ # For 2 latent images
[ 'M', 'W', '#', '@' ],
[ 'E', 'F', 'G', 'H' ],
[ '(', '{', ')', '}' ],
[ 'p', 'b', 'd', 'q' ],
[ 'x', 'o', 'a', 'c' ],
[ '<', '>', '!', '|' ],
[ ';', '~', '=', ':' ],
[ "`", "'", ".", "," ],
]
];
# ImageMagick uses 'gray1', 'gray2', etc. which need to be converted
# back to RGB values.
my $p_gray_to_rgb = {
gray => '7e7e7e', gray0 => '000000', gray1 => '030303',
gray2 => '050505', gray3 => '080808', gray4 => '0a0a0a',
gray5 => '0d0d0d', gray6 => '0f0f0f', gray7 => '121212',
gray8 => '141414', gray9 => '171717', gray10 => '1a1a1a',
gray11 => '1c1c1c', gray12 => '1f1f1f', gray13 => '212121',
gray14 => '242424', gray15 => '262626', gray16 => '292929',
gray17 => '2b2b2b', gray18 => '2e2e2e', gray19 => '303030',
gray20 => '333333', gray21 => '363636', gray22 => '383838',
gray23 => '3b3b3b', gray24 => '3d3d3d', gray25 => '404040',
gray26 => '424242', gray27 => '454545', gray28 => '474747',
gray29 => '4a4a4a', gray30 => '4d4d4d', gray31 => '4f4f4f',
gray32 => '525252', gray33 => '545454', gray34 => '575757',
gray35 => '595959', gray36 => '5c5c5c', gray37 => '5e5e5e',
gray38 => '616161', gray39 => '636363', gray40 => '666666',
gray41 => '696969', gray42 => '6b6b6b', gray43 => '6e6e6e',
gray44 => '707070', gray45 => '737373', gray46 => '757575',
gray47 => '787878', gray48 => '7a7a7a', gray49 => '7d7d7d',
gray50 => '7f7f7f', gray51 => '828282', gray52 => '858585',
gray53 => '878787', gray54 => '8a8a8a', gray55 => '8c8c8c',
gray56 => '8f8f8f', gray57 => '919191', gray58 => '949494',
gray59 => '969696', gray60 => '999999', gray61 => '9c9c9c',
gray62 => '9e9e9e', gray63 => 'a1a1a1', gray64 => 'a3a3a3',
gray65 => 'a6a6a6', gray66 => 'a8a8a8', gray67 => 'ababab',
gray68 => 'adadad', gray69 => 'b0b0b0', gray70 => 'b3b3b3',
gray71 => 'b5b5b5', gray72 => 'b8b8b8', gray73 => 'bababa',
gray74 => 'bdbdbd', gray75 => 'bfbfbf', gray76 => 'c2c2c2',
gray77 => 'c4c4c4', gray78 => 'c7c7c7', gray79 => 'c9c9c9',
gray80 => 'cccccc', gray81 => 'cfcfcf', gray82 => 'd1d1d1',
gray83 => 'd4d4d4', gray84 => 'd6d6d6', gray85 => 'd9d9d9',
gray86 => 'dbdbdb', gray87 => 'dedede', gray88 => 'e0e0e0',
gray89 => 'e3e3e3', gray90 => 'e5e5e5', gray91 => 'e8e8e8',
gray92 => 'ebebeb', gray93 => 'ededed', gray94 => 'f0f0f0',
gray95 => 'f2f2f2', gray96 => 'f5f5f5', gray97 => 'f7f7f7',
gray98 => 'fafafa', gray99 => 'fcfcfc', gray100 => 'ffffff',
};
##############
### Strict ###
##############
use strict;
use warnings;
#################
### Libraries ###
#################
use Data::Dumper;
use File::Basename;
use FileHandle;
use Image::Magick;
##################
### Prototypes ###
##################
sub convert_file_to_ascii($$$$);
sub convert_image_to_grayscale_xpm($);
sub convert_xpm_to_ascii($$$);
sub create_map($$);
sub get_ascii($$$$$$$);
sub get_shade($$$$$);
sub read_file($);
sub progress($$);
sub write_code($$$$);
sub write_file($$);
sub write_html($$);
###################
### Global vars ###
###################
$| = 1;
my $iam = basename $0;
my $syntax = "
syntax: $iam <image file> [message] [message]
This program converts a .jpg or .gif <image file> to ascii, and cr
+eates
an html file with the same basename as the original file. If one
+or two
'hidden message' files are given, a Perl script is also generated,
+ which
(depending on the arguments passed to it) lets the user generate b
+oth the
original picture and any 'latent' messages as well.
The format of the 'hidden message' file is simply spaces and non-s
+paces;
anything which is NOT a space represents a black pixel, and all sp
+aces
represent white pixels. For example:
@@@ @@@ @@@@@@@ @@@ @@@ @@@@@@@ @@@
@@@ @@@ @@@ @@@ @@@ @@@ @@@ @@@
@@@@@@@@ @@@@@@@ @@@ @@@ @@@ @@@ @@@
@@@ @@@ @@@ @@@ @@@ @@@ @@@
@@@ @@@ @@@@@@@ @@@@@@@ @@@@@@@ @@@@@@@ @@@
Either 'hidden message' file will be interpreted as a Perl script
+if it
is preceded by '=' (eg. '=script.pl'). This allows a separate scr
+ipt to
be embedded within the message instead.
";
####################
### Command-line ###
####################
(my $img = shift) or die $syntax;
(@ARGV > 2) and die "$iam: max latent messages allowed is 2\n";
my $phidden = [ @ARGV ];
####################
### Main program ###
####################
my $start = time;
my ($pmap, $pshades) = create_map($ppshades, $phidden);
convert_file_to_ascii($pmap, $pshades, $img, $phidden);
my $end = time;
my $duration = time - $start;
my $s = (1 == $duration)? "": "s";
$verbose and print "\n";
$timing and print "Total time = $duration second$s\n";
###################
### Subroutines ###
###################
sub read_file($) {
my ($fname) = @_;
my $fh = new FileHandle();
open($fh, "<$fname") or die "$iam: cannot read file '$fname' ($!)
+\n";
chomp (my @lines = <$fh>);
close $fh;
return \@lines;
}
sub create_map($$) {
my ($ppshades, $phidden) = @_;
my $nhidden = @$phidden;
my $pshades = $ppshades->[$nhidden];
my $nshades = @$pshades;
($black_limit < 0) and $black_limit = 0;
($white_limit > 255) and $white_limit = 255;
my $pmap = { };
my $range = ($white_limit - $black_limit + 1) / $nshades;
my $start_char = $black_limit;
my $last_char = 0;
my $this_char = 0;
my $i;
for ($i = 0; $i < $black_limit; $i++) {
$pmap->{$i} = $pshades->[0];
}
for (my $idx = 1, $i = $black_limit; $i <= $white_limit; $i++) {
while ($i - $black_limit >= $range * $idx && $idx < $nshades)
+{
++$idx;
}
$this_char = $pshades->[$idx - 1];
$pmap->{$i} = $this_char;
if ($last_char && $this_char ne $last_char) {
$start_char = $i;
}
$last_char = $this_char;
}
while ($i < 256) {
$pmap->{$i++} = $pshades->[-1];
}
return ($pmap, $pshades);
}
sub convert_file_to_ascii($$$$) {
my ($pmap, $pshades, $fname, $phidden) = @_;
(my $start_ext = $fname) =~ s,.*\.,.,;
my $pxpm = &convert_image_to_grayscale_xpm($fname);
my $pascii = convert_xpm_to_ascii($pmap, $pxpm, $phidden);
while (@$pascii > 0 && $pascii->[-1] =~ /^$/) {
pop @$pascii;
}
(my $text = $fname) =~ s/$start_ext$/.txt/;
&write_file($text, $pascii);
# Don't write the Perl script unless there's at least 1 latent mes
+sage
my $nhidden = @$phidden;
if ($nhidden) {
(my $code = $fname) =~ s/$start_ext$/.pl/;
write_code($nhidden, $pshades, $code, $pascii);
}
(my $html = $fname) =~ s/$start_ext$/.html/;
write_html($html, $pascii);
}
#
# Returns a value from 0.0 (lightest) to 1.0 (darkest), based on the
# pixels in the rows pointed to by $1, or undef if there is no more
# data.
#
sub get_shade($$$$$) {
my ($prows, $pintensity, $pixsize, $lnum, $idx) = @_;
my @syms;
my ($sum, $count);
for (my $i = 0; $i < @$prows; $i++) {
(length($prows->[$i]) >= $pixsize * $cols_per_pixel) or return
+ -1;
for (my $j = 0; $j < $cols_per_pixel; $j++) {
my $sym = substr($prows->[$i], 0, $pixsize, "");
defined($sym) or return -1;
my $shade = $pintensity->{$sym};
if (!defined($shade)) {
($prows->[$i] =~ /^(;|$)/ && $sym =~ /^}/) and return
+-1;
$lnum += $i;
my $msg = "undefined symbol '$sym', line $lnum, index
+$idx";
die "\n\n$iam: $msg\n";
}
$sum += $shade;
++$count;
}
}
my $avg_shade = $sum / $count;
return $avg_shade;
}
sub progress($$) {
my ($cnt, $n) = @_;
return unless $progress;
my $bar_width = 64;
my $pcnt = (0 == $n)? 0: ($cnt == $n)? 100: 100.0 * $cnt / $n;
my $bar_size = int($bar_width * $pcnt / 100);
my $blank_size = $bar_width - $bar_size;
my $blank = '-' x $blank_size;
my $bar = '*' x $bar_size;
printf " %5.1f%% [%s%s]\r", $pcnt, $bar, $blank;
}
sub get_ascii($$$$$$$) {
my ($pmap, $nhidden, $shade, $c1, $c2, $min, $max) = @_;
($shade > $white_limit) and $shade = 255;
($shade < $black_limit) and $shade = 0;
my $pasc = $pmap->{int($shade)};
my $idx = (($c1 eq ' ')? 0: 1) + (($c2 eq ' ')? 0: 2);
if ($idx < 0 || $idx > 3) { die "$iam: bad index $idx\n"; }
my $asc = $pasc->[$idx];
if (!defined($asc)) {
die "\n$iam: ascii for index $idx (shade $shade) is UNDEFINED
+\n";
}
return $asc;
}
sub convert_xpm_to_ascii($$$) {
my ($pmap, $plines, $phidden) = @_;
my $line = "";
while ($line !~ /^\s*static char.*{\s*$/) { $line = shift @$plines
+; }
my ($w, $h, $nshades, $pixsize);
while (1) {
$line = shift @$plines;
if ($line =~ /"(\d+)\s+(\d+)\s+(\d+)\s+(\d+)"/) {
($w, $h, $nshades, $pixsize) = ($1, $2, $3, $4);
last;
}
}
my %intensity;
my $re = '.' x $pixsize;
my $min = undef;
my $max = undef;
# Save symbols and the corresponding intensities
# 060104 liverpole -- fixed undefined symbol bug. Original code:
#
# for (my $i = 0; $i < $nshades; $i++) {
# $line = shift @$plines;
# next unless ($line =~ /"($re).*(#([0-9a-fA-F]{2})|(gray\d*
+))/);
# my ($pixel, $color) = ($1, $2);
# ($color =~ /gray/) and $color = '#' . $p_gray_to_rgb->{$co
+lor};
# $color =~ s/^#(..).*/$1/;
# my $intensity = hex($color);
# $intensity{$pixel} = $intensity;
# (!defined($min) || $min > $intensity) and $min = $intensit
+y;
# (!defined($max) || $max < $intensity) and $max = $intensit
+y;
# }
for (my $i = 0; $i < $nshades; $i++) {
$line = shift @$plines;
my ($pixel, $color, $shade);
if ($line =~ /"($re).*(none|white|black)/i) {
($pixel, $color) = ($1, $2);
$shade = ($color =~ /black/i)? 0: 255;
} elsif ($line =~ /"($re).*(gray\d*)/) {
($pixel, $color) = ($1, $2);
$color = $p_gray_to_rgb->{$color};
$shade = hex($color);
} elsif ($line =~ /"($re).*(#([0-9a-fA-F]{2}))/) {
($pixel, $color) = ($1, $2);
$color =~ s/^#(..).*/$1/;
$shade = hex($color);
} else {
my $where = sprintf "at line %d of %d", $i + 1, $nshades;
die "$iam: invalid shade $where: $line\n";
}
$intensity{$pixel} = $shade;
(!defined($min) || $min > $shade) and $min = $shade;
(!defined($max) || $max < $shade) and $max = $shade;
}
while ($plines->[0] !~ /^"/) {
shift @$plines;
}
if ($verbose) {
my $ratio = $cols_per_pixel / $rows_per_pixel;
print "Aspect ratio .................... $ratio\n";
print "Image geometry (w x h) .......... $w x $h pixels\n";
print "Total shades .................... $nshades\n";
print "Characters per pixel ............ $pixsize\n";
print "Minimum intensity (blackest) .... $min / 255\n";
print "Maximum intensity (whitest) ..... $max / 255\n";
}
my $total = @$plines;
my $count = 0;
my (@ascii, $asc);
# Read the lines from any hidden image files
my $nhidden = @$phidden;
map { s/^=// } (@$phidden);
my $phidden0 = (@$phidden > 0)? read_file($phidden->[0]): [ ];
my $phidden1 = (@$phidden > 1)? read_file($phidden->[1]): [ ];
progress(0, 0);
my ($c1, $c2);
# Process N=$rows_per_pixel rows at a time
for (my $i = 0; $i + $rows_per_pixel <= $total; $i += $rows_per_pi
+xel) {
progress($i, $total);
my $hidden0 = shift @$phidden0 || "";
my $hidden1 = shift @$phidden1 || "";
# Get $rows_per_pixel rows
my @rows;
for (my $j = 0; $j < $rows_per_pixel; $j++) {
$rows[$j] = shift @$plines;
$rows[$j] =~ s/^"(.*)".*$/$1/;
}
$count += $rows_per_pixel;
$asc = "";
my $rowsize = length $rows[0];
# Process N=$cols_per_pixel columns at a time
for (my $j = 0; $j < $rowsize; $j += ($pixsize * $cols_per_pix
+el)) {
# Get the average shade of $cols_per_pixel pixels from eac
+h row
my $shade = get_shade(\@rows, \%intensity, $pixsize, $i, $
+j);
last if ($shade < 0);
$c1 = substr($hidden0, 0, 1, "") || " ";
$c2 = substr($hidden1, 0, 1, "") || " ";
$asc .= get_ascii($pmap, $nhidden, $shade, $c1, $c2, $min,
+ $max);
}
push @ascii, $asc;
}
progress($total, $total);
$progress and print "\n";
$verbose and print "Decoded $count lines of $total\n";
return \@ascii;
}
sub convert_image_to_grayscale_xpm($) {
my ($fname) = @_;
$verbose and print "\n";
$verbose and print "=== File $fname ===\n";
my $image = new Image::Magick();
my $result = $image->Read($fname);
$result and die "$iam: error reading image file '$fname' ($result
+)\n";
$verbose and print "Read image '$fname'\n";
$result = $image->Quantize(colorspace=>'gray');
$result and die "$iam: error converting image to grayscale ($resu
+lt)\n";
$verbose and print "Converted image to grayscale\n";
my $tmp = "$iam$$.tmp.xpm";
$result = $image->Write($tmp);
$result and die "$iam: error writing .xpm file '$tmp' ($result)\n
+";
my $fh = new FileHandle();
my $plines = read_file($tmp);
$verbose and print "Converted image to .xpm format\n";
unlink $tmp;
return $plines;
}
sub write_file($$) {
my ($fname, $plines) = @_;
my $fh = new FileHandle();
open($fh, ">$fname") or die "$iam: cannot write file '$fname' ($!
+)\n";
my $count = @$plines;
my $s = (1 == $count)? "": "s";
for (my $i = 0; $i < $count; $i++) {
my $line = $plines->[$i];
$verbose and print $fh "$line\n";
}
close $fh;
$verbose and print "Wrote output file '$fname' ($count line$s)\n";
}
sub write_code($$$$) {
my ($nhidden, $pshades, $fname, $plines) = @_;
my $fh = new FileHandle();
open($fh, ">$fname") or die "$iam: unable to write file '$fname'
+($!)\n";
print $fh "#!/usr/bin/perl -w\n";
print $fh "\$_=q/\n";
map { print $fh "$_\n"; } @$plines;
if (2 == $nhidden) {
my ($list0, $list1, $list2);
foreach my $pshade (@$pshades) {
$list0 .= $pshade->[3] || 0;
$list1 .= $pshade->[2] || 0;
$list2 .= $pshade->[1] || 0;
}
if ($verbose) {
print "Character set 0 ... '$list0'\n";
print "Character set 1 ... '$list1'\n";
print "Character set 2 ... '$list2'\n";
}
my $text = '/;$;=(shift||0)%3;$,=q/' . $list0;
$text .= '/.(0,q/' . $list2 . '/,q/' . $list1 . '/)[$;];$;&&s'
+;
print $fh "$text\n";
print $fh '/[$,]/@/gm;$;&&s/[^\n@]/ /gm;print' . "\n";
} else {
# $nhidden = 1
my ($list);
foreach my $pshade (@$pshades) {
$list .= $pshade->[1] || 0;
}
$verbose and print "Character set ..... '$list'\n";
my $text = '/;$;=(shift||0)%2;$,=(0,q/' . $list . '/)[$;];$;&&
+s';
print $fh "$text\n";
print $fh '/[$,]/@/gm;$;&&s/[^\n@]/ /gm;print' . "\n";
}
close $fh;
my $count = @$plines;
my $s = (1 == $count)? "": "s";
$verbose and print "Wrote output file '$fname' ($count line$s)\n";
}
sub write_html($$) {
my ($fname, $plines) = @_;
my $font = 'Courier new';
my $fh = new FileHandle();
open($fh, ">$fname") or die "$iam: unable to write file '$fname'
+($!)\n";
print $fh "<html>\n";
print $fh "<head>\n";
print $fh "<style type=text/css>PRE {\n";
print $fh " FONT-SIZE:10px; COLOR: #000000;\n";
print $fh " FONT-FAMILY: '$font', Courier, mono\n";
print $fh "}\n";
print $fh "</style>\n";
print $fh "</head>\n";
print $fh "<body>\n";
print $fh " <pre>\n";
foreach my $line (@$plines) {
(my $new = $line) =~ s/</</g;
$new =~ s/>/>/g;
print $fh "$new\n";
}
print $fh " </pre>\n";
print $fh "</body>\n";
print $fh "</html>\n";
close $fh;
my $count = @$plines;
my $s = (1 == $count)? "": "s";
$verbose and print "Wrote output file '$fname' ($count line$s)\n";
}
