initial commit

This commit is contained in:
Dmitriy Pleshevskiy 2024-04-13 17:28:26 +03:00
commit 9e2fecffbe
Signed by: pleshevskiy
GPG key ID: 17041163DA10A9A2
11 changed files with 650 additions and 0 deletions

9
.gitignore vendored Normal file
View file

@ -0,0 +1,9 @@
# editors
.idea/
.vscode/
*.swp
# direnv
.direnv
.envrc
# nix
/result

5
CHANGELOG.md Normal file
View file

@ -0,0 +1,5 @@
# Revision history for picsg
## 0.1.0.0 -- 2024-04-13
- First version. Released on an unsuspecting world.

30
LICENSE Normal file
View file

@ -0,0 +1,30 @@
Copyright Author name here (c) 2022
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Author name here nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

27
README.md Normal file
View file

@ -0,0 +1,27 @@
# picsg
A tool for steganographing information in a picture encoded using the Vernam
cipher.
## Synopsis
```sh
picsg [subcommand]
```
where subcommand is one of the following:
- `encode <text> <output-path> [--img <image-path>]`
- `encode file <file-path> <output-path> [--img <image-path>]`
- `decode [--img] <encoded-path> <key-path> <output-path>`
## Examples
- Encode text using the Vernam cipher to the file `hello.enc` and create a file
`hello.enc.key` with a key to decode the `hello.enc` file.
`picsg encode "ABC" hello.enc`
- Decode the `hello.enc` file using key and print to the standard output
`picsg decode hello.enc hello.enc.key -`

2
Setup.hs Normal file
View file

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

138
app/DecodeSteg.hs Normal file
View file

