diohsc 0.1.6 → 0.1.6.1

raw patch · 10 files changed

+75/−43 lines, 10 files

Files

• ANSIColour.hs +20/−16
• CHANGELOG.md +7/−0
• ClientCert.hs +6/−2
• Makefile +1/−1
• Opts.hs +3/−1
• URI.hs +5/−1
• Version.hs +1/−1
• diohsc.1.md +14/−10
• diohsc.cabal +1/−1
• diohsc.hs +17/−10

@@ -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)

@@ -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)

@@ -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

@@ -1,4 +1,4 @@-VERSION=0.1.6+VERSION=0.1.6.1  GHCOPTS=-threaded -DICONV -DMAGIC -ignore-package regex-compat-tdfa 

@@ -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"     ]

@@ -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

@@ -16,4 +16,4 @@ programName = "diohsc"  version :: String-version = "0.1.6"+version = "0.1.6.1"

@@ -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.

@@ -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

@@ -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