diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/ClientCert.hs b/ClientCert.hs --- a/ClientCert.hs +++ b/ClientCert.hs @@ -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 diff --git a/ClientSessionManager.hs b/ClientSessionManager.hs --- a/ClientSessionManager.hs +++ b/ClientSessionManager.hs @@ -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 . diff --git a/Command.hs b/Command.hs --- a/Command.hs +++ b/Command.hs @@ -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)," diff --git a/GeminiProtocol.hs b/GeminiProtocol.hs --- a/GeminiProtocol.hs +++ b/GeminiProtocol.hs @@ -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 diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -VERSION=0.1.15 +VERSION=0.1.16 GHCOPTS=-threaded -DICONV -DMAGIC -ignore-package regex-compat-tdfa diff --git a/RunExternal.hs b/RunExternal.hs --- a/RunExternal.hs +++ b/RunExternal.hs @@ -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 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.15" +version = "0.1.16" diff --git a/diohsc.cabal b/diohsc.cabal --- a/diohsc.cabal +++ b/diohsc.cabal @@ -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, diff --git a/diohscrc.sample b/diohscrc.sample --- a/diohscrc.sample +++ b/diohscrc.sample @@ -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