-- This file is part of Diohsc -- Copyright (C) 2020 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 FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} module Main where import Control.Monad (join, unless, when) import Control.Monad.Catch (bracketOnError) import Control.Monad.State (execStateT) import Data.Hashable (hash) import Data.Maybe import Data.Semigroup (Any (..)) import qualified Data.Set as S import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.IO as T import qualified System.Console.Haskeline as HL import System.Directory import System.Environment import System.Exit import System.FilePath import System.IO import System.IO.Unsafe (unsafeInterleaveIO) import qualified BStack import ClientOptions import ClientState import GeminiProtocol import LineClient import Marks import Mundanities import Opts import PrintFancy import Prompt hiding (promptYN) import qualified Prompt import URI import Version #ifndef WINDOWS import System.Posix.Files (ownerModes, setFileMode) #endif main :: IO () main = do argv <- getArgs (opts,args) <- parseArgs argv when (Help `elem` opts) $ putStr usage >> exitSuccess when (Version `elem` opts) $ putStrLn version >> exitSuccess defUserDataDir <- getAppUserDataDirectory programName userDataDir <- canonicalizePath . fromMaybe defUserDataDir $ listToMaybe [ path | DataDir path <- opts ] let restrictedMode = Restricted `elem` opts outTerm <- hIsTerminalDevice stdout let ansi = NoAnsi `notElem` opts && (outTerm || Ansi `elem` opts) let argCommands :: Opt -> IO (Any, [String]) argCommands (ScriptFile "-") = ((Any True,) <$>) . warnIOErrAlt $ (T.unpack . T.strip <$>) . T.lines <$> T.getContents argCommands (ScriptFile f) = ((Any True,) <$>) . warnIOErrAlt $ (T.unpack <$>) <$> readFileLines f argCommands (OptCommand c) = return (Any True, [c]) argCommands _ = return (Any False, []) (Any commandsInOpts, optCommands) <- mconcat <$> mapM argCommands opts let repl = (not commandsInOpts && Batch `notElem` opts) || Prompt `elem` opts let interactive = Batch `notElem` opts && (repl || Interactive `elem` opts) let argToUri arg = doesPathExist arg >>= \case True -> Just . ("file://" <>) . escapePathString <$> makeAbsolute arg False | Just uri <- parseUriAsAbsolute . escapeIRI $ arg -> return $ Just $ show uri _ -> printErrFancy ansi ("No such URI / file: " <> arg) >> return Nothing argCommand <- join <$> mapM argToUri (listToMaybe args) let initialCommands = optCommands ++ maybeToList argCommand let ghost = Ghost `elem` opts unless ghost $ do mkdirhier userDataDir #ifndef WINDOWS setFileMode userDataDir ownerModes -- chmod 700 #endif let cmdHistoryPath = userDataDir "commandHistory" marksPath = userDataDir "marks" logPath = userDataDir "log" let displayInfo :: [String] -> IO () displayInfo = mapM_ $ printInfoFancy ansi displayWarning = mapM_ $ printErrFancy ansi promptYN = Prompt.promptYN interactive callbacks = InteractionCallbacks displayInfo displayWarning waitKey promptYN socksProxy = maybe (const NoSocksProxy) Socks5Proxy (listToMaybe [ h | SocksHost h <- opts ]) . fromMaybe "1080" $ listToMaybe [ p | SocksPort p <- opts ] requestContext <- unsafeInterleaveIO $ initRequestContext callbacks userDataDir ghost socksProxy marks <- unsafeInterleaveIO $ loadMarks marksPath let hlSettings = (HL.defaultSettings::HL.Settings ClientM) { HL.complete = HL.noCompletion , HL.historyFile = if ghost then Nothing else Just cmdHistoryPath } logLines <- reverse <$> readFileLines logPath let cLog = BStack.fromList logLines let visited = S.fromList $ hash <$> logLines let openLog :: IO (Maybe Handle) openLog = ignoreIOErrAlt $ Just <$> do h <- openFile logPath AppendMode hSetBuffering h LineBuffering return h closeLog :: Maybe Handle -> IO () closeLog = maybe (return ()) hClose (if ghost then ($ Nothing) else bracketOnError openLog closeLog) $ \logH -> let clientOptions = ClientOptions userDataDir interactive ansi ghost restrictedMode requestContext logH initState = emptyClientState {clientMarks = marks , clientLog = cLog, clientVisited = visited} in do endState <- (`execStateT` initState) . HL.runInputT hlSettings $ lineClient clientOptions initialCommands repl closeLog logH let maxlen = clientConfMaxLogLen $ clientConfig endState curlen = BStack.size $ clientLog endState when (not ghost && curlen > maxlen + maxlen `div` 10) . warnIOErr $ -- |reread file rather than just writing clientLog, in case -- another instance has also been appending to the log. truncateToEnd maxlen logPath