-- 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/. {-# 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"