Talkat.hs

   1 -- This file is part of htalkat
   2 -- Copyright (C) 2021 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 {-# LANGUAGE LambdaCase #-}
  12
  13 module Main where
  14
  15 import           Control.Monad      (forM_, mplus, when)
  16 import           Data.List          (sort)
  17 import           Data.Maybe         (fromMaybe, isJust)
  18 import           Safe               (headMay)
  19 import           System.Directory   (createDirectoryIfMissing,
  20                                      doesDirectoryExist, getHomeDirectory)
  21 import           System.Environment (getArgs, lookupEnv)
  22 import           System.Exit        (exitFailure, exitSuccess)
  23 import           System.FilePath    ((</>))
  24
  25 #ifndef WINDOWS
  26 import           System.Posix.Files (ownerModes, setFileMode)
  27 #endif
  28
  29 import           Command
  30 import           Config
  31 import           Fingerprint
  32 import           Host
  33 import           Identity
  34 import           Incoming
  35 import           Notify
  36 import           Petname
  37 import           Prompt
  38 import           TLSTalk
  39 import           User
  40 import           Util
  41 import           Version
  42
  43 import qualified Opts               as O
  44
  45 #if !(MIN_VERSION_base(4,11,0))
  46 import           Data.Semigroup
  47 #endif
  48
  49 die :: String -> IO ()
  50 die s = putStrLn s >> exitFailure
  51
  52 main :: IO ()
  53 main = do
  54     (opts,args) <- O.parseGlobal =<< getArgs
  55     when (O.Version `elem` opts) $ putStrLn version >> exitSuccess
  56
  57     ddir <- do
  58         let optDir = headMay [ path | O.DataDir path <- opts ]
  59         envDir <- lookupEnv "HTALKAT_DIR"
  60         defDir <- (</> ".htalkat") <$> getHomeDirectory
  61         pure . fromMaybe defDir $ optDir `mplus` envDir
  62     doesDirectoryExist ddir >>! do
  63         createDirectoryIfMissing True ddir
  64 #ifndef WINDOWS
  65         setFileMode ddir ownerModes -- chmod 700
  66 #endif
  67         createDirectoryIfMissing True $ ddir </> "incoming"
  68         createDirectoryIfMissing True $ ddir </> "names"
  69         createConfigFileIfNecessary ddir
  70         createNotifyScriptIfNecessary ddir
  71
  72     let socksProxy = maybe (const NoSocksProxy) Socks5Proxy
  73             (headMay [ h | O.SocksHost h <- opts ])
  74             . fromMaybe "1080" $ headMay [ p | O.SocksPort p <- opts ]
  75
  76     let (mcmd,args') = if O.Help `elem` opts then (Just Help, args)
  77             else (cmdOfStr =<< headMay args, drop 1 args)
  78
  79     conf <- loadConfig ddir
  80     case mcmd of
  81         Nothing -> do
  82             isConnectArg <- case args of
  83                 [target] -> isJust <$> resolveTarget ddir target
  84                 _        -> pure False
  85             if isConnectArg
  86                 then doCmd ddir conf socksProxy [] args Connect
  87                 else die "Unknown command/name. Use 'htalkat h' for help."
  88         Just cmd -> do
  89             (lOpts,lArgs) <- O.parseLocal cmd args'
  90             let conf' = foldr applyOptToConf conf lOpts
  91             doCmd ddir conf' socksProxy lOpts lArgs cmd
  92
  93 doCmd :: FilePath -> Config -> SocksProxy -> [O.Opt] -> [String] -> Command -> IO ()
  94 doCmd ddir conf socksProxy opts args = \case
  95     Help -> case args of
  96         [] -> putStr . O.globalHelp . init $ concatMap (<>"\n")
  97             [ "Usage: htalkat [OPTION...] COMMAND [ARG...]"
  98             , ""
  99             , "Commands:"
 100             , "  htalkat i[dentity] [PUBLIC_NAME]          create/show identity"
 101             , "  htalkat c[onnect] [talkat:]FP@HOST        connect to host"
 102             , "  htalkat c[onnect] NAME                    connect to named user"
 103             , "  htalkat n[ame] [talkat:]FP[@HOST] [NAME]  set name for user [at host]"
 104             , "  htalkat l[isten]                          start server"
 105             , "  htalkat a[nswer] [NAME]                   accept connection [from user]"
 106             , "  htalkat a[nswer] --list                   list unanswered connections"
 107             , "  htalkat n[ame] +N NAME                    set name for unnamed caller"
 108             , "  htalkat h[elp] [COMMAND]                  show help [on command]"
 109             , ""
 110             , "FP is a 32 hex character public key fingerprint."
 111             , "HOST can specify a nonstandard port as \"HOSTNAME:PORT\""
 112             , ""
 113             , "Options:"
 114             ]
 115         [c] | Just cmd <- cmdOfStr c -> putStr $ cmdHelp ddir cmd
 116         _ -> pure ()
 117
 118     cmd | O.Help `elem` opts -> putStr $ cmdHelp ddir cmd
 119
 120     Identity -> createOrShowIdentity ddir $ headMay args
 121
 122     Name -> case args of
 123         target:args' | length args' <= 1 ->
 124             resolveTarget ddir target >>= \case
 125                 Nothing   -> die $ "Unknown: " <> target
 126                 Just user -> case args' of
 127                     name:_ | Just pet <- parsePetname name ->
 128                         writeName ddir user pet
 129                     name:_ -> die $ "Invalid name: " <> name
 130                     [] -> do
 131                         name <- promptLine $ "Enter name to assign to " <> showUser user <> ": "
 132                         doCmd ddir conf socksProxy [] [target,name] Name
 133         [] -> do
 134             names <- sort <$> loadNames ddir
 135             forM_ names $ \name -> do
 136                 mUser <- lookupName ddir name
 137                 putStrLn $ showPetname name <> ": " <> case mUser of
 138                     Nothing -> "[unparseable name file!]"
 139                     Just (User fp mh) -> showFingerprint fp <>
 140                         maybe "" (("@" <>) . showHost) mh
 141         _ -> die "Usage: htalkat n [talkat:]FP[@HOST[:PORT]] NAME; htalkat n NAME1 NAME2"
 142
 143     Answer | O.ListPending `elem` opts -> mapM_ putStrLn =<< listIncoming ddir
 144     Answer | Just sockPath <- headMay [ p | O.SpawnInteractive p <- opts ] ->
 145         case args of
 146             [name] -> spawnDefaultInteractiveClient ddir conf name sockPath
 147             _      -> die "Usage: htalkat a -i SOCK_PATH NAME"
 148     Answer | [target] <- args ->
 149             resolveTarget ddir target >>= \case
 150                 Nothing          -> die $ "Unknown: " <> target
 151                 Just (User fp _) -> answerLast ddir conf (Just fp)
 152     Answer -> answerLast ddir conf Nothing
 153
 154     Listen -> loadIdentity ddir IdListen >>= \case
 155         Nothing   -> die "You must first create an identity with 'htalkat i'."
 156         Just cred -> serve ddir conf cred
 157     Connect -> loadIdentity ddir IdConnect >>= \case
 158         Nothing -> die "You must first create an identity with 'htalkat i'."
 159         Just cred -> case args of
 160             [target] -> resolveTarget ddir target >>= \case
 161                 Nothing ->
 162                     die $ "Unknown: " <> target
 163                 Just (User _ Nothing) ->
 164                     die $ "No host associated with '" <> target <> "'."
 165                 Just (User fp (Just host)) ->
 166                     connect ddir conf cred name socksProxy host fp
 167                     where
 168                     name | Just pet <- parsePetname target = showPetname pet
 169                         | otherwise = showHost host
 170             _ -> die "Usage: htalkat c NAME[@HOST]; htalkat c [talkat:]FP@HOST"
 171
 172 cmdHelp :: FilePath -> Command -> String
 173 cmdHelp ddir c = O.localHelp c . unlines $ cmdHelp' c
 174     where
 175     cmdHelp' Help =
 176         [ "htalkat h[elp] [COMMAND]"
 177         , "  Show help [on command]." ]
 178     cmdHelp' Identity =
 179         [ "htalkat i[dentity] [PUBLIC_NAME]"
 180         , "  Create new identity (prompting for public name if omitted),"
 181         , "  or show existing identity."
 182         , "  If PUBLIC_NAME is given and identity exists, change public name in identity."
 183         ]
 184     cmdHelp' Name =
 185         [ "htalkat n[ame] [talkat:]FP[@HOST] [NAME]"
 186         , "  Set NAME as a synonym for the user identified by the given fingerprint."
 187         , "  The name will be shown when receiving a call from the user."
 188         , "  If a host is specified, then NAME can be used with the c[onnect] command."
 189         , "  If NAME already exists, it will be overwritten."
 190         , "  If NAME is omitted, it will be prompted for; this makes a good URI handler."
 191         , "htalkat n[ame] NAME1 NAME2:"
 192         , "  As above, but setting NAME2 to whatever NAME1 is currently set to."
 193         , "  NAME1 may be of the form +N (+1, +2 etc); these pseudonames are"
 194         , "  automatically assigned to unknown incoming callers."
 195         , "htalkat n[ame]:"
 196         , "  List known names."
 197         , ""
 198         , "Names are saved as files in " <> ddir </> "names" <> "."
 199         , "To delete, rename, or copy names, manipulate these files directly." ]
 200     cmdHelp' Connect =
 201         [ "htalkat c[onnect] NAME"
 202         , "  Connect to user at host as previously named with the n[ame] command."
 203         , "htalkat c[onnect] [talkat:]FP@HOST"
 204         , "  Call host. It is important to obtain the correct fingerprint of the person"
 205         , "  you intend to call, not just give whatever fingerprint is served by the host."
 206         , ""
 207         , "The command 'c[onnect]' can normally be omitted."
 208         , "NAME@HOST also works."
 209         ]
 210     cmdHelp' Answer =
 211         [ "htalkat a[nswer] [NAME]"
 212         , "  Answer most recent incoming call, restricting to calls from NAME if given."
 213         ]
 214     cmdHelp' Listen =
 215         [ "htalkat l[isten]"
 216         , "  Start server process which will listen for calls and announce them."
 217         , "  Other users will be able to connect to you at talkat:FP@HOST[:PORT],"
 218         , "  where FP is as given by i[dentity], HOST is your hostname or IP address,"
 219         , "  and PORT is a non-standard port if you set one."
 220         , "  See " <> ddir </> "htalkat.conf" <> " for configuration options,"
 221         , "  and " <> ddir </> "notify.sh" <> " to set up notifications." ]