Update noise implementation for new protocol

This commit is contained in:
Tony Garnock-Jones 2024-04-09 11:36:22 +02:00
parent c97069375a
commit e6234b7713
1 changed files with 27 additions and 14 deletions

View File

@ -49,17 +49,21 @@
(lambda (set-peer-session! handle-message) (lambda (set-peer-session! handle-message)
(at acceptor-ref (at acceptor-ref
(assert (Resolve (Step (NoiseStepType) service-selector) (assert (Resolve (Step (NoiseStepType) service-selector)
(object #:name 'noise-initiator (object #:name 'noise-observer
[#:asserted (Resolved-accepted responder-session) [#:asserted (Resolved-accepted responder-session)
(at responder-session
(assert (Initiator
(object #:name 'noise-initiator
[#:message m
(handle-message m)]))))
(set-peer-session! responder-session) (set-peer-session! responder-session)
#:retracted #:retracted
(stop-current-facet)] (stop-current-facet)])))))))
[#:message m (handle-message m)])))))))
(define (noise-responder #:service-selector service-selector (define (noise-responder #:service-selector service-selector
#:static-keypair static-keypair #:static-keypair static-keypair
#:export initial-ref #:export initial-ref
#:initiator-session initiator-session #:observer observer
#:preshared-keys [psks #f] #:preshared-keys [psks #f]
#:pattern [pattern #f]) #:pattern [pattern #f])
(noise* #:role 'responder (noise* #:role 'responder
@ -69,11 +73,15 @@
#:preshared-keys psks #:preshared-keys psks
#:pattern pattern #:pattern pattern
(lambda (set-peer-session! handle-message) (lambda (set-peer-session! handle-message)
(set-peer-session! initiator-session) (at observer
(at initiator-session
(assert (Resolved-accepted (assert (Resolved-accepted
(object #:name (list 'noise-responder initial-ref initiator-session) (object #:name (list 'noise-responder initial-ref observer)
[#:message m (handle-message m)]))))))) [#:asserted (Initiator s)
(set-peer-session! s)
#:retracted
(stop-current-facet)]
[#:message m
(handle-message m)])))))))
(define (noise* #:role role (define (noise* #:role role
#:service-selector service-selector #:service-selector service-selector
@ -127,6 +135,7 @@
(handshake-step)))))) (handshake-step))))))
(define (set-peer-session! session) (define (set-peer-session! session)
(when peer-session (error 'noise* "Double-setting of peer-session"))
(set! peer-session session) (set! peer-session session)
(when (eq? role 'initiator) (handshake-step))) (when (eq? role 'initiator) (handshake-step)))
@ -134,12 +143,15 @@
(module+ test (module+ test
(require libsodium) (require libsodium)
(file-stream-buffer-mode (current-output-port) 'none)
(when (file-stream-buffer-mode (current-output-port))
;; ^ Only try to set it if we get a non-#f answer when we ask for it
(file-stream-buffer-mode (current-output-port) 'none))
(standard-actor-system (ds) (standard-actor-system (ds)
(spawn #:name 'test-main (define server-keys (make-crypto-box-keypair))
(define server-keys (make-crypto-box-keypair))
(spawn #:name 'test-responder
(define service-object (define service-object
(object [a (object [a
(printf "service+: ~v\n" a) (printf "service+: ~v\n" a)
@ -149,12 +161,13 @@
(stop-current-facet)])) (stop-current-facet)]))
(at ds (at ds
(during (Resolve (Step (NoiseStepType) 'test-service) $initiator-session) (during (Resolve (Step (NoiseStepType) 'test-service) $observer)
(noise-responder #:service-selector 'test-service (noise-responder #:service-selector 'test-service
#:static-keypair server-keys #:static-keypair server-keys
#:initiator-session initiator-session #:observer observer
#:export service-object))) #:export service-object))))
(spawn #:name 'test-initiator
(noise-initiator #:service-selector 'test-service (noise-initiator #:service-selector 'test-service
#:remote-static-pk (crypto-box-keypair-pk server-keys) #:remote-static-pk (crypto-box-keypair-pk server-keys)
#:acceptor-ref ds #:acceptor-ref ds