@ -0,0 +1,138 @@
{-| Module for decoding the information hidden in the image using LSB steganography method
-}
module DecodeSteg (
-- * Functions required for decoding information hidden in image
getWidth, getHeight, getRed, getGreen, getBlue
, getTotalNumPixels, getTotalBits, getPixelsforMessage
, getOptimumBits, readPixelBit, readBitOfImage, readByte
, readFileName, readAllBytes, decodeImg ) where
import Codec.Picture
import Data.Bits
import Data.Char
import Data.Word
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Internal as BI
-- | Obtain width of image
getWidth :: Image a -> Int
getWidth (Image w _ _) = w
-- | Obtain height of image
getHeight :: Image a -> Int
getHeight (Image _ h _) = h
-- | Obtain 8 bit red channel values from RGB8pixel of image
getRed :: PixelRGB8 -> Pixel8
getRed (PixelRGB8 r _ _) = r
-- | Obtain 8 bit green channel values from RGB8pixel of image
getGreen :: PixelRGB8 -> Pixel8
getGreen (PixelRGB8 _ g _) = g
-- | Obtain 8 bit blue channel values from RGB8pixel of image
getBlue :: PixelRGB8 -> Pixel8
getBlue (PixelRGB8 _ _ b) = b
-- | Get total number of pixels available to hide information in image
getTotalNumPixels :: Image PixelRGB8 -> Int
getTotalNumPixels img = getWidth img * getHeight img - 64 - 1
-- | Get total number of bits in which information can be hidden
getTotalBits :: Image PixelRGB8 -> Int -> Int
getTotalBits img bitsPerPixel = (getWidth img * getHeight img - 64 - 1)
* bitsPerPixel * 3
-- | Get number of pixels in which information is hidden
getPixelsforMessage :: Int -> Int -> Int
getPixelsforMessage len bitsPerPixel = div (len * 8) (bitsPerPixel * 3)
-- | Get optimum number of last significant bits in pixel to hide the information in image
getOptimumBits :: Image PixelRGB8 -> Int -> Int
getOptimumBits img bytes = max
(ceiling ((toRational (bytes * 8))
/ (toRational ((getTotalNumPixels img) * 3)))) 1
-- | A delimiter used to separate file name and its data in encoded image
nullWord8 = fromIntegral 0
-- | Test whether the pixel at given index is 0 or 1
readPixelBit :: Pixel8 -> Int -> Bool
readPixelBit px idx = testBit px idx
-- | Identifies which color channel of pixel is to be read and returns the bit at that color channel
readBitOfImage :: Image PixelRGB8 -> Int -> Int -> Int -> Int -> Double -> Bool
readBitOfImage img bitsPerPixel byteIdx bitIdx offset period
| color == 0 = readPixelBit (getRed (pixelAt img px py)) lsbIdx
| color == 1 = readPixelBit (getGreen (pixelAt img px py)) lsbIdx
| color == 2 = readPixelBit (getBlue (pixelAt img px py)) lsbIdx
where
pos = floor (fromIntegral (byteIdx * 8 + bitIdx) * period)
pixIdx = div pos (bitsPerPixel * 3) + offset
px = mod pixIdx (getWidth img)
py = div pixIdx (getWidth img)
color = div (mod pos (bitsPerPixel * 3)) bitsPerPixel
lsbIdx = mod (mod pos (bitsPerPixel * 3)) bitsPerPixel
{-| Converts a sequence of bits to Word8
-}
boolToWord8 :: [ Bool ] -> Word8
boolToWord8 = foldl (\byte bit -> byte * 2 + if bit then 1 else 0) 0
-- | Reads all the 8 bits of a byte (a character at given index of hidden information)
readByte :: Image PixelRGB8 -> Int -> Int -> Int -> Double -> Word8
readByte img idx lsb offset period = boolToWord8
[ readBitOfImage img lsb idx i offset period | i <- reverse [ 0 .. 7 ] ]
-- | Reads the lsb bits of pixel from given starting index in which filename is stored till nullWord8 is encountered (delimiter)
readFileName :: Image PixelRGB8 -> Int -> Int -> Int -> Double -> [ Word8 ]
readFileName img start lsb offset period
| byte == nullWord8 = []
| otherwise = [ byte ] ++ readFileName img (start + 1) lsb offset period
where
byte = readByte img start lsb offset period
-- | Read all the bytes of image in which information is hidden
readAllBytes
:: Image PixelRGB8 -> Int -> Int -> Int -> Int -> Double -> [ Word8 ]
readAllBytes img start lsb len offset period
| len <= 0 = []
| otherwise = (readByte img start lsb offset period)
: (readAllBytes img (start + 1) lsb (len - 1) offset period)
{- | Convert Word8 to Int32
-}
word8ToInt32 :: [ Word8 ] -> Int
word8ToInt32 [] = 0
word8ToInt32 [ x ] = fromIntegral x
word8ToInt32 (x : xs) = (fromIntegral x) + shiftL (word8ToInt32 xs) 8
{- | Convert a sequence of Word8 to string.
-}
word8ListToString :: [ Word8 ] -> String
word8ListToString list = map BI.w2c list
-- | Decrypt (read) bytes from file in which filename, filepath, information is hidden and writes it in a file
decodeImg :: Image PixelRGB8 -> IO [ Word8 ]
decodeImg img = return file
where
len = fromIntegral
(word8ToInt32 (readAllBytes img 0 1 4 0
(63 / (fromIntegral (getPixelsforMessage 4 1)))))
bitsPerPixel = getOptimumBits img len
name = readFileName img 0 bitsPerPixel 64
(fromIntegral (getTotalBits img bitsPerPixel) / fromIntegral (len * 8))
filePath = word8ListToString name
file = readAllBytes img (length name + 1) bitsPerPixel
(len - (length name + 1)) 64
((fromIntegral (getTotalBits img bitsPerPixel))
/ (fromIntegral (len * 8)))

137
app/EncodeSteg.hs Normal file
View file

