-- 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 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." ]