Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Comment on

( #3333=superdoc: 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"

In reply to Latent Image Obfuscation Generator by liverpole

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others pondering the Monastery: (6)
    As of 2015-07-30 03:18 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (269 votes), past polls