@ -0,0 +1,137 @@
{-| Module for encoding (hiding) text file or image into another image using LSB Steganography.
-}
module EncodeSteg ( getWidth, getHeight, getRed, getGreen, getBlue
, getTotalNumPixels, getTotalBits, getPixelsforMessage
, getMinBits, getChangedPixel, encodeImage
, writeBitToImage ) where
import Codec.Picture
import Control.Monad.ST
import Data.Bits
import qualified Codec.Picture.Types as M
import Data.Word
{-| Returns width of image.
-}
getWidth :: Image a -> Int
getWidth (Image w _ _) = w
{-| Returns height of image.
-}
getHeight :: Image a -> Int
getHeight (Image _ h _) = h
{-| Returns red channel values from pixel
-}
getRed :: PixelRGB8 -> Pixel8
getRed (PixelRGB8 r _ _) = r
{-| Returns green channel values from pixel
-}
getGreen :: PixelRGB8 -> Pixel8
getGreen (PixelRGB8 _ g _) = g
{-| Returns blue channel values from pixel
-}
getBlue :: PixelRGB8 -> Pixel8
getBlue (PixelRGB8 _ _ b) = b
{-| Returns total number of pixels
-}
getTotalNumPixels :: Image PixelRGB8 -> Int
getTotalNumPixels img = (getWidth img) * (getHeight img) - 64 - 1
{-| Returns total number of bits
-}
getTotalBits :: Image PixelRGB8 -> Int -> Int
getTotalBits img bitsPerPixel = ((getWidth img) * (getHeight img) - 64 - 1)
* bitsPerPixel * 3
{-| Returns total number of pixels to store message
-}
getPixelsforMessage :: Int -> Int -> Int
getPixelsforMessage len bitsPerPixel = div (len * 8) (bitsPerPixel * 3)
{-| Returns minimum bits to modify required per pixel color channel
-}
getMinBits :: Image PixelRGB8 -> Int -> Int
getMinBits img bytes = max
(ceiling ((toRational (bytes * 8))
/ (toRational ((getTotalNumPixels img) * 3)))) 1
{-| Modifies pixel 'pix' based on value of 'b'.
bit i is a value with the ith bit set and all other bits clear.
-}
getChangedPixel :: Pixel8 -> Int -> Bool -> Pixel8
getChangedPixel pix x b
| b = pix .|. bit x
| not b = pix .&. complement (bit x)
{- | Converts an integer to sequence of bits.
testBit returns True if the nth bit of the argument is 1.
-}
intToBits :: Bits a => a -> Int -> [ Bool ]
intToBits x idx = map (testBit x) [ 0 .. idx - 1 ]
{- | Convert Int32 to Word8
-}
int32ToWord8 :: Int -> [ Word8 ]
int32ToWord8 x = map fromIntegral
[ (shiftR x (pos * 8)) .&. 255 | pos <- [ 0, 1, 2, 3 ] ]
{-| Hides data 'message' in image.
Returns new image similar to old image but with data hidden inside it.
-}
encodeImage :: Image PixelRGB8 -> Int -> [ Word8 ] -> Either String
(Image PixelRGB8)
encodeImage img bitsPerPixel message
| bitsPerPixel <= 8 = Right
(runST $ do
newimg <- M.unsafeThawImage img
let modifyBits _i [] _start _b _period = M.freezeImage newimg
modifyBits i (x : xs) start b period = do
writeBitToImage img newimg b i 0 (bits !! 0) start period
writeBitToImage img newimg b i 1 (bits !! 1) start period
writeBitToImage img newimg b i 2 (bits !! 2) start period
writeBitToImage img newimg b i 3 (bits !! 3) start period
writeBitToImage img newimg b i 4 (bits !! 4) start period
writeBitToImage img newimg b i 5 (bits !! 5) start period
writeBitToImage img newimg b i 6 (bits !! 6) start period
writeBitToImage img newimg b i 7 (bits !! 7) start period
modifyBits (i + 1) xs start b period
where
bits = intToBits (x) 8
modifyBits 0 (int32ToWord8 len) 0 1
(63 / (fromIntegral (getPixelsforMessage 4 1)))
modifyBits 0 message 64 bitsPerPixel
((toRational (getTotalBits img bitsPerPixel))
/ (toRational (len * 8))))
| otherwise = Left "Too long information to be encoded!!!"
where
len = length message
{-| Writes data to image based on bits of message.
-}
writeBitToImage orig img bitsPerPixel byteIdx bitIdx bitVal offset period
| color == 0 = M.writePixel img px py
(PixelRGB8 (getChangedPixel (getRed (pixelAt orig px py)) lsbIdx bitVal)
(getGreen (pixelAt orig px py)) (getBlue (pixelAt orig px py)))
| color == 1 = M.writePixel img px py
(PixelRGB8 (getRed (pixelAt orig px py))
(getChangedPixel (getGreen (pixelAt orig px py)) lsbIdx bitVal)
(getBlue (pixelAt orig px py)))
| color == 2 = M.writePixel img px py
(PixelRGB8 (getRed (pixelAt orig px py)) (getGreen (pixelAt orig px py))
(getChangedPixel (getBlue (pixelAt orig px py)) lsbIdx bitVal))
where
pos = floor (fromIntegral (byteIdx * 8 + bitIdx) * period)
p = (div pos (bitsPerPixel * 3)) + offset
px = mod p (getWidth orig)
py = div p (getWidth orig)
color = (div (mod pos (bitsPerPixel * 3)) bitsPerPixel)
lsbIdx = (mod (mod pos (bitsPerPixel * 3)) bitsPerPixel)

