diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/Command.hs b/Command.hs --- a/Command.hs +++ b/Command.hs @@ -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." ] diff --git a/CommandLine.hs b/CommandLine.hs --- a/CommandLine.hs +++ b/CommandLine.hs @@ -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 diff --git a/GeminiProtocol.hs b/GeminiProtocol.hs --- a/GeminiProtocol.hs +++ b/GeminiProtocol.hs @@ -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 diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -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 diff --git a/Marks.hs b/Marks.hs --- a/Marks.hs +++ b/Marks.hs @@ -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 diff --git a/Opts.hs b/Opts.hs --- a/Opts.hs +++ b/Opts.hs @@ -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" diff --git a/ServiceCerts.hs b/ServiceCerts.hs --- a/ServiceCerts.hs +++ b/ServiceCerts.hs @@ -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 diff --git a/TextGemini.hs b/TextGemini.hs --- a/TextGemini.hs +++ b/TextGemini.hs @@ -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)) diff --git a/URI.hs b/URI.hs --- a/URI.hs +++ b/URI.hs @@ -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 diff --git a/Version.hs b/Version.hs --- a/Version.hs +++ b/Version.hs @@ -16,4 +16,4 @@ programName = "diohsc" version :: String -version = "0.1.5" +version = "0.1.6" diff --git a/diohsc.1.md b/diohsc.1.md --- a/diohsc.1.md +++ b/diohsc.1.md @@ -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*. diff --git a/diohsc.cabal b/diohsc.cabal --- a/diohsc.cabal +++ b/diohsc.cabal @@ -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 diff --git a/diohsc.hs b/diohsc.hs --- a/diohsc.hs +++ b/diohsc.hs @@ -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 diff --git a/diohscrc.sample b/diohscrc.sample --- a/diohscrc.sample +++ b/diohscrc.sample @@ -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