htalkat-0.1.2: 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 LambdaCase #-}
module Main where
import Control.Monad (forM_, mplus, when)
import Data.List (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 Command
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 as O
#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) <- O.parseGlobal =<< getArgs
when (O.Version `elem` opts) $ putStrLn version >> exitSuccess
ddir <- do
let optDir = headMay [ path | O.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 | O.SocksHost h <- opts ])
. fromMaybe "1080" $ headMay [ p | O.SocksPort p <- opts ]
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 conf socksProxy [] args Connect
else die "Unknown command/name. Use 'htalkat h' for help."
Just cmd -> do
(lOpts,lArgs) <- O.parseLocal cmd args'
let conf' = foldr applyOptToConf conf lOpts
doCmd ddir conf' socksProxy lOpts lArgs cmd
doCmd :: FilePath -> Config -> SocksProxy -> [O.Opt] -> [String] -> Command -> IO ()
doCmd ddir conf socksProxy opts args = \case
Help -> case args of
[] -> putStr . O.globalHelp . 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 -> putStr $ cmdHelp ddir cmd
_ -> pure ()
cmd | O.Help `elem` opts -> putStr $ cmdHelp ddir cmd
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 conf 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 | 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 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 conf 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 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." ]