diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,1 +1,10 @@ -0.1.1: First release +# htalkat Changelog + +## 0.1.2 +* Fix compatibility problems with older ghc; any base >= 4.9 should now work. +* Fix linebreaks in dumb client. +* Add per-command options mirroring most config options. +* Add options to use dumb client in place of curses client. + +## 0.1.1 +* First release diff --git a/Command.hs b/Command.hs new file mode 100644 --- /dev/null +++ b/Command.hs @@ -0,0 +1,32 @@ +-- This file is part of htalkat +-- Copyright (C) 2021 Martin Bays +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of version 3 of the GNU General Public License as +-- published by the Free Software Foundation, or any later version. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see http://www.gnu.org/licenses/. + +module Command where + +import Data.Char (toLower) +import Data.List (isPrefixOf) +import Safe (headMay) + +data Command + = Help + | Identity + | Name + | Answer + | Connect + | Listen + deriving (Eq,Ord,Show,Enum) + +commands :: [Command] +commands = enumFrom Help + +cmdOfStr :: String -> Maybe Command +cmdOfStr s = headMay [ c + | c <- commands + , s `isPrefixOf` (toLower <$> show c) ] diff --git a/Config.hs b/Config.hs --- a/Config.hs +++ b/Config.hs @@ -10,18 +10,25 @@ module Config where +import Safe (readMay) import System.Directory (doesFileExist) import System.Exit (exitFailure) import System.FilePath (()) +import Opts import Util +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif + data Config = Config { listen_host :: String , listen_port :: Int , accept_unnamed :: Bool , curses_local_top :: Bool , curses_log :: Bool + , use_dumb_client :: Bool , interactive_client :: [String] } deriving (Read) @@ -38,17 +45,32 @@ , " , curses_local_top = True # Display you above remote in curses client" , " , curses_log = False # Log conversations to files in ~/.htalkat/logs/" , "" + , " , use_dumb_client = False # Prefer dumb line-based client to curses client" + , "" , " # interactive_client: if non-empty, run in place of built-in client." , " # First string is the command to run, and subsequent strings are arguments." , " # It will be executed with two further arguments:" - , " # the name of the remote user," - , " # and the path to a unix domain socket to interact with." + , " # the path to a unix domain socket to interact with," + , " # and the name of the remote user." , " # Minimal example:" , " #, interactive_client = [\"sh\", \"-c\"," - , " # \"socat unix-connect:\\\"$2\\\" stdio\", \"talkatc\"]" + , " # \"socat unix-connect:\\\"$1\\\" stdio\", \"talkatc\"]" , " , interactive_client = []" , " }" ] + +applyOptToConf :: Opt -> Config -> Config +applyOptToConf (Host h) conf = conf { listen_host = h } +applyOptToConf (Port pStr) conf | Just p <- readMay pStr = conf { listen_port = p } +applyOptToConf AcceptUnnamed conf = conf { accept_unnamed = True } +applyOptToConf BlockUnnamed conf = conf { accept_unnamed = False } +applyOptToConf DumbClient conf = conf { use_dumb_client = True } +applyOptToConf CursesClient conf = conf { use_dumb_client = False } +applyOptToConf LocalTop conf = conf { curses_local_top = True } +applyOptToConf LocalBottom conf = conf { curses_local_top = False } +applyOptToConf Log conf = conf { curses_log = True } +applyOptToConf NoLog conf = conf { curses_log = False } +applyOptToConf _ conf = conf createConfigFileIfNecessary :: FilePath -> IO () createConfigFileIfNecessary ddir = diff --git a/CursesClient.hs b/CursesClient.hs --- a/CursesClient.hs +++ b/CursesClient.hs @@ -9,7 +9,6 @@ -- along with this program. If not, see http://www.gnu.org/licenses/. {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -47,6 +46,10 @@ import System.Posix.Signals #endif +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif + newtype Reversed = Reversed {getReversed :: T.Text} data StreamState = StreamState @@ -430,6 +433,7 @@ eraseLast strm n = do ss <- gets $ getSS strm ww <- liftIO getWidth + p <- gets (streamView . getSS strm) let cur = getReversed $ streamCurLine ss mightDecreaseHeight = -- +1 to handle case of wrapping at double-width char @@ -438,7 +442,7 @@ modify . mapSS strm . mapCurLine $ T.drop n if mightDecreaseHeight then redrawStream strm - else liftIO $ do + else when (p == 0) . liftIO $ do let win = streamWin ss (y,x) <- getYX win mvWAddStr win y (x - wErase) (replicate wErase ' ') diff --git a/DumbClient.hs b/DumbClient.hs --- a/DumbClient.hs +++ b/DumbClient.hs @@ -54,7 +54,7 @@ printWithErasures :: T.Text -> IO () printWithErasures = mapM_ (doLine . T.unpack) . T.lines where doLine :: String -> IO () - doLine = foldM_ go [] + doLine s = foldM_ go [] s >> putChar '\n' go [] '\b' = pure [] go (h:t) '\b' = erase (charWidth h) >> pure t diff --git a/Identity.hs b/Identity.hs --- a/Identity.hs +++ b/Identity.hs @@ -8,7 +8,6 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see http://www.gnu.org/licenses/. -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -46,6 +45,10 @@ import User import Util +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif + data IdentityType = IdConnect | IdListen deriving Eq loadIdentity :: FilePath -> IdentityType -> IO (Maybe Credential) @@ -98,8 +101,8 @@ secKey <- Ed25519.generateSecretKey let promptCN = do putStrLn "Enter a public name for this identity (can be blank)." - putStrLn "This will be shown to anyone you connect to, and only to them." - putStrLn "(You can change this later by rerunning this command)" + putStrLn "This will be shown to anyone you connect to, but not to incoming callers." + putStrLn "(You can reset this name later with 'htalkat i NEW_NAME')" promptLine "Public name: " cn <- maybe promptCN pure mCN connectChain <- generateSelfSigned secKey cn diff --git a/Incoming.hs b/Incoming.hs --- a/Incoming.hs +++ b/Incoming.hs @@ -25,6 +25,10 @@ import Petname import Util +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif + type Incoming = Int addIncoming :: FilePath -> Certificate -> FilePath -> Int -> IO Incoming diff --git a/Notify.hs b/Notify.hs --- a/Notify.hs +++ b/Notify.hs @@ -8,8 +8,6 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see http://www.gnu.org/licenses/. -{-# LANGUAGE CPP #-} - module Notify where import Control.Monad (void) @@ -25,6 +23,10 @@ import Fingerprint import Petname import Util + +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif notifyOfIncoming :: FilePath -> Certificate -> Petname -> IO () notifyOfIncoming ddir cert petname = do diff --git a/Opts.hs b/Opts.hs --- a/Opts.hs +++ b/Opts.hs @@ -10,20 +10,36 @@ {-# LANGUAGE Safe #-} -module Opts (help, parseArgs, Opt(..)) where +module Opts (globalHelp, localHelp, parseGlobal, parseLocal, Opt(..)) where import System.Console.GetOpt +import qualified Command as C + data Opt + -- global: = DataDir FilePath | SocksHost String | SocksPort String | Help | Version + -- local: + | Port String + | Host String + | BlockUnnamed + | AcceptUnnamed + | ListPending + | SpawnInteractive FilePath + | DumbClient + | CursesClient + | LocalTop + | LocalBottom + | Log + | NoLog deriving (Eq, Ord, Show) -options :: [OptDescr Opt] -options = +globalOptions :: [OptDescr Opt] +globalOptions = [ Option ['d'] ["datadir"] (ReqArg DataDir "PATH") "default: ~/.htalkat, or $HTALKAT_DIR if set" , Option ['S'] ["socks-host"] (ReqArg SocksHost "HOST") "use SOCKS5 proxy" , Option ['P'] ["socks-port"] (ReqArg SocksPort "PORT") "port for SOCKS5 proxy (default: 1080)" @@ -31,11 +47,45 @@ , Option ['h'] ["help"] (NoArg Help) "show usage information" ] -help :: String -> String -help = (`usageInfo` options) +localOptions :: C.Command -> [OptDescr Opt] +localOptions com = + Option ['h'] ["help"] (NoArg Help) "show usage information" : + case com of + C.Listen -> + [ Option ['p'] ["port"] (ReqArg Port "PORT") "Port to listen on (default: 5518)" + , Option ['H'] ["host"] (ReqArg Host "HOST") "Host to listen on (empty means bind all available)" + , Option ['b'] ["block-unnamed"] (NoArg BlockUnnamed) "Reject connections from unnamed users" + , Option ['a'] ["accept-unnamed"] (NoArg AcceptUnnamed) "Accept connections from unnamed users (default)" + ] + C.Answer -> + [ Option ['l'] ["list"] (NoArg ListPending) "List unanswered incoming connections" + , Option ['i'] ["interactive-client"] (ReqArg SpawnInteractive "SOCKET_PATH") "Directly invoke interactive client" + ] <> interactiveClientOptions + C.Connect -> interactiveClientOptions + _ -> [] + where interactiveClientOptions = + [ Option ['d'] ["dumb"] (NoArg DumbClient) "Use dumb line-based client" + , Option ['c'] ["curses"] (NoArg CursesClient) "Use curses client (default)" + , Option ['t'] ["top"] (NoArg LocalTop) "Put you on top in curses client" + , Option ['b'] ["bottom"] (NoArg LocalBottom) "Put you on bottom in curses client (default)" + , Option ['L'] ["log"] (NoArg Log) "Log conversation" + , Option ['N'] ["no-log"] (NoArg NoLog) "Don't log conversation (default)" + ] -parseArgs :: [String] -> IO ([Opt],[String]) -parseArgs argv = - case getOpt RequireOrder options argv of +globalHelp :: String -> String +globalHelp = (`usageInfo` globalOptions) + +localHelp :: C.Command -> String -> String +localHelp c = (`usageInfo` localOptions c) + +parseArgs :: [OptDescr Opt] -> [String] -> IO ([Opt],[String]) +parseArgs opts argv = + case getOpt RequireOrder opts argv of (o,n,[]) -> return (o,n) (_,_,errs) -> ioError . userError $ concat errs + +parseGlobal :: [String] -> IO ([Opt],[String]) +parseGlobal = parseArgs globalOptions + +parseLocal :: C.Command -> [String] -> IO ([Opt],[String]) +parseLocal = parseArgs . localOptions diff --git a/Petname.hs b/Petname.hs --- a/Petname.hs +++ b/Petname.hs @@ -27,6 +27,10 @@ import Mundanities import User +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif + data Petname = Named String | Unnamed Int deriving (Eq) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,10 @@ # htalkat: Haskell client and server for talkat (Talk Across TLS) -## Building from source -Install the haskell package manager cabal; e.g. on a debian system: +# Building from source +Install the haskell package manager cabal, and the ncurses library and headers; +e.g. on a debian system: ``` -$ sudo apt-get install cabal-install +$ sudo apt-get install cabal-install libncursesw5-dev ``` Then in the htalkat directory, run: ``` @@ -11,10 +12,10 @@ ``` The resulting binary will be installed by default as `~/.cabal/bin/htalkat`. -### Compile-time options +## Compile-time options * `cabal install -f -curses`: compile without curses; a very simple dumb client is used instead. -## Basic usage +# Basic usage ``` # Create your cryptographic identity: htalkat i @@ -33,10 +34,10 @@ htalkat h ``` -## Configuration +# Configuration After first run, you can edit ~/.htalkat/htalkat.conf for general configuration options, and ~/.htalkat/notify.sh to set how the server notifies you of incoming connections. -## Portability +# Portability htalkat was written with POSIX systems in mind, and has only been tested on them, but it may also be possible to compile and run it on Windows. Please let me know if you try. -- mbays@sdf.org diff --git a/RelayStream.hs b/RelayStream.hs --- a/RelayStream.hs +++ b/RelayStream.hs @@ -89,8 +89,7 @@ killThread decodeTTThread _ <- takeMVar finished - TLS.bye ctxt - ignoreIOErr $ killThread sockThread + ignoreIOErr $ TLS.bye ctxt >> killThread sockThread tryTakeMVar sockMV >>= \case Nothing -> pure () Just sock -> S.gracefulClose sock 1000 diff --git a/TLSTalk.hs b/TLSTalk.hs --- a/TLSTalk.hs +++ b/TLSTalk.hs @@ -8,7 +8,6 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see http://www.gnu.org/licenses/. -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -60,8 +59,11 @@ #ifdef CURSES import CursesClient -#else +#endif import DumbClient + +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup #endif bindingNamedSocket :: FilePath -> (S.Socket -> IO a) -> IO a @@ -72,9 +74,8 @@ S.listen sock 1 pure sock -serve :: FilePath -> Credential -> IO () -serve ddir cred = errorOnNoLock <=< withTryFileLock listenLockPath Exclusive $ \_ -> do - conf <- loadConfig ddir +serve :: FilePath -> Config -> Credential -> IO () +serve ddir conf cred = errorOnNoLock <=< withTryFileLock listenLockPath Exclusive $ \_ -> do let params = def { serverShared = def { sharedCredentials = Credentials [cred] } , serverSupported = def @@ -110,20 +111,23 @@ S.setSocketOption sock S.NoDelay 1 context <- contextNew sock params handshake context - Just cert <- (takeTailCert =<<) <$> getClientCertificateChain context - (if accept_unnamed conf then ((Just <$>) .) . lookupOrAddPetname else lookupPetname) - ddir (spkiFingerprint cert) >>= \case + mCert <- (takeTailCert =<<) <$> getClientCertificateChain context + case mCert of Nothing -> pure () - Just petname -> withSystemTempDirectory "htalkat" $ \tdir -> do - let sockPath = tdir "sock" - bindingNamedSocket sockPath $ \dSock -> do - -- Serial numbers ensure we don't delete the wrong dir - serial <- modifyMVar serialMVar $ \n -> pure (n+1,n) - incoming <- addIncoming ddir cert sockPath serial - notifyOfIncoming ddir cert petname - relayStream context WriteFirst dSock - withFileLock (incomingDir ddir ".lock") Exclusive $ \_ -> - cleanIncoming ddir (Just serial) incoming + Just cert -> (if accept_unnamed conf + then ((Just <$>) .) . lookupOrAddPetname else lookupPetname) + ddir (spkiFingerprint cert) >>= \case + Nothing -> pure () + Just petname -> withSystemTempDirectory "htalkat" $ \tdir -> do + let sockPath = tdir "sock" + bindingNamedSocket sockPath $ \dSock -> do + -- Serial numbers ensure we don't delete the wrong dir + serial <- modifyMVar serialMVar $ \n -> pure (n+1,n) + incoming <- addIncoming ddir cert sockPath serial + notifyOfIncoming ddir cert petname + relayStream context WriteFirst dSock + withFileLock (incomingDir ddir ".lock") Exclusive $ \_ -> + cleanIncoming ddir (Just serial) incoming where listenLockPath = ddir ".listen_lock" errorOnNoLock :: Maybe a -> IO () @@ -136,8 +140,8 @@ = NoSocksProxy | Socks5Proxy String String -connect :: FilePath -> Credential -> String -> SocksProxy -> Host -> Fingerprint -> IO () -connect ddir cred name socksProxy (Host hostname port) fp = do +connect :: FilePath -> Config -> Credential -> String -> SocksProxy -> Host -> Fingerprint -> IO () +connect ddir conf cred name socksProxy (Host hostname port) fp = do let serverId = if port == defaultTalkatPort then BS.empty else TS.encodeUtf8 . TS.pack . (':':) $ show port @@ -160,7 +164,6 @@ let path = tdir "sock" bindingNamedSocket path $ \dSock -> do _ <- forkIO $ relayStream context WriteSecond dSock - conf <- loadConfig ddir spawnInteractiveClient ddir conf name path where openSocket :: IO S.Socket @@ -196,8 +199,8 @@ , cipher_TLS13_AES128CCM_SHA256 ] -answerLast :: FilePath -> Maybe Fingerprint -> IO () -answerLast ddir mFp = do +answerLast :: FilePath -> Config -> Maybe Fingerprint -> IO () +answerLast ddir conf mFp = do mInfo <- withFileLock (incomingDir ddir ".lock") Exclusive $ \_ -> do lastIncoming ddir mFp >>= \case Just incoming -> do @@ -208,7 +211,6 @@ Nothing -> pure Nothing case mInfo of Just (petname, sockPath) -> do - conf <- loadConfig ddir spawnInteractiveClient ddir conf (showPetname petname) sockPath Nothing -> putStrLn "Nothing to answer." @@ -218,7 +220,7 @@ void . rawSystem command $ args ++ [name, sockPath] | otherwise = #ifdef CURSES - do + if not $ use_dumb_client conf then do mLog <- if curses_log conf then do createDirectoryIfMissing True $ ddir "logs" @@ -227,12 +229,11 @@ "-" <> show epochSecs <.> "log") AppendMode else pure Nothing cursesClient (curses_local_top conf) mLog name sockPath -#else - dumbClient sockPath + else #endif + dumbClient sockPath -spawnDefaultInteractiveClient :: FilePath -> String -> FilePath -> IO () -spawnDefaultInteractiveClient ddir name sockPath = do - conf <- loadConfig ddir +spawnDefaultInteractiveClient :: FilePath -> Config -> String -> FilePath -> IO () +spawnDefaultInteractiveClient ddir conf name sockPath = do spawnInteractiveClient ddir (conf { interactive_client = [] }) name sockPath diff --git a/Talkat.hs b/Talkat.hs --- a/Talkat.hs +++ b/Talkat.hs @@ -8,14 +8,12 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see http://www.gnu.org/licenses/. -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Main where import Control.Monad (forM_, mplus, when) -import Data.Char (toLower) -import Data.List (isPrefixOf, sort) +import Data.List (sort) import Data.Maybe (fromMaybe, isJust) import Safe (headMay) import System.Directory (createDirectoryIfMissing, @@ -28,6 +26,7 @@ import System.Posix.Files (ownerModes, setFileMode) #endif +import Command import Config import Fingerprint import Host @@ -41,35 +40,22 @@ import Util import Version -import qualified Opts - -data Command - = Help - | Identity - | Name - | Answer - | Connect - | Listen - deriving (Eq,Ord,Show,Enum) - -commands :: [Command] -commands = enumFrom Help +import qualified Opts as O -cmdOfStr :: String -> Maybe Command -cmdOfStr s = headMay [ c - | c <- commands - , s `isPrefixOf` (toLower <$> show c) ] +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif die :: String -> IO () die s = putStrLn s >> exitFailure main :: IO () main = do - (opts,args) <- Opts.parseArgs =<< getArgs - when (Opts.Version `elem` opts) $ putStrLn version >> exitSuccess + (opts,args) <- O.parseGlobal =<< getArgs + when (O.Version `elem` opts) $ putStrLn version >> exitSuccess ddir <- do - let optDir = headMay [ path | Opts.DataDir path <- opts ] + let optDir = headMay [ path | O.DataDir path <- opts ] envDir <- lookupEnv "HTALKAT_DIR" defDir <- ( ".htalkat") <$> getHomeDirectory pure . fromMaybe defDir $ optDir `mplus` envDir @@ -84,26 +70,30 @@ createNotifyScriptIfNecessary ddir let socksProxy = maybe (const NoSocksProxy) Socks5Proxy - (headMay [ h | Opts.SocksHost h <- opts ]) - . fromMaybe "1080" $ headMay [ p | Opts.SocksPort p <- opts ] + (headMay [ h | O.SocksHost h <- opts ]) + . fromMaybe "1080" $ headMay [ p | O.SocksPort p <- opts ] - let (mcmd,args') = if Opts.Help `elem` opts then (Just Help, args) + let (mcmd,args') = if O.Help `elem` opts then (Just Help, args) else (cmdOfStr =<< headMay args, drop 1 args) + conf <- loadConfig ddir case mcmd of Nothing -> do isConnectArg <- case args of [target] -> isJust <$> resolveTarget ddir target _ -> pure False if isConnectArg - then doCmd ddir socksProxy args Connect + then doCmd ddir conf socksProxy [] args Connect else die "Unknown command/name. Use 'htalkat h' for help." - Just cmd -> doCmd ddir socksProxy args' cmd + Just cmd -> do + (lOpts,lArgs) <- O.parseLocal cmd args' + let conf' = foldr applyOptToConf conf lOpts + doCmd ddir conf' socksProxy lOpts lArgs cmd -doCmd :: [Char] -> SocksProxy -> [String] -> Command -> IO () -doCmd ddir socksProxy args = \case +doCmd :: FilePath -> Config -> SocksProxy -> [O.Opt] -> [String] -> Command -> IO () +doCmd ddir conf socksProxy opts args = \case Help -> case args of - [] -> putStr . Opts.help . init . concat $ (<>"\n") <$> + [] -> putStr . O.globalHelp . init . concat $ (<>"\n") <$> [ "Usage: htalkat [OPTION...] COMMAND [ARG...]" , "" , "Commands:" @@ -122,60 +112,11 @@ , "" , "Options:" ] - [c] | Just cmd <- cmdOfStr c -> mapM_ putStrLn $ case cmd of - Help -> [ "htalkat h[elp] [COMMAND]" - , " Show help [on command]." ] - Identity -> - [ "htalkat i[dentity] [PUBLIC_NAME]" - , " Create new identity (prompting for public name if omitted)," - , " or show existing identity." - , " If PUBLIC_NAME is given and identity exists, change public name in identity." - ] - Name -> - [ "htalkat n[ame] [talkat:]FP[@HOST] [NAME]" - , " Set NAME as a synonym for the user identified by the given fingerprint." - , " The name will be shown when receiving a call from the user." - , " If a host is specified, then NAME can be used with the c[onnect] command." - , " If NAME already exists, it will be overwritten." - , " If NAME is omitted, it will be prompted for; this makes a good URI handler." - , "htalkat n[ame] NAME1 NAME2:" - , " As above, but setting NAME2 to whatever NAME1 is currently set to." - , " NAME1 may be of the form +N (+1, +2 etc); these pseudonames are" - , " automatically assigned to unknown incoming callers." - , "htalkat n[ame]:" - , " List known names." - , "" - , "Names are saved as files in " <> show ddir "names" <> "." - , "To delete, rename, or copy names, manipulate these files directly." ] - Connect -> - [ "htalkat c[onnect] NAME" - , " Connect to user at host as previously named with the n[ame] command." - , "htalkat c[onnect] [talkat:]FP@HOST" - , " Call host. It is important to obtain the correct fingerprint of the person" - , " you intend to call, not just give whatever fingerprint is served by the host." - , "" - , "The command 'c[onnect]' can normally be omitted." - , "NAME@HOST also works." - ] - Answer -> [ "htalkat a[nswer] [NAME]" - , " Answer most recent incoming call, restricting to calls from NAME if given." - , "" - , "htalkat a[nswer] --list" - , " List unanswered incoming connections." - , "" - , "htalkat a[nswer] --interactive-client NAME SOCKET_PATH" - , " Directly invoke interactive client," - , " for use with the interactive_client config option." - ] - Listen -> [ "htalkat l[isten]" - , " Start server process which will listen for calls and announce them." - , " Other users will be able to connect to you at talkat:FP@HOST[:PORT]," - , " where FP is as given by i[dentity], HOST is your hostname or IP address," - , " and PORT is a non-standard port if you set one." - , " See " <> ddir "listen.conf" <> " for configuration options," - , " and " <> ddir "notify.sh" <> " to set up notifications." ] + [c] | Just cmd <- cmdOfStr c -> putStr $ cmdHelp ddir cmd _ -> pure () + cmd | O.Help `elem` opts -> putStr $ cmdHelp ddir cmd + Identity -> createOrShowIdentity ddir $ headMay args Name -> case args of @@ -188,7 +129,7 @@ name:_ -> die $ "Invalid name: " <> name [] -> do name <- promptLine $ "Enter name to assign to " <> showUser user <> ": " - doCmd ddir socksProxy [target,name] Name + doCmd ddir conf socksProxy [] [target,name] Name [] -> do names <- sort <$> loadNames ddir forM_ names $ \name -> do @@ -198,19 +139,21 @@ Just (User fp mh) -> showFingerprint fp <> maybe "" (("@" <>) . showHost) mh _ -> die "Usage: htalkat n [talkat:]FP[@HOST[:PORT]] NAME; htalkat n NAME1 NAME2" - Answer -> case args of - s:_ | s `elem` ["-l","--list"] -> mapM_ putStrLn =<< listIncoming ddir - [s,name,sockPath] | s `elem` ["-i","--interactive-client"] -> - spawnDefaultInteractiveClient ddir name sockPath - [target] -> + + Answer | O.ListPending `elem` opts -> mapM_ putStrLn =<< listIncoming ddir + Answer | Just sockPath <- headMay [ p | O.SpawnInteractive p <- opts ] -> + case args of + [name] -> spawnDefaultInteractiveClient ddir conf name sockPath + _ -> die "Usage: htalkat a -i SOCK_PATH NAME" + Answer | [target] <- args -> resolveTarget ddir target >>= \case Nothing -> die $ "Unknown: " <> target - Just (User fp _) -> answerLast ddir (Just fp) - [] -> answerLast ddir Nothing - _ -> die "Usage: htalkat a [--list] [NAME]" + Just (User fp _) -> answerLast ddir conf (Just fp) + Answer -> answerLast ddir conf Nothing + Listen -> loadIdentity ddir IdListen >>= \case Nothing -> die "You must first create an identity with 'htalkat i'." - Just cred -> serve ddir cred + Just cred -> serve ddir conf cred Connect -> loadIdentity ddir IdConnect >>= \case Nothing -> die "You must first create an identity with 'htalkat i'." Just cred -> case args of @@ -220,8 +163,59 @@ Just (User _ Nothing) -> die $ "No host associated with '" <> target <> "'." Just (User fp (Just host)) -> - connect ddir cred name socksProxy host fp + connect ddir conf cred name socksProxy host fp where name | Just pet <- parsePetname target = showPetname pet | otherwise = showHost host _ -> die "Usage: htalkat c NAME[@HOST]; htalkat c [talkat:]FP@HOST" + +cmdHelp :: FilePath -> Command -> String +cmdHelp ddir c = O.localHelp c . unlines $ cmdHelp' c + where + cmdHelp' Help = + [ "htalkat h[elp] [COMMAND]" + , " Show help [on command]." ] + cmdHelp' Identity = + [ "htalkat i[dentity] [PUBLIC_NAME]" + , " Create new identity (prompting for public name if omitted)," + , " or show existing identity." + , " If PUBLIC_NAME is given and identity exists, change public name in identity." + ] + cmdHelp' Name = + [ "htalkat n[ame] [talkat:]FP[@HOST] [NAME]" + , " Set NAME as a synonym for the user identified by the given fingerprint." + , " The name will be shown when receiving a call from the user." + , " If a host is specified, then NAME can be used with the c[onnect] command." + , " If NAME already exists, it will be overwritten." + , " If NAME is omitted, it will be prompted for; this makes a good URI handler." + , "htalkat n[ame] NAME1 NAME2:" + , " As above, but setting NAME2 to whatever NAME1 is currently set to." + , " NAME1 may be of the form +N (+1, +2 etc); these pseudonames are" + , " automatically assigned to unknown incoming callers." + , "htalkat n[ame]:" + , " List known names." + , "" + , "Names are saved as files in " <> ddir "names" <> "." + , "To delete, rename, or copy names, manipulate these files directly." ] + cmdHelp' Connect = + [ "htalkat c[onnect] NAME" + , " Connect to user at host as previously named with the n[ame] command." + , "htalkat c[onnect] [talkat:]FP@HOST" + , " Call host. It is important to obtain the correct fingerprint of the person" + , " you intend to call, not just give whatever fingerprint is served by the host." + , "" + , "The command 'c[onnect]' can normally be omitted." + , "NAME@HOST also works." + ] + cmdHelp' Answer = + [ "htalkat a[nswer] [NAME]" + , " Answer most recent incoming call, restricting to calls from NAME if given." + ] + cmdHelp' Listen = + [ "htalkat l[isten]" + , " Start server process which will listen for calls and announce them." + , " Other users will be able to connect to you at talkat:FP@HOST[:PORT]," + , " where FP is as given by i[dentity], HOST is your hostname or IP address," + , " and PORT is a non-standard port if you set one." + , " See " <> ddir "listen.conf" <> " for configuration options," + , " and " <> ddir "notify.sh" <> " to set up notifications." ] diff --git a/TimedText.hs b/TimedText.hs --- a/TimedText.hs +++ b/TimedText.hs @@ -19,6 +19,10 @@ import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.Encoding as T +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif + type TimedText = [ Either Int Char ] pauseMax :: Int diff --git a/User.hs b/User.hs --- a/User.hs +++ b/User.hs @@ -16,11 +16,15 @@ , showUser ) where -import Control.Monad (guard, msum) -import Data.List (stripPrefix) +import Control.Monad (guard, msum) +import Data.List (stripPrefix) import Fingerprint import Host + +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif data User = User { userFP :: Fingerprint diff --git a/Version.hs b/Version.hs --- a/Version.hs +++ b/Version.hs @@ -16,4 +16,4 @@ programName = "htalkat" version :: String -version = "0.1.1" +version = "0.1.2" diff --git a/htalkat.cabal b/htalkat.cabal --- a/htalkat.cabal +++ b/htalkat.cabal @@ -1,6 +1,6 @@ -cabal-version: >=1.18 +cabal-version: 1.18 name: htalkat -version: 0.1.1 +version: 0.1.2 license: GPL-3 license-file: COPYING maintainer: mbays@sdf.org @@ -24,11 +24,13 @@ flag curses description: Enable Curses UI + manual: True executable htalkat main-is: Talkat.hs other-modules: Certificate + Command Config DumbClient Fingerprint @@ -51,15 +53,16 @@ WCWidth default-language: Haskell2010 - ghc-options: -threaded -Wall + default-extensions: CPP + ghc-options: -threaded -Wall -Wcompat build-depends: - base >=4.6 && <5, + base >=4.9 && <5, array >=0.3 && <0.6, asn1-encoding <0.10, asn1-types >=0.3.4 && <0.4, - bytestring >=0.10.4.0 && <0.12, + bytestring >=0.10.8.0 && <0.12, containers >=0.5.5.1 && <0.7, - cryptonite >=0.26 && <0.30, + cryptonite >=0.26 && <0.31, data-default-class >=0.1.2.0 && <0.2, data-hash >=0.2.0.1 && <0.3, directory >=1.2.1.0 && <1.4, @@ -67,8 +70,8 @@ filelock <0.2, filepath >=1.3.0.2 && <1.5, hourglass >=0.2.12 && <0.3, - memory >=0.14 && <0.17, - mtl >=2.0 && <2.3, + memory >=0.14 && <0.18, + mtl >=2.0 && <2.4, network >=2.4.2.3 && <3.2, network-simple >=0.4.3 && <0.5, pem >=0.2.4 && <0.3, @@ -76,10 +79,10 @@ rset <1.1, safe >=0.3.19 && <0.4, temporary >= 1.2 && <1.4, - text >=1.1.0.0 && <1.3, - time <1.13, + text >=1.1.0.0 && <2.1, + time <1.14, tls >=1.5.4 && <1.6, - transformers >=0.3.0.0 && <0.6, + transformers >=0.3.0.0 && <0.7, x509 >=1.7.5 && <1.8, x509-validation >=1.6.11 && <1.7