make files inaccessible by changing their names and parts of their contents (reversable).

obst.hs

import System.Environment
import System.Exit
import Control.Applicative
import Data.Bits (xor)
import System.IO
import System.Directory
import System.FilePath
import Control.Monad
import Crypto.Hash.SHA512 (hash)
import Data.Char
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC

type Password = String
type Hash = B.ByteString
type Key = B.ByteString

encryptLength = 2 ^ 10
ext = "obst"
storedHashPath = fmap (++ pathSeparator : ".obst-pw.dat") getHomeDirectory

main :: IO ()
main = getArgs >>= parse >> exitSuccess

parse :: [FilePath] -> IO ()
parse [] = usage >> exitSuccess
parse ["-n"] = createStoredHash >> exitSuccess
parse fs = do
    h_stored <- readStoredHash
    pw <- readPassword
    checkPassword pw h_stored
    is_dir <- doesDirectoryExist (head fs)
    if (is_dir && (length fs) == 1)
    then processDirectory pw (head fs)
    else processFiles pw fs
    
    
processFiles :: Password -> [FilePath] -> IO ()
processFiles pw fs = forM_ fs $ \f -> do
    is_dir <- doesDirectoryExist f
    if is_dir
    then do
        putStrLn $ "Entering directory: " ++ f
        processDirectory pw f
        renameDirectory f (obstDirName pw f)
        putStrLn $ f ++ " -> " ++ (obstDirName pw f)
    else processFile pw f
    
processFile :: Password -> FilePath -> IO ()
processFile pw f = do
    existing <- doesFileExist f
    if existing
    then do
        progName <- getProgName
        when (f /= progName && f /= ('.' : pathSeparator : progName)) $ do
            encryptFile f pw
            renameFile f (obstFileName pw f)
            putStrLn $ f ++ " -> " ++ (obstFileName pw f)
    else putStrLn $ f ++ ": File does not exist!"
    
processDirectory :: Password -> FilePath -> IO ()
processDirectory pw f = do
    contents <- getDirectoryContents f
    processFiles pw $ map ((f ++ [pathSeparator]) ++) $ filter notDots contents
    where notDots f_ = f_ /= "." && f_ /= ".."
        
checkPassword :: Password -> Hash -> IO ()
checkPassword pw h_stored = do
    let h_pw = hash $ BC.pack pw
    when (h_pw /= h_stored) $ do
        putStrLn "Wrong password!"
        exitFailure
        
readPassword :: IO Password
readPassword = do
    putStr "Enter password: "
    hFlush stdout
    pw <- getLine
    return pw
    
readStoredHash :: IO Hash
readStoredHash = do
    p <- storedHashPath
    existing <- doesFileExist p
    if existing 
    then B.readFile p
    else do
        putStrLn "Set a password first (-n option)!"
        exitFailure

createStoredHash :: IO ()
createStoredHash = do
    putStr "Enter new global password (!): "
    hFlush stdout
    pw <- getLine
    let h = hash $ BC.pack pw 
    path <- storedHashPath
    B.writeFile path h

encryptFile :: FilePath -> Password -> IO ()
encryptFile f pw = withBinaryFile f ReadWriteMode (\handle -> do
    contents <- B.hGet handle encryptLength
    hSeek handle AbsoluteSeek 0 -- rewind
    let key = BC.pack $ take encryptLength $ cycle pw
    B.hPut handle $ encrypt key contents
    )

usage :: IO ()
usage = do
    progName <- getProgName
    putStrLn $ "Usage: " ++ progName ++ " [OPTION] [FILE]\n"
    putStrLn "Options:"
    putStrLn "-n\tSet a new global password"
    

obstFileName :: Password -> FilePath -> FilePath
obstFileName pw f_
    | isEncrypted = (fst df ++) $ shiftName (-1) $ drop (length ext + 1) $ dropExtension (snd df)
    | otherwise = fst df ++ ext ++ "." ++ (shiftName 1 (snd df)) ++ "." ++ ext
    where
        f = cleanFilePath f_
        isEncrypted = takeExtension f == ("." ++ ext) && take (length ext + 1) (snd df) == (ext ++ ".")
        df = splitFileName f
        shiftName s = map (shiftLetter (s * (charSumLength pw)))
        
obstDirName :: Password -> FilePath -> FilePath
obstDirName pw f_ = (fst df ++) $ map (shiftLetter 13) $ snd df
    where
        f = cleanFilePath f_
        df = splitFileName f        
        
cleanFilePath :: FilePath -> FilePath
cleanFilePath f = if (last f) == pathSeparator then (init f) else f

encrypt :: Key -> B.ByteString -> B.ByteString
encrypt k = B.pack . B.zipWith xor k

charSumLength :: Password -> Int
charSumLength = sum . (map ord)
    
shiftLetter :: Int -> Char -> Char
shiftLetter n c
    | c >= 'a' && c <= 'z' = shiftFrom 'a'
    | c >= 'A' && c <= 'Z' = shiftFrom 'A'
    | otherwise = c
    where shiftFrom s = chr $ (ord s) + (((ord c) - (ord s) + n) `mod` 26)