114
app/Main.hs Normal file
View file

@ -0,0 +1,114 @@
{-# LANGUAGE LambdaCase #-}
module Main where
import Codec.Picture
import Data.Bits (xor)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.UTF8 as BLU
import Data.Char (chr, ord)
import Data.Word (Word8)
import DecodeSteg
import EncodeSteg
import System.Environment (getArgs)
import System.Random (randomRIO)
generateKey :: Int -> IO [ Int ]
generateKey n = sequence $ replicate n $ randomRIO ( 0, 65535 )
encodeText :: String -> [ Word8 ] -> IO [ Word8 ]
encodeText keypath content = do
key <- generateKey . length $ content
BL.writeFile keypath $ BL.pack (map fromIntegral key)
return $ map (\( a, b ) -> a `xor` b) $ zip content (map fromIntegral key)
decodeText :: [ Word8 ] -> [ Word8 ] -> [ Word8 ]
decodeText encodedText key = map (\( a, b ) -> a `xor` b) $ zip encodedText key
main :: IO ()
main = getArgs >>= \case
[ "encode", "file", filepath, encpath, "--img", imgpath ] -> do
let keypath = encpath ++ ".key"
filecontent <- BL.unpack <$> BL.readFile filepath
encoded <- encodeText keypath filecontent
readImage imgpath >>= \case
Left err -> putStrLn err
Right image -> do
let conv = (convertRGB8 image)
len = (length filepath) + 1 + (length encoded)
bitsPerPixel = getMinBits conv len
message = (BL.unpack . BLU.fromString $ filepath)
++ [ fromIntegral 0 ] ++ encoded
finalimg = (encodeImage conv bitsPerPixel message)
case finalimg of
Left errorStr -> putStrLn errorStr
Right encrypted -> do
savePngImage encpath $ ImageRGB8 encrypted
putStrLn ("Done")
[ "encode", "file", filepath, encpath ] -> do
let keypath = encpath ++ ".key"
filecontent <- BL.unpack <$> BL.readFile filepath
encoded <- encodeText keypath filecontent
BL.writeFile encpath $ BL.pack $ encoded
[ "encode", text, encpath, "--img", imgpath ] -> do
let keypath = encpath ++ ".key"
encoded <- encodeText keypath $ BL.unpack . BLU.fromString $ text
readImage imgpath >>= \case
Left err -> putStrLn err
Right image -> do
let conv = (convertRGB8 image)
len = 1 + (length encoded)
bitsPerPixel = getMinBits conv len
message = [ fromIntegral 0 ] ++ encoded
finalimg = (encodeImage conv bitsPerPixel message)
case finalimg of
Left errorStr -> putStrLn errorStr
Right encrypted -> do
savePngImage encpath $ ImageRGB8 encrypted
putStrLn ("Done")
[ "encode", text, encpath ] -> do
let keypath = encpath ++ ".key"
encoded <- encodeText keypath $ BL.unpack . BLU.fromString $ text
BL.writeFile encpath $ BL.pack $ encoded
[ "decode", "--img", imgpath, keypath, decodepath ] -> do
readImage imgpath >>= \case
Left err -> putStrLn err
Right image -> do
encodedText <- decodeImg . convertRGB8 $ image
key <- BL.unpack <$> BL.readFile keypath
printOrWriteFile decodepath $ BL.pack
$ decodeText encodedText key
[ "decode", encpath, keypath, decodepath ] -> do
encodedText <- BL.unpack <$> BL.readFile encpath
key <- BL.unpack <$> BL.readFile keypath
printOrWriteFile decodepath $ BL.pack $ decodeText encodedText key
_ -> help
where
printOrWriteFile filepath
= if filepath == "-" then print else BL.writeFile filepath
help :: IO ()
help = do
putStrLn "Name"
putStrLn ""
putStrLn " picsg - a tool for steganographing information in a picture encoded using the Vernam cipher."
putStrLn ""
putStrLn "Synopsis"
putStrLn ""
putStrLn " picsg [subcommand]"
putStrLn ""
putStrLn " where subcommand is one of the following:"
putStrLn ""
putStrLn " - encode <text> <output-path> [--img <image-path>]"
putStrLn " - encode file <file-path> <output-path> [--img <image-path>]"
putStrLn " - decode [--img] <encoded-path> <key-path> <output-path>"
putStrLn ""
putStrLn "Examples"
putStrLn ""
putStrLn " - Encode text using the Vernam cipher to the file hello.enc and create a file hello.enc.key with a key to decode the hello.enc file."
putStrLn ""
putStrLn " | picsg encode \"ABC\" hello.enc"
putStrLn ""
putStrLn " - Decode the hello.enc file using key and print to the standart output"
putStrLn ""
putStrLn " | picsg decode hello.enc hello.enc.key -"

61
flake.lock Normal file
View file

@ -0,0 +1,61 @@
{
"nodes": {
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1710146030,
"narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1712849433,
"narHash": "sha256-flQtf/ZPJgkLY/So3Fd+dGilw2DKIsiwgMEn7BbBHL0=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "f173d0881eff3b21ebb29a2ef8bedbc106c86ea5",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
}
}
},
"root": "root",
"version": 7
}

