[Richard Suchenwirth] 2003-08-02 - Steganography is a
cryptographic technique, where data is hidden inside other data. A simple
example is a color image, where every pixel has r(ed)-g(reen)-b(lue) values
each between
0 and 255. If the least significant bit of each color value is taken as
part of the data to hide, the visual impression of the image will hardly
change. 3 pixels together offer 9 bits of "hiding room", which is enough
for characters from Unicode pages 0 and 1. A small 100x100 image thus
can hide 10000/3 = 3333 characters, which is quite a lengthy "subtext".

First let's read the "subtext" from a given [photo] image - the l.s. bit is
easily obtained by modulo 2. You can choose whether you want to "read" all
pixels, which takes long, or only until the first NUL byte:
======
 proc stega_get {image {all 0}} {
    set w [image width $image]
    set h [image height $image]
    set n 0; set int 0; set res ""
    for {set i 0} {$i<$h} {incr i} {
        for {set j 0} {$j<$w} {incr j} {
            foreach {r g b} [$image get $j $i] break
            set int [expr {$int*8 + $r%2*4 + $g%2*2 + $b%2}]
            if {[incr n]==3} {
                if {!$all && $int==0} {return $res}
                if {$int<32} {set int 32} ;# blank out control chars
                append res [format %c $int]
                set n 0; set int 0
            }
        }
    }
    set res
 }
======

On an untreated test image, this returns quite some gibberish. But
now let's put a subtext into such an image. I restrict the character range to
page 0 of the Unicode, because ''[binary] scan'' is so convenient, but works on
bytes. Masking out the least-significant bit is done by bit-wise ANDing with
the pattern 0xFE (i.e. all but the lsb set).

======
 proc stega_put {image text} {
    set w [image width $image]
    set h [image height $image]
    set i 0; set j 0
    foreach char [split $text\x0 ""] {
        binary scan $char B* bits
        set bits [split 0$bits ""] ;# prepend 0 to make it 9
        foreach triplet [list [lrange $bits 0 2] \
              [lrange $bits 3 5] [lrange $bits 6 8]] {
           foreach {r g b} [$image get $j $i] {R G B} $triplet break
           set r [expr {($r & 0xFE) + $R}]
           set g [expr {($g & 0xFE) + $G}]
           set b [expr {($b & 0xFE) + $B}]
           set color [format #%02x%02x%02x $r $g $b]
           $image put $color -to $j $i
           if {[incr j]>=$w} {
               if {[incr i]>=$h} return ;# truncate on image full
               set j 0
           }
       }
    }
 }
======

For transferring such an image "with a message", save it to a
file. However, some file formats optimize away the least significant
bit, losing the message. Writing in GIF format conserves the lsb, but
may bail out because of "too many colors" (it appears to have a limited
color table, and in worst case steganography makes eight times as many
colors). Also, transparent pixels
suddenly turn to black (or almost black), revealing that something is
fishy with the image. JPEG drops the lsb. I found TIFF and PPM to work
reliably, albeit uncompressed, so the file may get 6 times bigger than
the original JPEG.

----
[thgr] 2009-02-08 - Read about steganography on wikipedia [http://en.wikipedia.org/wiki/Steganography] and wrote this litte tcl script to unravel the cat StenographyRecovered.png [http://en.wikipedia.org/wiki/File:StenographyRecovered.png] which is hidden in StenographyOriginal.png [http://en.wikipedia.org/wiki/File:StenographyOriginal.png]

======
 package require Img
 
 set sample "StenographyOriginal.png"
 set src [image create photo -file $sample]
 set w [image width  $src]
 set h [image height $src]
 set trg  [image create photo -width $w -height $h]
 set trg2 [image create photo -width $w -height $h]
 $trg blank
 $trg2 blank
 for {set y 0} {$y<$h} {incr y} {
     for {set x 0} {$x<$w} {incr x} {
         foreach {r g b} [$src get $x $y] {
             # extract last two bits of each color channel
             set R [expr {$r & 0x03}]
             set G [expr {$g & 0x03}]
             set B [expr {$b & 0x03}]
         }
         set color [format #%02x%02x%02x $R $G $B]
         $trg put $color -to $x $y
         # brighten 85 times
         set color [format #%02x%02x%02x [expr $R*85] [expr $G*85] [expr $B*85]]
         $trg2 put $color -to $x $y
     }
 }
 $trg write unraveled.png -format png
 $trg2 write unraveled_brightened.png -format png
======
----
[aspect] 2012-10-12:  Here's a funny little demonstration of steganography I came up with today.  It "hides" the message in a stream of text as follows:

tHis MessaGE loOkS lIKe I'Ve wrITtEN it wITh A BROkeN sHIft keY.  but you CAN sTILl REaD IT, BeCAUse You JUsT IgnoRE thE randOm capItaLs, treatiNg them aS 'nOisE'.  BuT THeRe is ACtuAlLy A MesSAGe HIdden In IT:  eVERy cAPiTAL LeTTer REPrESEntS a bINary 1, aNd EVEry lowER cAse leTTER a bInaRy 0.  knowiNG tHis, YoU CAn cONstRuct a biT SeqUEncE, PAcK tHaT InTO ByteS aND Take The asciI value Of EACh One tO GEt A secREt mesSaGE.  if yOU dIDn'T kNOw tHat it waS Here, yOu'D JUsT thinK i have a BRokEn shIFt key AnD IGnORE tHE cAPItalIsATIon.

======
#!/usr/bin/tclsh
#

lassign $argv secret carrier

puts "Encrypting $secret in $carrier"

foreach c [split $carrier {}] {
    if {[string is alpha $c]} {
        incr bitsAvail
    }
}

set bitsNeeded [expr {[string length $secret]*8}]
if {$bitsNeeded > $bitsAvail} {
    error "Not enough bits available: have $bitsAvail, need $bitsNeeded"
}

binary scan $secret B* bits
set bits [split $bits {}]
set upto 0

foreach c [split $carrier {}] {
    if {[string is alpha $c]} {
        if {($upto < [llength $bits]) && [lindex $bits $upto]} {
            set c [string toupper $c]
        } else {
            set c [string tolower $c]
        }
        incr upto
    }
    append result $c
}

puts $result
======
Decryption is left as an excercise for the reader ..

<<categories>> Cryptography | Arts and crafts of Tcl-Tk programming