Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Latent Image Obfuscation Generator

by liverpole (Monsignor)
on Jan 01, 2006 at 19:12 UTC ( #520274=CUFP: print w/ replies, xml ) Need Help??

About 3 months ago, I created this obfuscated program, which embedded a "hidden message" into an ascii-art picture.

I also mentioned my intent to submit the program I used to generate the obfuscated code, once I had cleaned it up a bit.

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.

Yesterday I finally resumed the project, and used the program to create a New Year's obfuscation.  As the code is now cleaned up, and works for 0, 1 or 2 hidden messages, it seems a good time to publish it.

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:

+ + @@@@@ @@@@@ @@@ @@@ @@@ @@@ @@@ @@@ @@@ @@@ @@@ @@@ @@@@@ @@@@@@ @@@@@@ @@@@@ @@ @@@@@@@@@@@ @ @@@@ @@@@ @@@ @@@@ @@@ @@@ @ @@@ @@@ @@@ @@@ @@@ @@@ @@@ @@@ @ @@@ @@@ @@@@@ @@@ @@@ @@@ @@@ @@@ @ @@@ @@@ @@ @@@ @@@ @@@ @@@ @@@ @@@ @ @@@ @@@ @@@ @@@ @@@ @@ @@@ @@ @@@ @@@ @@@ @@@ @@@ @@@@ @@ @@@@ @@ @@@ @@@@@ @@@@@ @@@@ @@@ @@@@@@ @@@@@@ @@@ @@@ @@@ @ @@@ @@@ @ @@@ @@@ @ @ @@@ @@@ @@@@ @@@@@@ @@@@@@ @@@ + + + @@@ @@@ @@@ @ @@@@ @ @@@@@ @ @ @@@@ @ @ @@@ @ @@@@@ @@@@@ @@ @@@ @ @@@ @ @@ @@@ @@@ @@ @ @ @@@ @ @@@ @@@ @@@ @@@@ @ @ @@@@ @ @@@@@@@@ @@@ @@@@ @ @ @@@@@ @@@ @@@@ @@@@ @ @@@@ @@@ @@@@ @@@ @ @@@ @@@ @ @@ @@ @@@ @@ @@@@@ @@ @@ + + + + @@ @ @@ @@@@@ @ @@@ @@@@ @ @@@ @@@ @ @@@ @@@@ @ @@@ @@@ @ @@@@@ @@@@@ @@ @@ @ @@@@@ @@ @@@ @ @@@@ @@@@@@@ @ @@@ @@@ @@@ @@@ @@@ @ @ @@@ @@@@@@@@ @@@@@ @@@ @ @@@ @@@ @@ @@@ @@@ @@@ @@@ @@@ @@@ @@@ @@@ @@@ @@@ @ @@@ @@@ @@@ @@@ @@@@@ @@@@@ @@@@ @@@@@@@@ @@@ + +

And this is the generation script 'latent.pl':

Updated 060104:  Fixed a bug in the interpretation of xpm shades, which occasionally caused an incorrect 'invalid shade' message.

#!/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/</&lt;/g; $new =~ s/>/&gt;/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"; }

@ARGV=split//,"/:L"; map{print substr crypt($_,ord pop),2,3}qw"PerlyouC READPIPE provides"

Comment on Latent Image Obfuscation Generator
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://520274]
Approved by sk
Front-paged by sk
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (9)
As of 2014-11-20 23:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (103 votes), past polls