diff --git a/ANSIColour.hs b/ANSIColour.hs --- a/ANSIColour.hs +++ b/ANSIColour.hs @@ -43,11 +43,18 @@ | BoldBlue | BoldMagenta | BoldCyan | BoldWhite deriving (Eq,Ord,Show,Read) -resetCode,boldCode,reverseCode,underlineCode :: MetaString a => a +resetCode, boldCode, unboldCode, reverseCode, + unreverseCode, underlineCode , ununderlineCode, resetColourCode + :: MetaString a => a resetCode = "\ESC[0m" boldCode = "\ESC[1m" underlineCode = "\ESC[4m" reverseCode = "\ESC[7m" +unboldCode = "\ESC[22m" +ununderlineCode = "\ESC[24m" +unreverseCode = "\ESC[27m" +resetColourCode = "\ESC[39m\ESC[22m" + colourCode :: MetaString a => Colour -> a colourCode c = (if isBold c then boldCode else "") <> "\ESC[3" <> fromString (colNum c) <> "m" where @@ -70,26 +77,23 @@ colNum BoldCyan = "6" colNum BoldWhite = "7" -thenReset :: IO () -> IO a -> IO a -thenReset = (`bracket_` T.putStr resetCode) - -withCode :: T.Text -> IO a -> IO a -withCode c = thenReset $ T.putStr c +withStyle :: T.Text -> T.Text -> IO a -> IO a +withStyle c r = T.putStr c `bracket_` T.putStr r withColour :: Colour -> IO a -> IO a -withColour c = withCode $ colourCode c +withColour c = withStyle (colourCode c) resetColourCode withBold, withReverse, withUnderline :: IO a -> IO a -withBold = withCode boldCode -withReverse = withCode reverseCode -withUnderline = withCode underlineCode +withBold = withStyle boldCode unboldCode +withReverse = withStyle reverseCode unreverseCode +withUnderline = withStyle underlineCode ununderlineCode -withCodeStr :: MetaString a => a -> a -> a -withCodeStr c s = c <> s <> resetCode +withStyleStr :: MetaString a => a -> a -> a -> a +withStyleStr c r s = c <> s <> r withColourStr :: MetaString a => Colour -> a -> a -withColourStr c = withCodeStr $ colourCode c +withColourStr c = withStyleStr (colourCode c) resetColourCode withBoldStr, withReverseStr, withUnderlineStr :: MetaString a => a -> a -withBoldStr = withCodeStr boldCode -withReverseStr = withCodeStr reverseCode -withUnderlineStr = withCodeStr underlineCode +withBoldStr = withStyleStr boldCode unboldCode +withReverseStr = withStyleStr reverseCode unreverseCode +withUnderlineStr = withStyleStr underlineCode ununderlineCode -- |"applyIf cond f" is shorthand for "if cond then f else id" applyIf :: Bool -> (a -> a) -> (a -> a) 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.1 +* Use canonical notBefore (00:00:00 1 Jan 1950) in client certs +* Add --prompt option, enabling usual command prompt after -e/-f +* Fix query escaping +* Fix colouring of wrapped link descriptions being lost when paging +* Fix --ghost not affecting queue loading + ## 0.1.6 * New command "query" for e.g. convenient use of search engines * Allow IRIs in user input (converted to URIs) diff --git a/ClientCert.hs b/ClientCert.hs --- a/ClientCert.hs +++ b/ClientCert.hs @@ -83,16 +83,20 @@ notAfterMax :: DateTime notAfterMax = DateTime (Date 9999 December 31) (TimeOfDay 23 59 59 0) +-- RFC5280 has no corresponding prescription for notBefore, but +-- 19500101000000Z seems the canonical choice. +notBeforeMin :: DateTime +notBeforeMin = DateTime (Date 1950 January 1) (TimeOfDay 0 0 0 0) + -- |generate 2048bit RSA key with maximum validity generateSelfSigned :: String -> IO ClientCert generateSelfSigned cn = do (pubKey, secKey) <- generate 256 65537 blinder <- generateBlinder $ public_n pubKey - currentTime <- timeConvert <$> timeCurrent let dn = DistinguishedName [(getObjectID DnCommonName, ASN1CharacterString UTF8 . TS.encodeUtf8 $ TS.pack cn)] sigAlg = SignatureALG HashSHA256 PubKeyALG_RSA to = timeConvert notAfterMax - from = currentTime + from = timeConvert notBeforeMin cert = Certificate { certVersion = 2 , certSerial = 0 diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -VERSION=0.1.6 +VERSION=0.1.6.1 GHCOPTS=-threaded -DICONV -DMAGIC -ignore-package regex-compat-tdfa diff --git a/Opts.hs b/Opts.hs --- a/Opts.hs +++ b/Opts.hs @@ -20,6 +20,7 @@ = Restricted | Interactive | Batch + | Prompt | ScriptFile FilePath | OptCommand String | DataDir FilePath @@ -37,14 +38,15 @@ [ Option ['d'] ["datadir"] (ReqArg DataDir "PATH") "data and config directory (default: ~/.diohsc)" , Option ['e'] ["command"] (ReqArg OptCommand "COMMAND") "execute command" , Option ['f'] ["file"] (ReqArg ScriptFile "PATH") "execute commands from file (\"-\" for stdin)" + , Option ['p'] ["prompt"] (NoArg Prompt) "prompt for further commands after -e/-f" , Option ['i'] ["interact"] (NoArg Interactive) "interactive mode (assumed unless -e/-f used)" , Option ['b'] ["batch"] (NoArg Batch) "non-interactive mode (assumed if -e/-f used)" , 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 ['r'] ["restricted"] (NoArg Restricted) "disallow shell and filesystem access" , 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/URI.hs b/URI.hs --- a/URI.hs +++ b/URI.hs @@ -150,8 +150,12 @@ unescapeUriString :: String -> String unescapeUriString = NU.unEscapeString +-- | unreserved / sub-delims / ":" / "@" / "/" / "?" +isUnescapedInQuery :: Char -> Bool +isUnescapedInQuery c = NU.isUnescapedInURI c && c `notElem` ("#[]"::String) + escapeQuery :: String -> String -escapeQuery = NU.escapeURIString NU.isUnescapedInURI . withEscapes +escapeQuery = NU.escapeURIString isUnescapedInQuery . withEscapes where withEscapes "" = "" withEscapes ('\\':'\\':s) = '\\':withEscapes s 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.6" +version = "0.1.6.1" diff --git a/diohsc.1.md b/diohsc.1.md --- a/diohsc.1.md +++ b/diohsc.1.md @@ -6,7 +6,7 @@ diohsc [OPTION]... [URI|PATH] # DESCRIPTION -diohcs is a gemini client with the following features: +diohsc is a gemini client with the following features: * Simple line-based command-response terminal user interface with ANSI colour. * Terse but combinatorially expressive command language. @@ -36,14 +36,18 @@ : "-e" and "-f" options will be processed in order of appearance, : after any diohscrc file, and before processing any uri/path argument. +-p, \-\-prompt +: Interactively read diohsc commands from stdin, +: after any commands given as arguments have been executed. +: This is the default unless "-e" or "-f" is used. + -i, \-\-interact -: Interactively read diohsc commands from stdin, and prompt for further input -: as appropriate. -: This is the default mode unless "-e" or "-f" is used. +: When processing commands, prompt for further input where appropriate. +: This is the default mode unless "-e" or "-f" is used and "-p" is not. -b, \-\-batch -: Do not prompt for input. -: This is the default mode if "-e" or "-f" is used. +: When processing commands, never prompt for further input. +: This is the default mode if "-e" or "-f" is used and "-p" is not. -c, \-\-colour : Use ANSI escape sequences for formatting. @@ -59,15 +63,15 @@ : still write to the filesystem, as will the "identity" command if it is used to : create a new named identity. +-r, \-\-restricted +: Disallow shell and filesystem access. This prevents all use of external +: commands, and reading or writing outside of *datadir*. + -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*. -v, \-\-version : Show version information. 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.6 +version: 0.1.6.1 license: GPL-3 license-file: COPYING maintainer: mbays@sdf.org diff --git a/diohsc.hs b/diohsc.hs --- a/diohsc.hs +++ b/diohsc.hs @@ -94,8 +94,8 @@ { cOptUserDataDir :: FilePath , cOptInteractive :: Bool , cOptAnsi :: Bool - , cOptRestrictedMode :: Bool , cOptGhost :: Bool + , cOptRestrictedMode :: Bool , cOptRequestContext :: RequestContext , cOptLogH :: Maybe Handle } @@ -223,8 +223,8 @@ argCommands (OptCommand c) = return [c] argCommands _ = return [] optCommands <- concat <$> mapM argCommands opts - let interactive = Batch `notElem` opts && (null optCommands || Interactive `elem` opts) - let repl = null optCommands + let repl = null optCommands || Prompt `elem` opts + let interactive = Batch `notElem` opts && (repl || Interactive `elem` opts) let argToUri arg = doesPathExist arg >>= \case True -> Just . ("file://" <>) . escapePathString <$> makeAbsolute arg @@ -716,18 +716,25 @@ in doPage $ markLine <$> ms handleCommand [] ("inventory",_) = do ais <- gets clientActiveIdentities - let showNumberedUri :: T.Text -> (Int,URI) -> T.Text - showNumberedUri s (n,uri) = s <> T.pack (show n) <> " " <> showUriFull ansi ais Nothing uri - showNumberedItem s (n,item) = showNumberedUri s (n, historyUri item) - showNumberedQueueItem s (n,q) = showNumberedUri s (n, queueUri q) + let showNumberedUri :: Bool -> T.Text -> (Int,URI) -> T.Text + showNumberedUri iterate s (n,uri) = s <> + (if iterate && n == 1 then " " + else if iterate && n == 2 then s + else T.pack (show n)) <> + " " <> showUriFull ansi ais Nothing uri + showIteratedItem s (n,item) = showNumberedUri True s (n, historyUri item) + showNumberedItem s (n,item) = showNumberedUri False s (n, historyUri item) + showIteratedQueueItem s (n,q) = showNumberedUri True s (n, queueUri q) showJumpBack :: [T.Text] showJumpBack = maybeToList $ ("'' " <>) . showUriFull ansi ais Nothing . historyUri <$> jumpBack doPage . intercalate [""] . filter (not . null) $ [ showJumpBack - , showNumberedQueueItem "~" <$> zip [1..] queue + , showIteratedQueueItem "~" <$> zip [1..] queue , showNumberedItem "'" <$> M.toAscList sessionMarks - , showNumberedItem "<" <$> zip [1..] (maybe [] historyAncestors curr) - , showNumberedItem ">" <$> zip [1..] (maybe [] historyDescendants curr) + , (showIteratedItem "<" <$> zip [1..] (maybe [] (initSafe . historyAncestors) curr)) + ++ (("@ " <>) . showUriFull ansi ais Nothing . historyUri <$> + maybeToList (curr >>= lastMay . historyAncestors)) + , showIteratedItem ">" <$> zip [1..] (maybe [] historyDescendants curr) ] handleCommand [] ("log",_) = let showLog (n,t) = "$" <> T.pack (show n) <> " " <> colour Yellow t