#!/usr/bin/perl

# version 0.0.1
# file version 00000001

# import ImageMagick perl wrapper and POSIX functions
use Image::Magick;
use POSIX;
use integer;

# check arguments
if ($#ARGV < 2) {
	die <<EOF;
Error: not enough arguments.
	
steg-encode.pl - Hide a message in an image.
------------------------------------------------------------------------------
Usage: steg-encode.pl envelope body outfile

  envelope  - An graphics file in any format that ImageMagick can use.
  body      - A small file (e.g. text file, gzipped data) to hide.
  outfile   - Output file. Should use a format that has the following
  	      properties:
	      
	          * ImageMagick can write it;
		  * 24-bit (or higher) colour;
		  * Uncompressed or non-lossy compression.
		  
  	      Ideal formats are BMP or PNG.
	      
EOF
} 

# grab arguments
$imgfile = shift @ARGV;
$msgfile = shift @ARGV;
$outfile = shift @ARGV;

# some useful globals
$xSize = 0;
$ySize = 0;
$msgSize = 0;
$envSize = 0;

# read image - note: this function also sets $xSize and $ySize.
@envelope = &readImageIntoArray($imgfile);

# calculate how big the envelope is.
$envSize = 3 * $xSize * $ySize;
&debug("Envelope can hold $envSize bits");

# read message - note: this function also sets $msgSize
@body = &readMessageIntoArray($msgfile);
&debug("Letter Body is $msgSize bits");

# create header for message, containing file version number and
# message size.
@head = &createHead();

# the letter consists of a head then the body.
@letter = (@head,@body);
&debug("Letter is $msgSize bits");

# don't want to waste our time if the envelope is too small!
die "Error: message too big to fit in envelope!" if ($envSize < $msgSize);

# main loop
@out = &steg();

# write file
&writeStegFile($outfile, @out);


################## Functions ################## 

sub readImageIntoArray {

	# open the file
	$f = shift @_;
	$image = Image::Magick->new;
	$image->Read($f);
	
	# set to 24bit colour
	$image->Set(depth=>8);
	
	# find dimensions
	($xSize, $ySize) = $image->[0]->Get('width', 'height');
	&debug("Image $f: x is $xSize, y is $ySize");
	
	# prepare initial array
	@retval = ();
	
	# loop through each pixel of the image
	for ($x = 0; $x < $xSize; $x++) {
		for ($y = 0; $y < $ySize; $y++) {
		
			# look at the pixel colour
			$p = $image->Get("pixel[$x,$y]");
			
			# split into RGBA components. discard alpha channel.
			($r,$g,$b,$a) = split(/\,/, $p);
			
			# IMPORTANT:
			# Some versions of ImageMagic use 24-bit RGB, if this describes you, then
			# change the next line to read "if ( 1==0 ) {". 
			if ( 1==1 ) {
				# ImageMagick is using 48-bit RGB, so divide through to get 24-bit.
				$r = $r >> 8;
				$g = $g >> 8;
				$b = $b >> 8;
			}
			
			# add these values to the array.
			@retval = (@retval, $r, $g, $b);
			
		}
	}
	
	# image is now contained into array.
	return @retval;
	
}


sub readMessageIntoArray {

	# open file
	$f = shift @_;
	open(F,$f) || die "Couldn't open $f!";
	
	# initialise array
	@retval = ();
	
	# loop through file
	while ( !eof(F) ) {
		
		# read a character
		read (F, $char, 1);
		
		# get the binary representation. voodoo code.
		$b = substr(unpack("B*", pack("N", ord($char))), 24);
		
		# split into bits
		@bits = split(//, $b);
		
		# append bits to end of file
		@retval = (@retval, @bits);
		
		# increment counter!
		$msgSize += 8;
	}
	
	# close file
	close(F);	
	
	# return array
	return @retval;
}

sub createHead {

	# a head is a 32-bit array. the first 8 bits are the file version.
	# the last 24 bits are an unsigned integer showing the length in
	# bytes of the hidden message.

	$fileVersion = '00000001';
	$b = substr(unpack("B*", pack("N", ($msgSize / 8))), 8);
	&debug("Message Header: $fileVersion$b");
	$msgSize += 32;
	return split(//, $fileVersion . $b);
}

sub steg {
	
	# initialise array
	@retval = ();
	
	# these values are useful for evening out disturbances.
	$shift{'r'} = 0;
	$shift{'g'} = 0;
	$shift{'b'} = 0;
	$now = 'r';
	
	for ($i = 0; $i < $envSize; $i++) {
	
		$e = $envelope[$i];
		$l = $letter[$i];
		
		# if the letter bit is 0 and the envelope is already even
		# OR the letter bit is 1 and the envelope is already off
		# OF if we're already past the end of the message
		if ( ($i>$msgSize) || ($e%2==$l) ) {
		
			# simply pass on the original value unchanged
			$retval[$i] = $e;
			
		}
		
		# if the letter bit is 0, but the envelope is odd...
		elsif ($l==0) {
		
			# don't have any choice but to adjust 255 down to 254.
			if ($e == 255) {
				$retval[$i] = 254;
				# but rmember next time we have a choice, suggest to go up.
				$shift{$now}++;
			} 
			
			# if we should be adjusting up, do so.
			elsif ($shift{$now} > 0) {
				$retval[$i] = $e + 1;
				$shift{$now}--;
			}

			# otherwise, adjust down.			
			else {
				$retval[$i] = $e - 1;
				$shift{$now}++;
			}
			
		}
		
		# otherwise the letter bit must be 1 and the envelope byte even.
		else {
			# don't have any choice but to adjust 0 up to 1.
			if ($e == 0) {
				$retval[$i] = 1;
				# but rmember next time we have a choice, suggest to go down.
				$shift{$now}--;
			} 
			
			# if we should be adjusting down, do so.
			elsif ($shift{$now} < 0) {
				$retval[$i] = $e - 1;
				$shift{$now}++;
			}
			
			# otherwise, adjust up.
			else {
				$retval[$i] = $e + 1;
				$shift{$now}--;
			}
		}
		
		# advance to next colour, for balancing.
		$now = &shiftColour($now);
	}
	
	return @retval;
}

sub writeStegFile {

	# get parameters
	$f = shift @_;
	@data = @_;
	
	# create empty image
	$image = undef;
	$size = $xSize . 'x' . $ySize;
	$image = Image::Magick->New(size=>$size);
	
	# fill with blank. seems this is needed.
	$image->Read('xc:white');

	# loop through each pixel of the image
	for ($x = 0; $x < $xSize; $x++) {
		for ($y = 0; $y < $ySize; $y++) {
		
			# obtain r,g,b from array
			$r = shift @data;
			$g = shift @data;
			$b = shift @data;
			
			# combine rgb
			$colour=sprintf("#%02x%02x%02x", $r,$g,$b);

			# set the pixel
			$image->Set("pixel[$x,$y]"=>$colour);
		}
	}
	
	# output file
	debug("Writing file $f");
	$x = $image->Write($f);
	warn $x if $x;
}

sub debug {
	$l = shift @_;
	print STDERR "$l\n";
}


# little support function for "steg"
sub shiftColour {
	$n = shift @_;
	if ($n eq 'r') {
		return 'g';
	} elsif ($n eq 'g') {
		return 'b';
	} else {
		return 'r';
	}
}