47
flake.nix Normal file
View file

@ -0,0 +1,47 @@
{
inputs = {
nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
flake-utils.url = "github:numtide/flake-utils";
};
outputs = { self, nixpkgs, flake-utils }:
flake-utils.lib.eachDefaultSystem (system:
let
pkgs = import nixpkgs { inherit system; };
hPkgs = pkgs.haskellPackages;
myDevTools = with hPkgs; [
ghc
ghcid
ormolu
hlint
hoogle
haskell-language-server
implicit-hie
retrie
];
picsg = pkgs.haskellPackages.developPackage {
root = ./.;
};
in
{
packages = {
default = picsg;
picsg = picsg;
docker = pkgs.dockerTools.buildImage {
name = "picgs";
config = {
Cmd = [ "${picsg}/bin/picsg" ];
};
};
};
devShells.default = pkgs.mkShell {
buildInputs = myDevTools ++ [ hPkgs.cabal-install ];
LD_LIBRARY_PATH = pkgs.lib.makeLibraryPath myDevTools;
};
});
}

80
picsg.cabal Normal file
View file

@ -0,0 +1,80 @@
cabal-version: 3.0
-- The cabal-version field refers to the version of the .cabal specification,
-- and can be different from the cabal-install (the tool) version and the
-- Cabal (the library) version you are using. As such, the Cabal (the library)
-- version used must be equal or greater than the version stated in this field.
-- Starting from the specification version 2.2, the cabal-version field must be
-- the first thing in the cabal file.
-- Initial package description 'picsg' generated by
-- 'cabal init'. For further documentation, see:
-- http://haskell.org/cabal/users-guide/
--
-- The name of the package.
name: picsg
-- The package version.
-- See the Haskell package versioning policy (PVP) for standards
-- guiding when and how versions should be incremented.
-- https://pvp.haskell.org
-- PVP summary: +-+------- breaking API changes
-- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change
version: 0.1.0.0
-- A short (one-line) description of the package.
-- synopsis:
-- A longer description of the package.
-- description:
-- The license under which the package is released.
license: GPL-3.0-or-later
-- The file containing the license text.
license-file: LICENSE
-- The package author(s).
author: Dmitriy Pleshevskiy
-- An email address to which users can send suggestions, bug reports, and patches.
maintainer: dmitriy@pleshevski.ru
-- A copyright notice.
-- copyright:
build-type: Simple
-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
extra-doc-files: CHANGELOG.md
-- Extra source files to be distributed with the package, such as examples, or a tutorial module.
-- extra-source-files:
common warnings
ghc-options: -Wall
executable picsg
-- Import common warning flags.
import: warnings
-- .hs or .lhs file containing the Main module.
main-is: Main.hs
-- Modules included in this executable, other than Main.
-- other-modules:
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:
-- Other library packages from which modules are imported.
build-depends: base ^>=4.18.2.0,
utf8-string == 1.0.2,
random == 1.2.1.2,
bytestring == 0.11.5.3,
JuicyPixels == 3.3.8
-- Directories containing source files.
hs-source-dirs: app
-- Base language which the package is written in.
default-language: Haskell2010