From e345671c76392443491523c88ea14826e7a057b4 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Thu, 14 Aug 2025 22:48:11 +0100 Subject: [PATCH] agent: extend xrcp certificate validity 1 hour in the past, to allow out of sync clocks (#1601) --- src/Simplex/Messaging/Transport/Credentials.hs | 8 -------- src/Simplex/RemoteControl/Client.hs | 6 +++--- 2 files changed, 3 insertions(+), 11 deletions(-) diff --git a/src/Simplex/Messaging/Transport/Credentials.hs b/src/Simplex/Messaging/Transport/Credentials.hs index 3d6155da0..f610ab943 100644 --- a/src/Simplex/Messaging/Transport/Credentials.hs +++ b/src/Simplex/Messaging/Transport/Credentials.hs @@ -25,14 +25,6 @@ import qualified Simplex.Messaging.Crypto as C import qualified Time.System as Hourglass import qualified Time.Types as HT --- | Generate a certificate chain to be used with TLS fingerprint-pinning --- --- @ --- genTlsCredentials = do --- ca <- genCredentials Nothing (-25, 365 * 24) "Root" -- long-lived root cert --- leaf <- genCredentials (Just ca) (0, 1) "Entity" -- session-signing cert --- pure $ tlsCredentials (leaf :| [ca]) --- @ tlsCredentials :: NonEmpty Credentials -> (C.KeyHash, TLS.Credential) tlsCredentials credentials = (C.KeyHash rootFP, (X509.CertificateChain certs, privateToTls $ snd leafKey)) where diff --git a/src/Simplex/RemoteControl/Client.hs b/src/Simplex/RemoteControl/Client.hs index a4b4c9038..bde72fb23 100644 --- a/src/Simplex/RemoteControl/Client.hs +++ b/src/Simplex/RemoteControl/Client.hs @@ -85,7 +85,7 @@ encInvitationSize = 900 newRCHostPairing :: TVar ChaChaDRG -> IO RCHostPairing newRCHostPairing drg = do - ((_, caKey), caCert) <- genCredentials drg Nothing (-25, 24 * 999999) "ca" + ((_, caKey), caCert) <- genCredentials drg Nothing (25, 24 * 999999) "ca" (_, idPrivKey) <- atomically $ C.generateKeyPair drg pure RCHostPairing {caKey, caCert, idPrivKey, knownHost = Nothing} @@ -193,7 +193,7 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct genTLSCredentials :: TVar ChaChaDRG -> C.APrivateSignKey -> X.SignedCertificate -> IO TLS.Credential genTLSCredentials drg caKey caCert = do let caCreds = (C.signatureKeyPair caKey, caCert) - leaf <- genCredentials drg (Just caCreds) (0, 24 * 999999) "localhost" -- session-signing cert + leaf <- genCredentials drg (Just caCreds) (1, 24 * 999999) "localhost" -- session-signing cert pure . snd $ tlsCredentials (leaf :| [caCreds]) certFingerprint :: X.SignedCertificate -> C.KeyHash @@ -259,7 +259,7 @@ connectRCCtrl drg (RCVerifiedInvitation inv@RCInvitation {ca, idkey}) pairing_ h where newCtrlPairing :: IO RCCtrlPairing newCtrlPairing = do - ((_, caKey), caCert) <- genCredentials drg Nothing (0, 24 * 999999) "ca" + ((_, caKey), caCert) <- genCredentials drg Nothing (1, 24 * 999999) "ca" (_, dhPrivKey) <- atomically $ C.generateKeyPair drg pure RCCtrlPairing {caKey, caCert, ctrlFingerprint = ca, idPubKey = idkey, dhPrivKey, prevDhPrivKey = Nothing} updateCtrlPairing :: RCCtrlPairing -> ExceptT RCErrorType IO RCCtrlPairing