diohsc 0.1.5 → 0.1.6
raw patch · 15 files changed
+173/−71 lines, 15 files
Files
- CHANGELOG.md +7/−0
- Command.hs +12/−7
- CommandLine.hs +3/−3
- GeminiProtocol.hs +29/−9
- Makefile +2/−2
- Marks.hs +2/−2
- Opts.hs +4/−0
- ServiceCerts.hs +4/−1
- TextGemini.hs +45/−35
- URI.hs +31/−0
- Version.hs +1/−1
- diohsc.1.md +6/−0
- diohsc.cabal +11/−1
- diohsc.hs +14/−9
- diohscrc.sample +2/−1
CHANGELOG.md view
@@ -2,6 +2,13 @@ This file covers only non-trivial user-visible changes; see the git log for full gory details. +## 0.1.6+* New command "query" for e.g. convenient use of search engines+* Allow IRIs in user input (converted to URIs)+* Implement SOCKS5 support (-S and -P options)+* Fix bug triggered by /home being a symlink+* Fix bug with connecting to literal IPv6 addresses+ ## 0.1.5 * Align and wrap link lines; add option to print description first * Use reverse video in prompt for added visibility (thanks Ben)
Command.hs view
@@ -42,7 +42,7 @@ safeActionCommands = ["cat"] actionCommands True = safeActionCommands actionCommands False = unsafeActionCommands ++ safeActionCommands- otherCommands = ["commands", "log", "repl", "alias", "set", "at"]+ otherCommands = ["commands", "log", "query", "repl", "alias", "set", "at"] normaliseCommand :: String -> Maybe String normaliseCommand partial =@@ -63,7 +63,7 @@ , " } : Next unvisited link" , " <} : Next unvisited link of parent" , ""- , "See \"help targets\" for more."+ , "See \"{help} {targets}\" for more." , "" , withBoldStr "Commands" , "--------"@@ -96,9 +96,9 @@ , " 3 {|} mpv - : Request link 3 and pipe the stream to command 'mpv -'" , " << {save} blah : Save data from history item before last" , " 2 {browse} lynx : Run \"lynx [uri-of-link-2]\""- , " / {mark} root : Mark the root of the current site as 'root"- , " / {identify} asdf : Use identity \"asdf\" for all of current site"- , "Use \"help targets\" to get full details on this notation."+ , " / {mark} root : Mark the root of the current capsule as 'root"+ , " / {identify} asdf : Use identity \"asdf\" for all of current capsule"+ , "Use \"{help} {targets}\" to get full details on this notation." , "" , "Spaces around the command can often be omitted, e.g.:" , " 2a0 : Add link 2 to start of queue"@@ -153,7 +153,7 @@ , " .. , ./foo , ../foo , /foo , ?foo : URI relative to current location" , " 'example , 'ex , 'e : location marked with \"mark example\"" , " '' : location last jumped away from"- , " ~ , {-next} : next queue item"+ , " ~ : next queue item" , " $5 : log item" , " If no base target is given, the current location is used as the base." , ""@@ -201,7 +201,7 @@ , " \"}\", \"{\", and \"*\" work like \"]\", \"[\", and \"_\"," , " but consider only unvisited links. Example: \"*-a\" adds all unvisited links." , ""- , "See also: {mark}, {queue}, {alias}"+ , "See also: {mark}, {queue}, {alias}, {query}" ] "queue" -> [ "The queue is a list of uris, which you can add to with \"add\""@@ -422,6 +422,11 @@ , "in order of priority when expanding abbreviations," , "and show the shortest permissible abbreviations." , "See also: {alias}"]+ "query" -> [ "TARGET {query} QUERY: request target with query set to QUERY."+ , "Unlike TARGET?QUERY, this command does not require spaces to be escaped,"+ , "and it can be aliased; e.g. if 'search is a mark set to a search engine:"+ , " alias S 'search query"+ , " S ascii art cat" ] "repl" -> [ "TARGET {repl}: enter read-eval-print-loop," , "in which each line of input is used as a query string at the target." , "To return to normal command mode, enter an empty query or ^C or ^D." ]
CommandLine.hs view
@@ -57,9 +57,9 @@ resolveElemsSpec (EsSRange mes1 mes2) = do mns1 <- mapM resolveES mes1 mns2 <- mapM resolveES mes2- return $ case liftM2 (>) mns1 mns2 of- Just True -> reverse . maybe id drop mns2 $ maybe id (take . (+ 1)) mns1 as- _ -> maybe id drop mns1 $ maybe id (take . (+ 1)) mns2 as+ return $ if Just True == liftM2 (>) mns1 mns2 || mns2 == Just (-1)+ then reverse . maybe id drop mns2 $ maybe id (take . (+ 1)) mns1 as+ else maybe id drop mns1 $ maybe id (take . (+ 1)) mns2 as resolveElemsSpec (EsSSearch s) = return $ filter (s `match`) as resolveES :: ElemSpec -> Either String Int
GeminiProtocol.hs view
@@ -28,10 +28,12 @@ import Data.X509.CertificateStore import Data.X509.Validation hiding (Fingerprint (..), getFingerprint)-import Network.Simple.TCP (closeSock, connectSock)+import Network.Simple.TCP (closeSock, connectSock,+ connectSockSOCKS5) import Network.Socket (Socket) import Network.TLS as TLS import Network.TLS.Extra.Cipher+import Network.URI (isIPv4address, isIPv6address) import Safe import System.FilePath import Time.System@@ -97,6 +99,10 @@ -> IO Bool } +data SocksProxy+ = NoSocksProxy+ | Socks5Proxy String String+ -- Note: we're forced to resort to mvars because the tls library (tls-1.5.4 at -- least) uses IO rather than MonadIO in the onServerCertificate callback. data RequestContext = RequestContext@@ -107,10 +113,11 @@ (MVar (Set.Set String)) FilePath Bool+ SocksProxy ClientSessions -initRequestContext :: InteractionCallbacks -> FilePath -> Bool -> IO RequestContext-initRequestContext callbacks path readOnly =+initRequestContext :: InteractionCallbacks -> FilePath -> Bool -> SocksProxy -> IO RequestContext+initRequestContext callbacks path readOnly socksProxy = let certPath = path </> "trusted_certs" serviceCertsPath = path </> "known_hosts" in do@@ -121,7 +128,7 @@ mTrusted <- newMVar Set.empty mIgnoredCertErrors <- newMVar Set.empty mIgnoredCCertWarnings <- newMVar Set.empty- RequestContext callbacks certStore mTrusted mIgnoredCertErrors mIgnoredCCertWarnings serviceCertsPath readOnly <$> newClientSessions+ RequestContext callbacks certStore mTrusted mIgnoredCertErrors mIgnoredCCertWarnings serviceCertsPath readOnly socksProxy <$> newClientSessions requestOfProxiesAndUri :: M.Map String Host -> URI -> Maybe Request requestOfProxiesAndUri proxies uri =@@ -139,10 +146,14 @@ -- on gemini. On the basis that this naming convention should -- indicate that the scheme is backwards-compatible with -- actual gemini, we handle them the same as gemini.- hostname <- uriRegName uri+ hostname <- decodeIPv6 <$> uriRegName uri let port = fromMaybe defaultGeminiPort $ uriPort uri return $ Host hostname port return . NetworkRequest host $ uri+ where+ decodeIPv6 :: String -> String+ decodeIPv6 ('[':rest) | last rest == ']', addr <- init rest, isIPv6address addr = addr+ decodeIPv6 h = h newtype RequestException = ExcessivelyLongUri Int@@ -159,7 +170,7 @@ -> Bool -- ^whether to display extra information about connection -> Request -> IO (Either SomeException (Response, IO ())) makeRequest (RequestContext (InteractionCallbacks displayInfo displayWarning _ promptYN)- certStore mTrusted mIgnoredCertErrors mIgnoredCCertWarnings serviceCertsPath readOnly clientSessions) mIdent bound verboseConnection (NetworkRequest (Host hostname port) uri) =+ certStore mTrusted mIgnoredCertErrors mIgnoredCCertWarnings serviceCertsPath readOnly socksProxy clientSessions) mIdent bound verboseConnection (NetworkRequest (Host hostname port) uri) = let requestBytes = TS.encodeUtf8 . TS.pack $ show uri ++ "\r\n" uriLength = BS.length requestBytes - 2 ccfp = clientCertFingerprint . identityCert <$> mIdent@@ -170,6 +181,8 @@ sessionManager = clientSessionManager 3600 clientSessions ccfp params = (TLS.defaultParamsClient hostname serverId) { clientSupported = def { supportedCiphers = gemini_ciphersuite }+ -- |RFC6066 disallows SNI with literal IP addresses+ , clientUseServerNameIndication = not $ isIPv4address hostname || isIPv6address hostname , clientHooks = def { onServerCertificate = checkServerCert , onCertificateRequest = \(_,pairs,_) -> case mIdent of@@ -227,7 +240,12 @@ handleAll = return . Left openSocket :: IO Socket- openSocket = fst <$> connectSock hostname (show port)+ openSocket = case socksProxy of+ NoSocksProxy -> fst <$> connectSock hostname (show port)+ Socks5Proxy socksHostname socksPort -> do+ sock <- fst <$> connectSock socksHostname socksPort+ _ <- connectSockSOCKS5 sock hostname (show port)+ return sock checkServerCert store cache service chain@(CertificateChain signedCerts) = do errors <- doTofu =<< validate Data.X509.HashSHA256 defaultHooks@@ -339,9 +357,11 @@ warnErrors promptTrust (signedByOld || expired || samePubKey) ("Permanently trust new certificate" <>- (if readOnly then "" else " (and delete old certificate)") <> "?")+ (if readOnly then ""+ else " (replacing old certificate (which will be backed up))") <> "?") ("Temporarily trust new certificate" <>- (if readOnly then "" else " (but keep old certificate)") <> "?")+ (if readOnly then ""+ else " (but keep old certificate)") <> "?") when (saveCert && not readOnly) $ saveServiceCert serviceCertsPath service tailSigned `catch` printIOErr return trust
Makefile view
@@ -1,4 +1,4 @@-VERSION=0.1.5+VERSION=0.1.6 GHCOPTS=-threaded -DICONV -DMAGIC -ignore-package regex-compat-tdfa @@ -24,7 +24,7 @@ clean: rm diohsc *.hi *.o -dioshc.1: dioshc.1.md+diohsc.1: diohsc.1.md pandoc --standalone -f markdown -t man < diohsc.1.md >| diohsc.1 dist-newstyle/sdist/diohsc-${VERSION}.tar.gz: *.hs README.md CHANGELOG.md COPYING *.cabal *.sample diohsc.1
Marks.hs view
@@ -44,9 +44,9 @@ let (u,i) = TS.breakOn "[" s' idName = TS.drop 1 i guard . not $ TS.null idName- uri <- parseUriAsAbsolute $ TS.unpack u+ uri <- parseUriAsAbsolute . escapeIRI $ TS.unpack u return . URIWithIdName uri . Just $ TS.unpack idName- , (`URIWithIdName` Nothing) <$> parseUriAsAbsolute (TS.unpack s) ]+ , (`URIWithIdName` Nothing) <$> (parseUriAsAbsolute . escapeIRI $ TS.unpack s) ] type Marks = Map.Map String URIWithIdName
Opts.hs view
@@ -23,6 +23,8 @@ | ScriptFile FilePath | OptCommand String | DataDir FilePath+ | SocksHost String+ | SocksPort String | Ghost | Ansi | NoAnsi@@ -40,6 +42,8 @@ , Option ['c'] ["colour"] (NoArg Ansi) "use ANSI colour (assumed if stdout is term)" , Option ['C'] ["no-colour"] (NoArg NoAnsi) "do not use ANSI colour" , Option ['g'] ["ghost"] (NoArg Ghost) "write nothing to filesystem (unless commanded)"+ , Option ['S'] ["socks-host"] (ReqArg SocksHost "HOST") "use SOCKS5 proxy"+ , Option ['P'] ["socks-port"] (ReqArg SocksPort "PORT") "port for SOCKS5 proxy (default 1080)" , Option ['r'] ["restricted"] (NoArg Restricted) "disallow shell and filesystem access" , Option ['v'] ["version"] (NoArg Version) "show version information" , Option ['h'] ["help"] (NoArg Help) "show usage information"
ServiceCerts.hs view
@@ -16,6 +16,7 @@ import Data.PEM import Data.X509 import Data.X509.Validation+import System.Directory (doesFileExist, renamePath) import System.FilePath import qualified Data.ByteString as BS@@ -47,5 +48,7 @@ saveServiceCert :: FilePath -> ServiceID -> SignedCertificate -> IO () saveServiceCert path service cert = let filepath = path </> serviceToString service- in isSubPath path filepath >>? BS.writeFile filepath .+ in isSubPath path filepath >>? do+ doesFileExist filepath >>? renamePath filepath (filepath ++ ".bk")+ BS.writeFile filepath . pemWriteBS . PEM "CERTIFICATE" [] . encodeSignedObject $ cert
TextGemini.hs view
@@ -8,13 +8,14 @@ -- 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 OverloadedStrings #-} {-# LANGUAGE Safe #-} module TextGemini where import Control.Monad.State-import Data.Maybe (catMaybes, mapMaybe)+import Data.Maybe (catMaybes, isJust, mapMaybe) import ANSIColour @@ -29,7 +30,7 @@ | LinkLine { linkLineIndex :: Int, linkLineLink :: Link } | AltTextLine T.Text | PreformatToggleLine- | PreformattedLine T.Text+ | PreformattedLine T.Text T.Text | HeadingLine Int T.Text | ItemLine T.Text | QuoteLine T.Text@@ -69,14 +70,13 @@ where printLine (TextLine line) = wrap width line printLine (AltTextLine line)- | preOpt == PreOptPre = []- | preOpt == PreOptBoth && T.null line = []+ | preOpt == PreOptPre || T.null line = [] | otherwise = (:[]) $ applyIf ansi withBoldStr "`` " <> line printLine PreformatToggleLine = [] - printLine (PreformattedLine line)- | preOpt == PreOptAlt = []+ printLine (PreformattedLine alt line)+ | preOpt == PreOptAlt && not (T.null alt) = [] | otherwise = (:[]) $ applyIf ansi ((resetCode <>) . withBoldStr) "` " <> line printLine (HeadingLine level line) = (:[]) $ if ansi then applyIf (level /= 2) withUnderlineStr .@@ -114,10 +114,10 @@ else wrap' l' n' ws -data GeminiParseState = GeminiParseState { numLinks :: Int, preformatted :: Bool }+data GeminiParseState = GeminiParseState { numLinks :: Int, preformatted :: Maybe T.Text } initialParseState :: GeminiParseState-initialParseState = GeminiParseState 0 False+initialParseState = GeminiParseState 0 Nothing parseGemini :: T.Text -> GeminiDocument parseGemini text = GeminiDocument . catMaybes $ evalState@@ -127,38 +127,48 @@ parseLine :: T.Text -> State GeminiParseState (Maybe GeminiLine) parseLine line = do pre <- gets preformatted- if T.take 3 line == "```" then do- modify $ \s -> s { preformatted = not pre }- return $ if pre then case T.strip $ T.drop 3 line of- "" -> Nothing- _ -> Just . ErrorLine $ "Illegal non-empty text after closing '```'"- -- ^The spec says we MUST ignore any text on a "```" line closing a preformatted- -- block. This seems like a gaping extensibility hole to me, so I'm interpreting it- -- as not disallowing an error message.- else Just . AltTextLine . T.strip $ T.drop 3 line- else if pre then return . Just $ PreformattedLine line- else if T.take 2 line == "=>" then- case parseLink . T.dropWhile isGemWhitespace $ T.drop 2 line of- Nothing -> return . Just . ErrorLine $ "Unparseable link line: " <> line- Just link -> do- n <- gets numLinks- modify $ \s -> s { numLinks = n + 1 }- return . Just $ LinkLine n link- else let headers = T.length . T.takeWhile (== '#') $ line- in if headers > 0 && headers < 4- then return . Just . HeadingLine (fromIntegral headers) .- T.dropWhile isGemWhitespace . T.dropWhile (== '#') $ line- else if T.take 2 line == "* "- then return . Just . ItemLine $ T.drop 2 line- else if T.take 1 line == ">"- then return . Just . QuoteLine $ T.drop 1 line- else return . Just $ TextLine line+ case T.take 1 line of+ "`" | T.take 3 line == "```", isJust pre -> do+ modify $ \s -> s { preformatted = Nothing }+ return $ case T.strip $ T.drop 3 line of+ "" -> Nothing+ _ -> Just . ErrorLine $ "Illegal non-empty text after closing '```'"+ -- ^The spec says we MUST ignore any text on a "```" line closing a preformatted+ -- block. This seems like a gaping extensibility hole to me, so I'm interpreting it+ -- as not disallowing an error message.+ "`" | T.take 3 line == "```" ->+ let alt = T.strip $ T.drop 3 line in do+ modify $ \s -> s { preformatted = Just alt }+ return . Just . AltTextLine $ alt+ _ | Just alt <- pre ->+ return . Just $ PreformattedLine alt line+ "=" | T.take 2 line == "=>" ->+ case parseLink . T.dropWhile isGemWhitespace $ T.drop 2 line of+ Nothing -> return . Just . ErrorLine $ "Unparseable link line: " <> line+ Just link -> do+ n <- gets numLinks+ modify $ \s -> s { numLinks = n + 1 }+ return . Just $ LinkLine n link+ "#" | headers <- T.length . T.takeWhile (== '#') $ line,+ headers > 0 && headers < 4 ->+ return . Just . HeadingLine (fromIntegral headers) .+ T.dropWhile isGemWhitespace . T.dropWhile (== '#') $ line+ "*" | T.take 2 line == "* " ->+ return . Just . ItemLine $ T.drop 2 line+ ">" ->+ return . Just . QuoteLine $ T.drop 1 line+ _ ->+ return . Just $ TextLine line parseLink :: T.Text -> Maybe Link parseLink linkInfo = let uriText = T.takeWhile (not . isGemWhitespace) linkInfo desc = T.dropWhile isGemWhitespace . T.dropWhile (not . isGemWhitespace) $ linkInfo- in (`Link` desc) <$> parseUriReference (T.unpack uriText)+ in (`Link` desc) <$> parseUriReference (+#ifdef IRILinks+ escapeIRI $+#endif+ T.unpack uriText) isGemWhitespace :: Char -> Bool isGemWhitespace = (`elem` (" \t"::String))
URI.hs view
@@ -14,6 +14,7 @@ module URI ( URI , URIRef+ , escapeIRI , escapePathString , escapeQuery , escapeQueryPart@@ -166,3 +167,33 @@ escapeQueryPart s | (s','?':q) <- break (== '?') s = s' ++ '?' : escapeQuery q | otherwise = s++-- |conversion of IRI to URI according to Step 2 in Section 3.1 in RFC3987+-- (for now at least, we apply this also to the regname rather than+-- punycoding)+escapeIRI :: String -> String+escapeIRI = NU.escapeURIString (not . escape)+ where+ -- |ucschar or iprivate in RFC3987+ escape :: Char -> Bool+ escape c = let i = fromEnum c in+ i >= 0xA0 && i <= 0xD7FF ||+ i >= 0xE000 && i <= 0xF8FF ||+ i >= 0xF900 && i <= 0xFDCF ||+ i >= 0xFDF0 && i <= 0xFFEF ||+ i >= 0x10000 && i <= 0x1FFFD ||+ i >= 0x20000 && i <= 0x2FFFD ||+ i >= 0x30000 && i <= 0x3FFFD ||+ i >= 0x40000 && i <= 0x4FFFD ||+ i >= 0x50000 && i <= 0x5FFFD ||+ i >= 0x60000 && i <= 0x6FFFD ||+ i >= 0x70000 && i <= 0x7FFFD ||+ i >= 0x80000 && i <= 0x8FFFD ||+ i >= 0x90000 && i <= 0x9FFFD ||+ i >= 0xA0000 && i <= 0xAFFFD ||+ i >= 0xB0000 && i <= 0xBFFFD ||+ i >= 0xC0000 && i <= 0xCFFFD ||+ i >= 0xD0000 && i <= 0xDFFFD ||+ i >= 0xE1000 && i <= 0xEFFFD ||+ i >= 0xF0000 && i <= 0xFFFFD ||+ i >= 0x100000 && i <= 0x10FFFD
Version.hs view
@@ -16,4 +16,4 @@ programName = "diohsc" version :: String-version = "0.1.5"+version = "0.1.6"
diohsc.1.md view
@@ -59,6 +59,12 @@ : still write to the filesystem, as will the "identity" command if it is used to : create a new named identity. +-S, \-\-socks-host *HOST*+: Use SOCKS5 proxy for all connections (including DNS resolution).++-P, \-\-socks-port *PORT*+: Port to use for SOCKS5 proxy. Default: 1080.+ -r, \-\-restricted : Disallow shell and filesystem access. This prevents all use of external : commands, and reading or writing outside of *datadir*.
diohsc.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: diohsc-version: 0.1.5+version: 0.1.6 license: GPL-3 license-file: COPYING maintainer: mbays@sdf.org@@ -37,6 +37,13 @@ default: False manual: True +flag irilinks+ description:+ Allow IRIs in gemtext links (preparing for likely spec change).+ Punycoding is not currently supported.+ default: False+ manual: True+ executable diohsc main-is: diohsc.hs other-modules:@@ -111,6 +118,9 @@ if flag(magic) cpp-options: -DMAGIC build-depends: magic <1.2++ if flag(irilinks)+ cpp-options: -DIRILinks if (!os(windows) || flag(libiconv)) cpp-options: -DICONV
diohsc.hs view
@@ -211,7 +211,7 @@ when (Version `elem` opts) $ putStrLn version >> exitSuccess defUserDataDir <- getAppUserDataDirectory programName- userDataDir <- makeAbsolute . fromMaybe defUserDataDir $ listToMaybe [ path | DataDir path <- opts ]+ userDataDir <- canonicalizePath . fromMaybe defUserDataDir $ listToMaybe [ path | DataDir path <- opts ] let restrictedMode = Restricted `elem` opts outTerm <- hIsTerminalDevice stdout@@ -228,7 +228,7 @@ let argToUri arg = doesPathExist arg >>= \case True -> Just . ("file://" <>) . escapePathString <$> makeAbsolute arg- False | Just uri <- parseUriAsAbsolute arg -> return $ Just $ show uri+ False | Just uri <- parseUriAsAbsolute . escapeIRI $ arg -> return $ Just $ show uri _ -> printErrOpt ansi ("No such URI / file: " <> arg) >> return Nothing argCommand <- join <$> mapM argToUri (listToMaybe args) @@ -251,8 +251,11 @@ displayWarning = mapM_ $ printErrOpt 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 <- initRequestContext callbacks userDataDir ghost+ requestContext <- initRequestContext callbacks userDataDir ghost socksProxy (warnings, marks) <- loadMarks marksPath displayWarning warnings let hlSettings = (HL.defaultSettings::HL.Settings ClientM)@@ -330,7 +333,7 @@ True -> catMaybes . (queueLine <$>) <$> readFileLines queueFile <* removeFile queueFile where queueLine :: T.Text -> Maybe QueueItem- queueLine s = QueueItem Nothing <$> parseUriAsAbsolute (T.unpack s)+ queueLine s = QueueItem Nothing <$> (parseUriAsAbsolute . escapeIRI $ T.unpack s) False -> return [] appendQueueToFile :: ClientM ()@@ -517,7 +520,7 @@ , clientVisited = S.insert (hash $ show uri) $ clientVisited s } unless ghost . liftIO $ maybe (return ()) (ignoreIOErr . (`T.hPutStrLn` t)) logH - loggedUris = catMaybes $ (parseAbsoluteUri . T.unpack <$>) $ BStack.toList cLog+ loggedUris = catMaybes $ (parseAbsoluteUri . escapeIRI . T.unpack <$>) $ BStack.toList cLog expand :: String -> String expand = expandHelp ansi (fst <$> aliases) userDataDir@@ -642,7 +645,7 @@ let makeRel r | base == PTargetCurr = r makeRel r@('/':_) = '.':r makeRel r = r- in case parseUriReference . escapeQueryPart $ makeRel s of+ in case parseUriReference . escapeIRI . escapeQueryPart $ makeRel s of Nothing -> Left $ "Failed to parse relative URI: " <> s Just ref -> map relTarget <$> resolveTarget base where@@ -650,7 +653,7 @@ ref `relativeTo` historyUri item relTarget t = TargetUri . relativeTo ref $ targetUri t - resolveTarget (PTargetAbs s) = case parseUriAsAbsolute $ escapeQueryPart s of+ resolveTarget (PTargetAbs s) = case parseUriAsAbsolute . escapeIRI $ escapeQueryPart s of Nothing -> Left $ "Failed to parse URI: " <> s Just uri -> return [TargetUri uri] @@ -857,8 +860,8 @@ handleUriCommand uri ("identify", args) = case requestOfUri uri of Nothing -> printErr "Bad URI" Just req -> gets ((`findIdentityRoot` req) . clientActiveIdentities) >>= \case- Just (root,(ident,_)) -> endIdentityPrompted root ident- Nothing -> void . runMaybeT $ do+ Just (root,(ident,_)) | null args -> endIdentityPrompted root ident+ _ -> void . runMaybeT $ do ident <- MaybeT . liftIO $ case args of (CommandArg idName _ : _) -> getIdentity interactive ansi idsPath idName [] -> if interactive@@ -878,6 +881,8 @@ (CommandArg _ c : _) -> return $ subPercentOrAppend (show uri) c lift $ confirm (confirmShell "Run" cmd) >>? doRestricted $ void (runShellCmd cmd []) handleUriCommand uri ("repl",_) = repl Nothing uri+ handleUriCommand uri ("query", CommandArg _ str : _) =+ goUri True Nothing . setQuery ('?':escapeQuery str) $ uri handleUriCommand uri ("log",_) = addToLog uri handleUriCommand _ (c,_) = printErr $ "Bad arguments to command " <> c
diohscrc.sample view
@@ -46,10 +46,11 @@ ## Aliases # You can set aliases as shorthands for commands. e.g.: #alias up ..+#alias Search 'search query+#alias QueueNew at *- add #alias Mpv |mpv --cache-secs 5 - #alias Read ||- espeak -s 300 --stdin --stdout | aplay #alias BGRead ||- espeak -s 300 --stdin --stdout | aplay &-#alias QueueNew at *- add ## Identification # You may want to configure certain cryptographic identities to always be used