module Unbreak.Run
( runInit
, runOpen
, runLogout
, runAdd
) where
import Prelude hiding ((++))
import Control.Monad
import Control.Exception
import System.IO
import System.IO.Error
import System.Exit
import System.Posix.ByteString
import System.Process
import Data.ByteString (ByteString)
import qualified Data.ByteString.OverheadFree as B
import qualified Data.ByteString.Base64.URL as B64
import qualified Data.Text.Encoding as T
import Unbreak.Crypto
import Unbreak.Format
(++) :: Monoid m => m -> m -> m
(++) = mappend
sessionPath :: ByteString
sessionPath = "/tmp/unbreak.session"
getHomePath :: IO ByteString
getHomePath = getEnv "HOME" >>= \ m -> case m of
Nothing -> error "$HOME not found"
Just h -> return h
runInit :: IO ()
runInit = do
confPath <- (++ "/.unbreak.json") <$> getHomePath
existence <- fileExist confPath
if existence
then B.putStrLn "There is already the ~/.unbreak.json file.\
\ If you are willing to create the default config file,\
\ please delete ~/.unbreak.json and retry.\n\
\Warning: the \"name\" part of the config may be required to open\
\ the documents you have created in the past."
else do
B.writeFile confPath (enc initConf)
B.putStrLn $ "Created the initial default configuration at " ++
confPath
session :: Conf -> IO (ByteString, ByteString)
session Conf{..} = catchIOError
( do
shelfPath <- B.readFile sessionPath
master <- B.readFile (shelfPath ++ "/master")
return (shelfPath, master)
)
$ const $ do
shelfPath <- mkdtemp "/dev/shm/unbreak-"
B.writeFile sessionPath shelfPath
B.putStr "Type password: "
password <- withNoEcho B.getLine <* B.putStrLn ""
let master = scrypt password (T.encodeUtf8 name)
B.writeFile (shelfPath ++ "/master") master
createDirectory (shelfPath ++ "/file") 0o700
return (shelfPath, master)
runOpen :: ByteString -> IO ()
runOpen filename = getConf f (`editRemoteFile` filename)
where
f errmsg = B.putStrLn ("Failed: " ++ errmsg) *> exitFailure
getConf :: (ByteString -> IO a) -> (Conf -> IO a) -> IO a
getConf failure success = do
confPath <- (++ "/.unbreak.json") <$> getHomePath
existence <- fileExist confPath
if existence
then do
rawConf <- B.readFile confPath
case dec rawConf of
Left errmsg -> failure $ B.pack errmsg
Right conf -> success conf
else do
B.putStrLn "You may need to run 'unbreak init' first."
failure "~/.unbreak.json does not exist"
editRemoteFile :: Conf -> ByteString -> IO ()
editRemoteFile conf@Conf{..} fileName = do
(shelfPath, master) <- session conf
let
encFileName = B64.encode $ encryptFileName master fileName
filePath = mconcat [shelfPath, "/file/", fileName]
encFilePath = mconcat [shelfPath, "/file/", encFileName]
remoteFilePath = mconcat [T.encodeUtf8 remote, encFileName]
tryRun (mconcat ["scp ", remoteFilePath, " ", encFilePath])
( decrypt master <$> B.tail <$> B.readFile encFilePath >>=
\ m -> case m of
CryptoPassed plaintext -> B.writeFile filePath plaintext
CryptoFailed e -> do
B.putStrLn $ "Decryption failed. " ++ B.pack (show e)
exitFailure
)
$ \ _ -> do
B.putStrLn "Create new file."
B.writeFile filePath ""
before <- epochTime
run (mconcat [T.encodeUtf8 editor, " ", filePath]) $ const $ do
B.putStrLn "Editor exited abnormally. Editing cancelled."
exitFailure
after <- modificationTime <$> getFileStatus filePath
when (before < after) $ do
encryptCopy master filePath encFilePath
run (mconcat ["scp ", encFilePath, " ", remoteFilePath]) $
\ n -> do
B.putStrLn $ mconcat
[ "[!] Upload failed. ("
, B.pack $ show n
, ")\nYour file is at:\n\n\t"
, filePath
, "\n\nIf you want to retry upload, try:\n\n\t"
, "unbreak add -f "
, filePath
, "\n"
]
removeLink encFilePath
exitFailure
removeLink encFilePath
removeLink filePath
B.putStrLn "Done."
runLogout :: IO ()
runLogout = do
shelfPath <- catchIOError (B.readFile sessionPath) $ \ e -> do
if isDoesNotExistError e
then B.putStrLn "You are not logged in."
else B.putStrLn $ mconcat
[ "Reading "
, sessionPath
, " has failed. ("
, B.pack $ show e
, ") Perhaps there is no active session?"
]
exitFailure
run ("rm -rf " ++ shelfPath) $ \ errorCode -> B.putStrLn $ mconcat
[ "[!] Removing the session directory at "
, shelfPath
, " failed! ("
, B.pack $ show errorCode
, ") Please manually delete it."
]
removeLink sessionPath
runAdd
:: Bool
-> RawFilePath
-> IO ()
runAdd force filePath = getConf f (\ c -> encryptAndSend c force filePath)
where
f errmsg = B.putStrLn ("Failed: " ++ errmsg) *> exitFailure
encryptAndSend :: Conf -> Bool -> RawFilePath -> IO ()
encryptAndSend conf@Conf{..} force filePath = do
(shelfPath, master) <- session conf
let
encFileName = B64.encode $ encryptFileName master fileName
encFilePath = mconcat [shelfPath, "/file/", encFileName]
remoteFilePath = mconcat [remoteB, encFileName]
action = do
encryptCopy master filePath encFilePath
run (mconcat ["scp ", encFilePath, " ", remoteFilePath]) $
\ n -> B.putStrLn $ mconcat
["Upload failed. (", B.pack $ show n, ")"]
removeLink encFilePath
if force then action
else tryRun (mconcat ["ssh ", host, " test -e ", docdir, encFileName])
( do
B.putStrLn
"The file name already exists in the storage. Cancelled."
exitFailure
)
$ const action
where
(host, cDocdir) = B.break (== ':') remoteB
docdir = if B.head cDocdir == ':' then B.tail cDocdir else cDocdir
remoteB = T.encodeUtf8 remote
(_, fileName) = B.breakEnd (== '/') filePath
encryptCopy :: ByteString -> RawFilePath -> RawFilePath -> IO ()
encryptCopy key sourcePath targetPath = do
plaintext <- B.readFile sourcePath
nonce <- getRandomBytes 12
B.writeFile targetPath $
"\0" ++ throwCryptoError (encrypt nonce key plaintext)
withNoEcho :: IO a -> IO a
withNoEcho action = do
old <- hGetEcho stdin
bracket_ (hSetEcho stdin False) (hSetEcho stdin old) action
run :: ByteString -> (Int -> IO ()) -> IO ()
run cmd = tryRun cmd (return ())
tryRun :: ByteString -> IO a -> (Int -> IO a) -> IO a
tryRun cmd successHandler failHandler = do
(_, _, _, p) <- createProcess (shell $ B.unpack cmd)
c <- waitForProcess p
case c of
ExitFailure n -> failHandler n
_ -> successHandler