path: root/CmdLine.hs

{- Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

module CmdLine where

import Types
import Types.Storage
import Types.Server (HostName, Port)
import Types.Cost (Seconds(..))
import Storage.Local
import Storage.Network
import Tunables
import qualified Gpg
import Options.Applicative
import Data.Monoid
import qualified Data.ByteString.UTF8 as BU8
import qualified Data.Text as T
import System.Directory

data CmdLine = CmdLine
	{ mode :: Maybe Mode
	, secretkeysource :: Maybe SecretKeySource
	, localstoragedirectory :: Maybe LocalStorageDirectory
	, gui :: Bool
	, testMode :: Bool
	, customShareParams :: Maybe ShareParams
	, name :: Maybe Name
	, othername :: Maybe Name
	, preferredStorage :: [Maybe LocalStorageDirectory -> IO (Maybe Storage)]
	, serverConfig :: ServerConfig
	, chaffMaxDelay :: Maybe Seconds
	}

data Mode = Backup | Restore | UploadQueued | AutoStart | Server | BackupServer FilePath | RestoreServer FilePath | Chaff HostName | CheckServers | Benchmark | Test
	deriving (Show)

data ServerConfig = ServerConfig
	{ serverPort :: Port
	, serverAddress :: String
	, monthsToFillHalfDisk :: Integer
	, serverMotd :: Maybe T.Text
	}

parse :: Parser CmdLine
parse = CmdLine
	<$> optional parseMode
	<*> optional (gpgswitch <|> fileswitch)
	<*> optional localstoragedirectoryopt
	<*> guiswitch
	<*> testmodeswitch
	<*> optional parseShareParams
	<*> optional nameopt
	<*> optional othernameopt
	<*> many (addstoragedirectory <|> addserver)
	<*> parseServerConfig
	<*> optional chaffmaxdelayopt
  where
	gpgswitch = GpgKey . KeyId . T.pack <$> strOption
		( long "gpgkeyid"
		<> metavar "KEYID"
		<> help "Specify keyid of gpg key to back up or restore. (When this option is used to back up a key, it must also be used at restore time.)"
		)
	fileswitch = KeyFile <$> strOption
		( long "keyfile"
		<> metavar "FILE"
		<> help "Specify secret key file to back up or restore. (The same filename must be used to restore a key as was used to back it up.)"
		)
	localstoragedirectoryopt = LocalStorageDirectory <$> option str
		( long "store-directory"
		<> metavar "DIR"
		<> help "Where to store data locally. For the client, data is stored here before it is uploaded to the server. For the server, this is where it stores its data. (default: ~/.keysafe/objects/)"
		)
	testmodeswitch = switch
		( long "testmode"
		<> help "Avoid using expensive cryptographic operations to secure data. Use for testing only, not with real secret keys."
		)
	guiswitch = switch
		( long "gui"
		<> help "Use GUI interface for interaction. Default is to use readline interface when run in a terminal, and GUI otherwise."
		)
	nameopt = option nameOption
		( long "name"
		<> metavar "N"
		<> help "Specify name used for key backup/restore, avoiding the usual prompt."
		)
	othernameopt = option nameOption
		( long "othername"
		<> metavar "N"
		<> help "Specify other name used for key backup/restore, avoiding the usual prompt."
		)
	chaffmaxdelayopt = option secondsOption
		( long "chaff-max-delay"
		<> metavar "SECONDS"
		<> help "Specify a delay between chaff uploads. Will delay a random amount between 0 and this many seconds."
		)
	addstoragedirectory = (\d _lsd -> localStorageOverride d) 
		<$> strOption
			( long "add-storage-directory"
			<> metavar "DIR"
			<> help "Add the directory to the list of locations keysafe will use for backup/restore of keys. Keysafe will use the directory first, before any of its built-in servers."
			)
	addserver = (\(h, p) lsd -> networkStorageOverride lsd h p) 
		<$> option hostPortOption
			( long "add-server"
			<> metavar "HOST[:PORT]"
			<> help "Add the server to the server list which keysafe will use for backup/restore of keys. Keysafe will use the server first before any of its built-in servers."
			)

parseMode :: Parser Mode
parseMode = 
	flag' Backup
		( long "backup"
		<> help "Store a secret key in keysafe."
		)
	<|> flag' Restore
		( long "restore"
		<> help "Retrieve a secret key from keysafe."
		)
	<|> flag' UploadQueued
		( long "uploadqueued"
		<> help "Upload any data to servers that was queued by a previous --backup run."
		)
	<|> flag' AutoStart
		( long "autostart"
		<> help "Run automatically on login by desktop autostart file."
		)
	<|> flag' Server
		( long "server"
		<> help "Run as a keysafe server, accepting objects and storing them to ~/.keysafe/objects/local/"
		)
	<|> BackupServer <$> strOption
		( long "backup-server"
		<> metavar "BACKUPDIR"
		<> help "Run on a server, populates the directory with a gpg encrypted backup of all objects stored in the --store-directory. This is designed to be rsynced offsite (with --delete) to back up a keysafe server with minimal information leakage."
		)
	<|> RestoreServer <$> strOption
		( long "restore-server"
		<> metavar "BACKUPDIR"
		<> help "Restore all objects present in the gpg-encrypted backups in the specified directory."
		)
	<|> Chaff <$> strOption
		( long "chaff"
		<> metavar "HOSTNAME"
		<> help "Upload random data to a keysafe server."
		)
	<|> flag' CheckServers
		( long "check-servers"
		<> help "Tries to connect to each server in the server list. Displays the server's MOTD, and the amount of data stored on it. Prints message to stderr and exits nonzero if any of the servers are not accessible."
		)
	<|> flag' Benchmark
		( long "benchmark"
		<> help "Benchmark speed of keysafe's cryptographic primitives."
		)
	<|> flag' Test
		( long "test"
		<> help "Run test suite."
		)

parseShareParams :: Parser ShareParams
parseShareParams = ShareParams <$> totalobjects <*> neededobjects
  where
	totalobjects = option auto 
		( long "totalshares"
		<> metavar "M"
		<> help ("Configure the number of shares to split encrypted secret key into. "
			++ showdefault totalObjects ++ neededboth)
		)
	neededobjects = option auto 
		( long "neededshares"
		<> metavar "N"
		<> help ("Configure the number of shares needed to restore. " 
			++ showdefault neededObjects ++ neededboth)
		)
	showdefault f = "(default: " ++ show (f (shareParams defaultTunables)) ++ ")"
	neededboth = " (When this option is used to back up a key, it must also be provided at restore time.)"
	

parseServerConfig :: Parser ServerConfig
parseServerConfig = ServerConfig
	<$> option auto
		( long "port"
		<> metavar "P"
		<> value 4242
		<> showDefault
		<> help "Port for server to listen on."
		)
	<*> option str
		( long "address"
		<> metavar "A"
		<> value "127.0.0.1"
		<> showDefault
		<> help "Address for server to bind to. (Use \"*\" to bind to all addresses.)"
		)
	<*> option auto
		( long "months-to-fill-half-disk"
		<> metavar "N"
		<> value 12
		<> showDefault
		<> help "Server rate-limits requests and requires proof of work, to avoid too many objects being stored. This is an lower bound on how long it could possibly take for half of the current disk space to be filled."
		)
	<*> optional (T.pack <$> strOption 
		( long "motd"
		<> metavar "MESSAGE"
		<> help "The server's Message Of The Day."
		))

get :: IO CmdLine
get = execParser opts
  where
	opts = info (helper <*> parse)
		( fullDesc
		<> header "keysafe - securely back up secret keys"
		)

-- | When a mode is not specified on the command line,
-- default to backing up if a secret key exists, and otherwise restoring.
selectMode :: CmdLine -> IO Mode
selectMode cmdline = case mode cmdline of
	Just m -> return m
	Nothing -> case secretkeysource cmdline of
		Just (KeyFile f) -> present <$> doesFileExist f
		_ -> present . not . null <$> Gpg.listSecretKeys
  where
	present True = Backup
	present False = Restore

customizeShareParams :: CmdLine -> Tunables -> Tunables
customizeShareParams cmdline t = case customShareParams cmdline of
	Nothing -> t
	Just ps -> t { shareParams = ps }

secondsOption :: ReadM Seconds
secondsOption = Seconds . toRational <$> (auto :: ReadM Double)

nameOption :: ReadM Name
nameOption = Name . BU8.fromString <$> auto

hostPortOption :: ReadM (HostName, Port)
hostPortOption = eitherReader $ \s ->
	case break (== ':') s of
		([], []) -> Left "need a hostname"
		(h, ':':ps) -> case reads ps of
			[(p, "")] -> Right (h, p)
			_ -> Left $ "unable to parse port \"" ++ ps ++ "\""
		(h, _) -> Right (h, 4242)