diohsc 0.1.15 → 0.1.16
raw patch · 10 files changed
+67/−58 lines, 10 filesdep ~cryptondep ~data-default-classdep ~hashable
Dependency ranges changed: crypton, data-default-class, hashable, tls
Files
- CHANGELOG.md +3/−0
- ClientCert.hs +4/−1
- ClientSessionManager.hs +8/−7
- Command.hs +3/−2
- GeminiProtocol.hs +36/−36
- Makefile +1/−1
- RunExternal.hs +2/−1
- Version.hs +1/−1
- diohsc.cabal +5/−5
- diohscrc.sample +4/−4
CHANGELOG.md view
@@ -2,6 +2,9 @@ This file covers only non-trivial user-visible changes; see the git log for full gory details. +# 0.1.16+* Fix producing client certificates with illegal empty CN. Instead, use "OU=-" as DN if CN is empty.+ # 0.1.15 * Switch tls dependency to tls-2.0; deprecated ciphers dropped * Handle 44 response with exponential backoff
ClientCert.hs view
@@ -119,7 +119,10 @@ generateSelfSigned :: KeyType -> String -> IO ClientCert generateSelfSigned tp cn =- let dn = DistinguishedName [(getObjectID DnCommonName,+ let dn | null cn = -- empty DN not allowed by RFC 5280, so use "OU=-"+ DistinguishedName [(getObjectID DnOrganizationUnit,+ ASN1CharacterString UTF8 $ TS.encodeUtf8 "-")]+ | otherwise = DistinguishedName [(getObjectID DnCommonName, ASN1CharacterString UTF8 . TS.encodeUtf8 $ TS.pack cn)] sigAlg = case tp of KeyRSA -> SignatureALG HashSHA256 PubKeyALG_RSA
ClientSessionManager.hs view
@@ -33,14 +33,15 @@ newClientSessions = newMVar Map.empty clientSessionManager :: Int -> ClientSessions -> Maybe Fingerprint -> SessionManager-clientSessionManager lifetime sess fp = SessionManager- (\_ -> return Nothing)- (\_ -> return Nothing)- insert- delete- True+clientSessionManager lifetime sess fp = noSessionManager+ { sessionResume = \_ -> return Nothing+ , sessionResumeOnlyOnce = \_ -> return Nothing+ , sessionEstablish = insert+ , sessionInvalidate = delete+ , sessionUseTicket = True+ } where- insert sid sd@SessionData{ sessionClientSNI = Just sni } = do+ insert sid sd | Just sni <- sessionClientSNI sd = do now <- timeCurrent let expire = now `timeAdd` Seconds (fromIntegral lifetime) modifyMVar_ sess $ return .
Command.hs view
@@ -422,8 +422,9 @@ , "The action is determined by the mime-type; see the run-mailcap manpage." ] "browse" -> [ "TARGET {browse}: run command given by environment variable $BROWSER on uri." , "TARGET {browse} COMMAND: run given shell command on uri."- , "%s is substituted with the uri"- , "if no %s appears, the uri is used as an additional final argument."+ , "%s is substituted with the uri, shell-escaped,"+ , "%S is substituted with the unescaped uri."+ , "if no %s/%S appears, the escaped uri is appended (separated by a space)." , "A literal '%' can be escaped as '%%'." , "" , "If an identity would be used at the target URI (if it had scheme gemini),"
GeminiProtocol.hs view
@@ -26,10 +26,6 @@ import Data.List (intercalate, intersperse, isPrefixOf, stripPrefix, transpose) import Data.Maybe (fromMaybe, isJust)-import Data.X509-import Data.X509.CertificateStore-import Data.X509.Validation hiding (Fingerprint (..),- getFingerprint) import Network.Simple.TCP (closeSock, connectSock, connectSockSOCKS5) import Network.Socket (Socket)@@ -45,6 +41,10 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC +import qualified Data.X509 as X+import qualified Data.X509.CertificateStore as X+import qualified Data.X509.Validation as X+ import qualified Codec.MIME.Parse as MIME import qualified Codec.MIME.Type as MIME import qualified Data.Map as M@@ -114,8 +114,8 @@ -- least) uses IO rather than MonadIO in the onServerCertificate callback. data RequestContext = RequestContext InteractionCallbacks- CertificateStore- (MVar (Set.Set (Fingerprint, ServiceID)))+ X.CertificateStore+ (MVar (Set.Set (Fingerprint, X.ServiceID))) (MVar (Set.Set Fingerprint)) (MVar (Set.Set Fingerprint)) (MVar (Set.Set String))@@ -132,7 +132,7 @@ unless readOnly $ do mkdirhier certPath mkdirhier serviceCertsPath- certStore <- fromMaybe (makeCertificateStore []) <$> readCertificateStore certPath+ certStore <- fromMaybe (X.makeCertificateStore []) <$> X.readCertificateStore certPath mTrusted <- newMVar Set.empty mIgnoredCertErrors <- newMVar Set.empty mWarnedCA <- newMVar Set.empty@@ -266,9 +266,9 @@ _ <- connectSockSOCKS5 sock hostname (show port) return sock - checkServerCert store cache service chain@(CertificateChain signedCerts) = do- errors <- doTofu =<< validate Data.X509.HashSHA256 defaultHooks- (defaultChecks { checkExhaustive = True , checkLeafV3 = False }) store cache service chain+ checkServerCert store cache service chain@(X.CertificateChain signedCerts) = do+ errors <- doTofu =<< X.validate X.HashSHA256 X.defaultHooks+ (X.defaultChecks { X.checkExhaustive = True , X.checkLeafV3 = False }) store cache service chain if null errors || any isTrustError errors || null signedCerts then return errors else do@@ -283,25 +283,25 @@ then modifyMVar_ mIgnoredCertErrors (return . Set.insert tailFingerprint) >> return [] else return errors where- isTrustError = (`elem` [UnknownCA, SelfSigned, NotAnAuthority])+ isTrustError = (`elem` [X.UnknownCA, X.SelfSigned, X.NotAnAuthority]) -- |error pertaining to the tail certificate, to be ignored if the -- user explicitly trusts the certificate for this service. -- These don't actually affect the TOFU-trustworthiness of a -- certificate, but we warn the user about them anyway.- isTrustableError LeafNotV3 = True- isTrustableError (NameMismatch _) = True- isTrustableError _ = False+ isTrustableError X.LeafNotV3 = True+ isTrustableError (X.NameMismatch _) = True+ isTrustableError _ = False tailSigned = head signedCerts tailFingerprint = fingerprint tailSigned - chainSigsFail :: Maybe SignatureFailure+ chainSigsFail :: Maybe X.SignatureFailure chainSigsFail = let verify (signed:signing:rest) = msum [- case verifySignedSignature signed . certPubKey $ getCertificate signing of- SignaturePass -> Nothing- SignatureFailed failure -> Just failure+ case X.verifySignedSignature signed . X.certPubKey $ X.getCertificate signing of+ X.SignaturePass -> Nothing+ X.SignatureFailed failure -> Just failure , verify (signing:rest) ] verify _ = Nothing in verify signedCerts@@ -320,19 +320,19 @@ then filter (\e -> not $ isTrustError e || isTrustableError e) errors else errors - checkTrust :: [FailedReason] -> IO Bool+ checkTrust :: [X.FailedReason] -> IO Bool checkTrust errors = do trusted <- ((tailFingerprint, service) `Set.member`) <$> readMVar mTrusted if trusted then return True else do trust <- checkTrust' errors when trust $ modifyMVar_ mTrusted (return . Set.insert (tailFingerprint, service)) return trust- checkTrust' :: [FailedReason] -> IO Bool+ checkTrust' :: [X.FailedReason] -> IO Bool checkTrust' _ | Just sigFail <- chainSigsFail = do displayWarning [ "Invalid signature in certificate chain: " ++ show sigFail ] return False checkTrust' errors = do- let certs = map getCertificate signedCerts+ let certs = map X.getCertificate signedCerts tailCert = head certs tailHex = "SHA256:" <> fingerprintHex tailFingerprint serviceString = serviceToString service@@ -365,17 +365,17 @@ ("Temporarily trust " ++ prompt) Just trustedSignedCert -> do currentTime <- timeConvert <$> timeCurrent- let trustedCert = getCertificate trustedSignedCert- expired = currentTime > (snd . certValidity) trustedCert- samePubKey = certPubKey trustedCert == certPubKey tailCert+ let trustedCert = X.getCertificate trustedSignedCert+ expired = currentTime > (snd . X.certValidity) trustedCert+ samePubKey = X.certPubKey trustedCert == X.certPubKey tailCert oldFingerprint = fingerprint trustedSignedCert oldHex = "SHA256:" <> fingerprintHex oldFingerprint oldInfo = [ "Fingerprint of old certificate: " <> oldHex ] ++ fingerprintPicture oldFingerprint ++ [ "Old certificate " ++ (if expired then "expired" else "expires") ++ ": " ++ printExpiry trustedCert ]- signedByOld = SignaturePass `elem`- ((`verifySignedSignature` certPubKey trustedCert) <$> signedCerts)+ signedByOld = X.SignaturePass `elem`+ ((`X.verifySignedSignature` X.certPubKey trustedCert) <$> signedCerts) if signedByOld then displayInfo $ ("The new certificate chain is signed by " ++@@ -406,24 +406,24 @@ saveTempServiceInfo serviceCertsPath service (tempTimes + 1, tailHex) `catch` printIOErr pure trust - printExpiry :: Certificate -> String- printExpiry = timePrint ISO8601_Date . snd . certValidity+ printExpiry :: X.Certificate -> String+ printExpiry = timePrint ISO8601_Date . snd . X.certValidity - showCN :: DistinguishedName -> String- showCN = maybe "[Unspecified CN]" (TS.unpack . TS.decodeUtf8 . getCharacterStringRawData) . getDnElement DnCommonName+ showCN :: X.DistinguishedName -> String+ showCN = maybe "[Unspecified CN]" (TS.unpack . TS.decodeUtf8 . X.getCharacterStringRawData) . X.getDnElement X.DnCommonName - showIssuerDN :: [SignedCertificate] -> String+ showIssuerDN :: [X.SignedCertificate] -> String showIssuerDN signed = case lastMay signed of Nothing -> ""- Just headSigned -> showCN . certIssuerDN $ getCertificate headSigned+ Just headSigned -> showCN . X.certIssuerDN $ X.getCertificate headSigned - showChain :: [SignedCertificate] -> [String]+ showChain :: [X.SignedCertificate] -> [String] showChain [] = [""] showChain signed = let sigChain = reverse signed- certs = getCertificate <$> sigChain- issuerCN = showCN . certIssuerDN $ head certs- subjectCNs = showCN . certSubjectDN <$> certs+ certs = X.getCertificate <$> sigChain+ issuerCN = showCN . X.certIssuerDN $ head certs+ subjectCNs = showCN . X.certSubjectDN <$> certs hexes = ("SHA256:" <>) . fingerprintHex . fingerprint <$> sigChain pics = fingerprintPicture . fingerprint <$> sigChain expStrs = ("Expires " ++) . printExpiry <$> certs
Makefile view
@@ -1,4 +1,4 @@-VERSION=0.1.15+VERSION=0.1.16 GHCOPTS=-threaded -DICONV -DMAGIC -ignore-package regex-compat-tdfa
RunExternal.hs view
@@ -52,7 +52,8 @@ subPercent "" = return [] subPercent ('%':'%':s) = ('%':) <$> subPercent s subPercent ('%':'c':s) = (':':) <$> subPercent s- subPercent ('%':'s':s) = put True >> (sub ++) <$> subPercent s+ subPercent ('%':'S':s) = put True >> (sub ++) <$> subPercent s+ subPercent ('%':'s':s) = put True >> (shellQuote sub ++) <$> subPercent s subPercent (c:s) = (c:) <$> subPercent s shellQuote s | all shellSafe s && not (null s) = s
Version.hs view
@@ -16,4 +16,4 @@ programName = "diohsc" version :: String-version = "0.1.15"+version = "0.1.16"
diohsc.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: diohsc-version: 0.1.15+version: 0.1.16 license: GPL-3 license-file: COPYING maintainer: mbays@sdf.org@@ -93,9 +93,9 @@ asn1-types >=0.3.4 && <0.4, bytestring >=0.10.4.0 && <0.13, containers >=0.5.5.1 && <0.8,- crypton >=0.26 && <0.35,- data-default-class >=0.1.2.0 && <0.2,- hashable >= 1.1 && <1.5,+ crypton >=0.26 && <1.1,+ data-default-class >=0.1.2.0 && <0.3,+ hashable >= 1.1 && <1.6, directory >=1.2.1.0 && <1.4, exceptions >=0.10.4 && <0.11, filepath >=1.3.0.2 && <1.6,@@ -116,7 +116,7 @@ temporary ==1.3.*, terminal-size >=0.3.2.1 && <0.4, text >=1.1.0.0 && <2.2,- tls >=2.0 && <2.1,+ tls >=2.0 && <2.2, transformers >=0.3.0.0 && <0.7, crypton-x509 >=1.7.5 && <1.8, crypton-x509-store >=1.6.7 && <1.7,
diohscrc.sample view
@@ -54,8 +54,8 @@ #alias Search 'search query #alias QueueNew at *- add #alias Mpv |mpv --cache-secs 5 --#alias CS br screen -X register '%s' # copy URI to GNU screen buffer-#alias CX br xsel -i <<< '%s' # copy URI to X selection buffer+#alias CS br screen -X register %s # copy URI to GNU screen buffer+#alias CX br xsel -i <<< %s # copy URI to X selection buffer #alias GPGImport |gpg --import #alias Read ||- espeak -s 300 --stdin --stdout | aplay #alias BGRead ||- espeak -s 300 --stdin --stdout | aplay &@@ -66,11 +66,11 @@ # upload an existing file (or compose one), # or as "TARGET TE [-t TOKEN]" to edit a gemini TARGET and upload the changed # version via titan.-#alias TU br titan-upload.sh %s+#alias TU br titan-upload.sh #alias TE ! $EDITOR %s && titan-upload.sh titan://${URI#gemini://} %s # Paging with gmir: # For use with https://github.com/codesoap/gmir . # Requires perl with the URI library (which you probably have). # If you select a link in gmir, it will be added to the diohsc queue.-#alias GMIR !rel="$(gmir "%s")"; [ -n "$rel" ] && echo "$(perl -e 'use URI; print URI->new_abs(shift, shift)')' "$rel" "$URI")" >> ~/.diohsc/queue+#alias GMIR !rel="$(gmir %s)"; [ -n "$rel" ] && echo "$(perl -e 'use URI; print URI->new_abs(shift, shift)')' "$rel" "$URI")" >> ~/.diohsc/queue