htalkat-0.1.1: Talkat.hs
-- This file is part of htalkat
-- Copyright (C) 2021 Martin Bays <mbays@sdf.org>
--
-- 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/.
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Monad (forM_, mplus, when)
import Data.Char (toLower)
import Data.List (isPrefixOf, sort)
import Data.Maybe (fromMaybe, isJust)
import Safe (headMay)
import System.Directory (createDirectoryIfMissing,
doesDirectoryExist, getHomeDirectory)
import System.Environment (getArgs, lookupEnv)
import System.Exit (exitFailure, exitSuccess)
import System.FilePath ((</>))
#ifndef WINDOWS
import System.Posix.Files (ownerModes, setFileMode)
#endif
import Config
import Fingerprint
import Host
import Identity
import Incoming
import Notify
import Petname
import Prompt
import TLSTalk
import User
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
cmdOfStr :: String -> Maybe Command
cmdOfStr s = headMay [ c
| c <- commands
, s `isPrefixOf` (toLower <$> show c) ]
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
ddir <- do
let optDir = headMay [ path | Opts.DataDir path <- opts ]
envDir <- lookupEnv "HTALKAT_DIR"
defDir <- (</> ".htalkat") <$> getHomeDirectory
pure . fromMaybe defDir $ optDir `mplus` envDir
doesDirectoryExist ddir >>! do
createDirectoryIfMissing True ddir
#ifndef WINDOWS
setFileMode ddir ownerModes -- chmod 700
#endif
createDirectoryIfMissing True $ ddir </> "incoming"
createDirectoryIfMissing True $ ddir </> "names"
createConfigFileIfNecessary ddir
createNotifyScriptIfNecessary ddir
let socksProxy = maybe (const NoSocksProxy) Socks5Proxy
(headMay [ h | Opts.SocksHost h <- opts ])
. fromMaybe "1080" $ headMay [ p | Opts.SocksPort p <- opts ]
let (mcmd,args') = if Opts.Help `elem` opts then (Just Help, args)
else (cmdOfStr =<< headMay args, drop 1 args)
case mcmd of
Nothing -> do
isConnectArg <- case args of
[target] -> isJust <$> resolveTarget ddir target
_ -> pure False
if isConnectArg
then doCmd ddir socksProxy args Connect
else die "Unknown command/name. Use 'htalkat h' for help."
Just cmd -> doCmd ddir socksProxy args' cmd
doCmd :: [Char] -> SocksProxy -> [String] -> Command -> IO ()
doCmd ddir socksProxy args = \case
Help -> case args of
[] -> putStr . Opts.help . init . concat $ (<>"\n") <$>
[ "Usage: htalkat [OPTION...] COMMAND [ARG...]"
, ""
, "Commands:"
, " htalkat i[dentity] [PUBLIC_NAME] create/show identity"
, " htalkat c[onnect] [talkat:]FP@HOST connect to host"
, " htalkat c[onnect] NAME connect to named user"
, " htalkat n[ame] [talkat:]FP[@HOST] [NAME] set name for user [at host]"
, " htalkat l[isten] start server"
, " htalkat a[nswer] [NAME] accept connection [from user]"
, " htalkat a[nswer] --list list unanswered connections"
, " htalkat n[ame] +N NAME set name for unnamed caller"
, " htalkat h[elp] [COMMAND] show help [on command]"
, ""
, "FP is a 32 hex character public key fingerprint."
, "HOST can specify a nonstandard port as \"HOSTNAME:PORT\""
, ""
, "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." ]
_ -> pure ()
Identity -> createOrShowIdentity ddir $ headMay args
Name -> case args of
target:args' | length args' <= 1 ->
resolveTarget ddir target >>= \case
Nothing -> die $ "Unknown: " <> target
Just user -> case args' of
name:_ | Just pet <- parsePetname name ->
writeName ddir user pet
name:_ -> die $ "Invalid name: " <> name
[] -> do
name <- promptLine $ "Enter name to assign to " <> showUser user <> ": "
doCmd ddir socksProxy [target,name] Name
[] -> do
names <- sort <$> loadNames ddir
forM_ names $ \name -> do
mUser <- lookupName ddir name
putStrLn $ showPetname name <> ": " <> case mUser of
Nothing -> "[unparseable name file!]"
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] ->
resolveTarget ddir target >>= \case
Nothing -> die $ "Unknown: " <> target
Just (User fp _) -> answerLast ddir (Just fp)
[] -> answerLast ddir Nothing
_ -> die "Usage: htalkat a [--list] [NAME]"
Listen -> loadIdentity ddir IdListen >>= \case
Nothing -> die "You must first create an identity with 'htalkat i'."
Just cred -> serve ddir cred
Connect -> loadIdentity ddir IdConnect >>= \case
Nothing -> die "You must first create an identity with 'htalkat i'."
Just cred -> case args of
[target] -> resolveTarget ddir target >>= \case
Nothing ->
die $ "Unknown: " <> target
Just (User _ Nothing) ->
die $ "No host associated with '" <> target <> "'."
Just (User fp (Just host)) ->
connect ddir 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"