Acme-Steganography-Image-Png
view release on metacpan or search on metacpan
Revision history for Perl extension Acme::Steganography::Image::Png.
0.01 Fri Mar 11 22:01:05 2005
- original version; created by h2xs 1.19
0.02 Sat Mar 12 13:33:13 GMT 2005
- Added RGB classes.
0.03 Mon Mar 14 21:19:05 GMT 2005
- Use string & and | operators for about 30% speedup
Ops are bad, m'kay.
0.04 Mon Mar 14 22:59:27 GMT 2005
- Acme::Steganography::Image::Png::556FS uses Floyd-Steinberg dithering
to spread around the errors caused by stuffing way too much data in.
0.05 Mon Apr 3 15:20:09 BST 2006
- Actually give the error message on file open failure
- Patch from Simon Wistow to allow write_images to use an existing
Imager object, which allowed support for inlining images within
files.
0.06 Mon Oct 2 00:33:16 BST 2006
- Wrap the arguments to calls to croak in (), to avoid problems with
Changes
README
MANIFEST
Makefile.PL
Png.pm
t/grey.t
t/rgb.t
t/Elsa
t/Tester.pm
t/rgb_inline_image.t
META.yml Module meta-data (added by MakeMaker)
--- #YAML:1.0
name: Acme-Steganography-Image-Png
version: 0.06
abstract: ~
license: perl
generated_by: ExtUtils::MakeMaker version 6.30_02
author: Nicholas Clark <nick@ccl4.org>
distribution_type: module
requires:
Class::Accessor: 0
Imager: 0
Test::More: 0
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'Acme::Steganography::Image::Png',
'VERSION_FROM' => 'Png.pm', # finds $VERSION
'PREREQ_PM' => {'Imager' => 0,
'Class::Accessor' => 0,
'Test::More' => 0,
},
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(# ABSTRACT_FROM => 'Png.pm', # retrieve abstract from module
AUTHOR => 'Nicholas Clark <nick@ccl4.org>') : ()),
((eval $ExtUtils::MakeMaker::VERSION > 6.30) ? (LICENSE => 'perl') : ()),
);
package Acme::Steganography::Image::Png;
use strict;
use vars qw($VERSION @ISA);
use Imager;
require Class::Accessor;
use Carp;
@ISA = qw(Class::Accessor);
# What arguments can we accept to the constructor.
# Am I reinventing the wheel here?
my %keys;
@keys{@keys} = ();
sub _keys {
return \%keys;
}
Acme::Steganography::Image::Png->mk_accessors(@keys);
# This will get refactored out at some point to support other formats.
sub generate_header {
my ($self) = shift;
my $section = $self->section;
my $header = pack 'w', $section;
if (!$section) {
$header .= pack 'w', length ${$self->data};
}
}
sub default_filename_generator {
my $state = shift;
$state ||= 0;
my $new_state = $state+1;
# really unimaginative filenames by default
($state, $new_state);
}
package Acme::Steganography::Image::Png::FlashingNeonSignGrey;
use vars '@ISA';
@ISA = 'Acme::Steganography::Image::Png';
# Raw data as a greyscale PNG
sub make_image {
my $self = shift;
my $img = new Imager;
$img->read(data=>$_[0], type => 'raw', xsize => $self->x,
ysize => $self->y, datachannels=>1, storechannels=>1, bits=>8);
$img;
}
$self->x * $self->y;
}
sub extract_payload {
my ($class, $img) = @_;
my $datum;
$img->write(data=> \$datum, type => 'raw');
$datum;
}
package Acme::Steganography::Image::Png::RGB::556;
use vars '@ISA';
@ISA = 'Acme::Steganography::Image::Png::RGB';
# Raw data in the low bits of a colour image
Acme::Steganography::Image::Png->mk_accessors('raw');
sub extract_payload {
my ($class, $img) = @_;
my ($raw, $data);
$img->write(data=> \$raw, type => 'raw');
my $end = length ($raw)/3;
for (my $offset = 0; $offset < $end; ++$offset) {
my ($red, $green, $blue) = unpack 'x' . ($offset * 3) . 'C3', $raw;
my $datum = (($red & 0x1F) << 11) | (($green & 0x1F) << 6) | ($blue & 0x3F);
$img->read(data=>$raw, type => 'raw', xsize => $self->x,
ysize => $self->y, datachannels => 3,interleave => 0);
$img;
}
sub calculate_datum_length {
my $self = shift;
$self->x * $self->y * 2;
}
package Acme::Steganography::Image::Png::RGB::556FS;
use vars '@ISA';
@ISA = 'Acme::Steganography::Image::Png::RGB::556';
# Raw data in the low bits of a colour image, with Floyd-Steinberg dithering
# to spread the errors around. Share and enjoy, share and enjoy.
sub make_image {
my $self = shift;
# We get a copy to play with
my $raw = $self->raw;
my $img = new Imager;
my $next_row;
$next_row->[$x][$_] += $error;
}
}
}
$img->read(data=>$raw, type => 'raw', xsize => $xsize,
ysize => $ysize, datachannels => 3,interleave => 0);
$img;
}
package Acme::Steganography::Image::Png::RGB::323;
use vars '@ISA';
@ISA = 'Acme::Steganography::Image::Png::RGB';
# Raw data in the low bits of a colour image
Acme::Steganography::Image::Png->mk_accessors('raw');
sub extract_payload {
my ($class, $img) = @_;
my ($raw, $data);
$img->write(data=> \$raw, type => 'raw');
my $end = length ($raw)/3;
for (my $offset = 0; $offset < $end; ++$offset) {
my ($red, $green, $blue) = unpack 'x' . ($offset * 3) . 'C3', $raw;
my $datum = (($red & 0x7) << 5) | (($green & 0x3) << 3) | ($blue & 0x7);
$img->read(data=>$raw, type => 'raw', xsize => $self->x,
ysize => $self->y, datachannels => 3,interleave => 0);
$img;
}
sub calculate_datum_length {
my $self = shift;
$self->x * $self->y;
}
package Acme::Steganography::Image::Png::RGB;
use vars '@ISA';
@ISA = 'Acme::Steganography::Image::Png';
# Raw data in the low bits of a colour image
sub write_images {
my $self = shift;
my $victim = shift;
my $img;
if (ref($victim) && $victim->isa('Imager')) {
$img = $victim;
$self->y($img->getheight());
my $raw;
$img->write(data=> \$raw, type => 'raw')
or croak($img->errstr);
$self->raw($raw);
$self->SUPER::write_images;
}
package Acme::Steganography::Image::Png;
sub generate_next_image {
my ($self) = shift;
my $datum = $self->generate_header;
my $offset = $self->offset;
my $datum_length = $self->datum_length;
# Fill our blob of data to the correct length
my $grab = $datum_length - length $datum;
$datum .= substr ${$self->data()}, $offset, $grab;
$self->offset($offset + $grab);
substr ($data, $length) = '';
$data;
}
1;
__END__
=head1 NAME
Acme::Steganography::Image::Png - hide data (badly) in Png images
=head1 SYNOPSIS
use Acme::Steganography::Image::Png;
# Write your data out as RGB PNGs hidden in the image "Camouflage.jpg"
my $writer = Acme::Steganography::Image::Png::RGB::556FS->new();
$writer->data(\$data);
my @filenames = $writer->write_images("Camouflage.jpg");
# Returns a list of the filenames it wrote to
# Then read them back.
my $reread =
Acme::Steganography::Image::Png::RGB::556->read_files(@files);
=head1 DESCRIPTION
Acme::Steganography::Image::Png is extremely ineffective at hiding your
secrets inside Png images.
There are 4 implementations
=over 4
=item Acme::Steganography::Image::Png::FlashingNeonSignGrey
Blatantly stuffs your data into greyscale PNG files with absolutely no attempt
to hide it.
=item Acme::Steganography::Image::Png::RGB::556
Stuffs your data into a sample image, using the low order bits of each colour.
2 bytes of your data are stored in each pixel, 5 bits in Red and Green, 6 in
Blue. It produces a rather grainy image.
=item Acme::Steganography::Image::Png::RGB::323
Also stuffs your data into a sample image, using the low order bits of each
colour. Only 1 byte of your data is stored in each pixel, 3 bits in Red and
Blue, 2 in Green. To the untrained eye the image looks good. But the fact
that it's PNG will make anyone suspicious about the contents.
=item Acme::Steganography::Image::Png::RGB::556FS
Stuffs your data into a sample image, using the low order bits of each colour.
2 bytes of your data are stored in each pixel, 5 bits in Red and Green, 6 in
Blue. Changing the value of pixels to store data is adding error to the image,
in this case rather a lot of error. To attempt to conceal some of the
graininess Floyd-Steinberg dithering is used to spread the errors around. It's
not perfect, but effects are quite interesting, producing a reasonably nice
dithered image.
=back
Acme::Steganography::Image::Png version 0.06
============================================
Acme::Steganography::Image::Png is extremely ineffective at hiding your
secrets inside Png images.
If you want real steganography, you're in the wrong place.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
t/Tester.pm view on Meta::CPAN
package Tester;
use strict;
use Test::More 'no_plan';
require Acme::Steganography::Image::Png;
ok ("Well, it loads");
my $file = $^X;
cmp_ok (-s $^X, '>', 0, "$^X has some contents");
my $data;
{
local $/;
#!perl -w
use strict;
use FindBin;
use lib $FindBin::Bin;
use Tester;
Tester::test_package('Acme::Steganography::Image::Png::FlashingNeonSignGrey');
use FindBin;
use File::Spec;
use lib $FindBin::Bin;
use Tester;
use Test::More;
my $test_image = File::Spec->catfile($FindBin::Bin, 'Elsa');
ok (-e $test_image, "We have our test image '$test_image'");
Tester::test_package('Acme::Steganography::Image::Png::RGB::556', $test_image);
Tester::test_package('Acme::Steganography::Image::Png::RGB::323', $test_image);
Tester::test_package('Acme::Steganography::Image::Png::RGB::556FS',
$test_image);
( run in 0.316 second using v1.01-cache-2.11-cpan-a1d94b6210f )