forked from syndicate-lang/marketplace-ssh-2014
Split out authentication
This commit is contained in:
parent
32595e718f
commit
2fc82642ea
|
|
@ -40,11 +40,6 @@
|
|||
(define test-user-private (load-private-key "test-user-key"))
|
||||
(define test-user-public (load-public-key "test-user-key.pub"))
|
||||
|
||||
(define (user-public-key-accepted? user-name public-key)
|
||||
(match* (user-name public-key)
|
||||
[(#"tonyg" (== (public-key->pieces test-user-public))) #t]
|
||||
[(_ _) #f]))
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
(define (session ground-ds source sink host-private-key)
|
||||
|
|
@ -73,12 +68,44 @@
|
|||
local-identification
|
||||
remote-identification
|
||||
'server
|
||||
host-private-key
|
||||
user-public-key-accepted?))]
|
||||
host-private-key))]
|
||||
[else
|
||||
(log-error "Invalid peer identification string ~v" remote-identification)
|
||||
(stop-actor-system)])])
|
||||
|
||||
(assert (SshAuthenticationMethodAcceptable (SshAuthMethod-none)))
|
||||
(during (Observe (:pattern (SshAuthenticationAcceptable
|
||||
(SshAuthMethod-none)
|
||||
(SshAuthRequest-none ,(DLit $username))
|
||||
,_))
|
||||
_)
|
||||
(assert (SshAuthenticationAcceptable (SshAuthMethod-none)
|
||||
(SshAuthRequest-none username)
|
||||
(equal? username "guest"))))
|
||||
|
||||
(assert (SshAuthenticationMethodAcceptable (SshAuthMethod-password)))
|
||||
(during (Observe (:pattern (SshAuthenticationAcceptable
|
||||
(SshAuthMethod-password)
|
||||
(SshAuthRequest-password ,(DLit $username) ,(DLit $password))
|
||||
,_))
|
||||
_)
|
||||
(assert (SshAuthenticationAcceptable (SshAuthMethod-password)
|
||||
(SshAuthRequest-password username password)
|
||||
(and (equal? username "user")
|
||||
(equal? password "password")))))
|
||||
|
||||
(assert (SshAuthenticationMethodAcceptable (SshAuthMethod-publickey)))
|
||||
(during (Observe (:pattern (SshAuthenticationAcceptable
|
||||
(SshAuthMethod-publickey)
|
||||
(SshAuthRequest-publickey ,(DLit $username) ,(DLit $key))
|
||||
,_))
|
||||
_)
|
||||
(assert (SshAuthenticationAcceptable
|
||||
(SshAuthMethod-publickey)
|
||||
(SshAuthRequest-publickey username key)
|
||||
(and (equal? username "tonyg")
|
||||
(equal? key (public-key->pieces test-user-public))))))
|
||||
|
||||
(during (SshAuthenticatedUser $user-name #"ssh-connection")
|
||||
(run-repl-instance conn-ds user-name))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,26 @@
|
|||
version 1 .
|
||||
embeddedType EntityRef.Ref .
|
||||
|
||||
SshAuthenticatedUser = <authenticated @username bytes @service bytes>.
|
||||
SshAuthenticatedUser = <authenticated @username string @service bytes>.
|
||||
|
||||
SshAuthMethod =
|
||||
/ @none #"none"
|
||||
/ @publickey #"publickey"
|
||||
/ @password #"password"
|
||||
.
|
||||
|
||||
SshAuthRequest =
|
||||
/ <none @username string>
|
||||
/ <publickey @username string @key PublicKey>
|
||||
/ <password @username string @password string>
|
||||
.
|
||||
|
||||
SshAuthenticationMethodAcceptable = <authentication-method-acceptable @method SshAuthMethod>.
|
||||
|
||||
SshAuthenticationAcceptable =
|
||||
<authentication-acceptable? @method SshAuthMethod @request SshAuthRequest @ok bool>.
|
||||
|
||||
PublicKey = Ed25519PublicKey .
|
||||
|
||||
Ed25519PublicKey = <ed25519-public-key @q bytes>.
|
||||
Ed25519PrivateKey = <ed25519-private-key @q bytes @d bytes>.
|
||||
|
|
|
|||
|
|
@ -29,8 +29,8 @@
|
|||
|
||||
(module+ test (require rackunit))
|
||||
|
||||
(struct ed25519-private-key (q d) #:transparent)
|
||||
(struct ed25519-public-key (q) #:transparent)
|
||||
(struct ed25519-private-key (q d) #:prefab)
|
||||
(struct ed25519-public-key (q) #:prefab)
|
||||
|
||||
(define (bytes->private-key-pieces bs)
|
||||
(match (bytes->ssh-private-key bs)
|
||||
|
|
@ -53,8 +53,8 @@
|
|||
(datum->pk-key (list 'eddsa 'public 'ed25519 q) 'rkt-public)]))
|
||||
|
||||
(define (make-key-signature private-key key-alg exchange-hash)
|
||||
(case key-alg
|
||||
[(ssh-ed25519)
|
||||
(match key-alg
|
||||
[#"ssh-ed25519"
|
||||
(define signature (pk-sign private-key exchange-hash))
|
||||
(bit-string (#"ssh-ed25519" :: (t:string))
|
||||
(signature :: (t:string)))]))
|
||||
|
|
@ -62,8 +62,8 @@
|
|||
(define (verify-key-signature! public-key key-alg exchange-hash h-signature)
|
||||
;; TODO: If we are *re*keying, worth checking here that the key hasn't *changed* either.
|
||||
(write `(TODO check-key!)) (newline) (flush-output) ;; actually check the identity TOFU/POP
|
||||
(case key-alg
|
||||
[(ssh-ed25519)
|
||||
(match key-alg
|
||||
[#"ssh-ed25519"
|
||||
(define signature (bit-string-case h-signature
|
||||
([ (= #"ssh-ed25519" :: (t:string #:pack))
|
||||
(sig :: (t:string #:pack)) ]
|
||||
|
|
@ -77,12 +77,14 @@
|
|||
(bit-string (#"ssh-ed25519" :: (t:string))
|
||||
(q :: (t:string)))]))
|
||||
|
||||
(define (ssh-key->pieces blob)
|
||||
(bit-string-case blob
|
||||
([ (= #"ssh-ed25519" :: (t:string #:pack))
|
||||
(q :: (t:string #:pack)) ]
|
||||
(ed25519-public-key q))
|
||||
(else #f)))
|
||||
(define (ssh-key->pieces key-alg blob)
|
||||
(match key-alg
|
||||
[#"ssh-ed25519" (bit-string-case blob
|
||||
([ (= #"ssh-ed25519" :: (t:string #:pack))
|
||||
(q :: (t:string #:pack)) ]
|
||||
(ed25519-public-key q))
|
||||
(else #f))]
|
||||
[_ #f]))
|
||||
|
||||
;; TODO: proper store for keys
|
||||
|
||||
|
|
@ -92,5 +94,6 @@
|
|||
(define (load-public-key filename)
|
||||
(match (file->string filename)
|
||||
[(pregexp #px"ssh-ed25519 +(\\S+) +([^\n]*)\n$" (list _ data-base64 _comment))
|
||||
(pieces->public-key (ssh-key->pieces (base64-decode (string->bytes/utf-8 data-base64))))]
|
||||
(pieces->public-key (ssh-key->pieces #"ssh-ed25519"
|
||||
(base64-decode (string->bytes/utf-8 data-base64))))]
|
||||
[_ (error 'load-public-key "Cannot load key in file ~s" filename)]))
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@
|
|||
|
||||
(provide t:boolean
|
||||
t:string
|
||||
t:string/utf-8
|
||||
t:mpint
|
||||
mpint-width
|
||||
t:name-list
|
||||
|
|
@ -116,6 +117,13 @@
|
|||
(bit-string ((bytes-length (bit-string->bytes bs)) :: integer bits 32)
|
||||
(bs :: binary)))))
|
||||
|
||||
(define-syntax t:string/utf-8
|
||||
(syntax-rules ()
|
||||
((_ #t input ks kf)
|
||||
(t:string #t input (lambda (v rest) (ks (bytes->string/utf-8 v) rest)) kf #:pack))
|
||||
((_ #f str)
|
||||
(t:string #f (string->bytes/utf-8 str) #:pack))))
|
||||
|
||||
(define-syntax t:mpint
|
||||
(syntax-rules ()
|
||||
((_ #t input ks kf)
|
||||
|
|
@ -169,13 +177,14 @@
|
|||
(else (kf))))]))
|
||||
|
||||
(define-for-syntax (codec-options field-type)
|
||||
(syntax-case field-type (byte boolean uint32 uint64 string mpint name-list extension)
|
||||
(syntax-case field-type (byte boolean uint32 uint64 string string/utf-8 mpint name-list extension)
|
||||
(byte #'(integer bits 8))
|
||||
((byte n) #'((t:packed-bytes n)))
|
||||
(boolean #'((t:boolean)))
|
||||
(uint32 #'(integer bits 32))
|
||||
(uint64 #'(integer bits 64))
|
||||
(string #'((t:string #:pack)))
|
||||
(string/utf-8 #'((t:string/utf-8)))
|
||||
(mpint #'((t:mpint)))
|
||||
(name-list #'((t:name-list)))
|
||||
(extension #'((t:packed-bytes)))))
|
||||
|
|
@ -309,9 +318,9 @@
|
|||
(string service-name))
|
||||
|
||||
(define-ssh-message-type ssh-msg-userauth-request SSH_MSG_USERAUTH_REQUEST
|
||||
(string user-name)
|
||||
(string service-name)
|
||||
(string method-name)
|
||||
(string/utf-8 user-name)
|
||||
(string service-name)
|
||||
(string method-name)
|
||||
(extension method-specific-fields))
|
||||
|
||||
(define-ssh-message-type ssh-msg-userauth-failure SSH_MSG_USERAUTH_FAILURE
|
||||
|
|
@ -321,8 +330,8 @@
|
|||
(define-ssh-message-type ssh-msg-userauth-success SSH_MSG_USERAUTH_SUCCESS)
|
||||
|
||||
(define-ssh-message-type ssh-msg-userauth-banner SSH_MSG_USERAUTH_BANNER
|
||||
(string message)
|
||||
(string language))
|
||||
(string/utf-8 message)
|
||||
(string language))
|
||||
|
||||
(define-ssh-message-type ssh-msg-userauth-pk-ok SSH_MSG_USERAUTH_PK_OK
|
||||
(string algorithm-name)
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@
|
|||
|
||||
;; An AuthenticationState is one of
|
||||
;; - #f, for not-yet-authenticated
|
||||
;; - an (SshAuthenticatedUser Bytes Bytes), recording successful completion
|
||||
;; - an (SshAuthenticatedUser String Bytes), recording successful completion
|
||||
;; of the authentication protocol after a request to be identified
|
||||
;; as the given username for the given service.
|
||||
;; TODO: When authentication is properly implemented, we will need
|
||||
|
|
@ -74,32 +74,35 @@
|
|||
|
||||
(define-syntax with-incoming-task
|
||||
(syntax-rules ()
|
||||
[(_ #:done done! (type-byte packet-pattern message-pattern) body ...)
|
||||
(with-incoming-task* on done! (type-byte packet-pattern message-pattern)
|
||||
body ...)]
|
||||
[(_ (type-byte packet-pattern message-pattern) body ...)
|
||||
(with-incoming-task* on (type-byte packet-pattern message-pattern) body ...)]))
|
||||
(with-incoming-task #:done done! (type-byte packet-pattern message-pattern)
|
||||
body ...
|
||||
(done!))]))
|
||||
|
||||
(define-syntax-rule
|
||||
(with-incoming-task/react (type-byte packet-pattern message-pattern) body ...)
|
||||
(react
|
||||
(with-incoming-task* stop-on (type-byte packet-pattern message-pattern)
|
||||
body ...)))
|
||||
(with-incoming-task* stop-on done! (type-byte packet-pattern message-pattern)
|
||||
body ...
|
||||
(done!))))
|
||||
|
||||
(define-syntax with-incoming-task*
|
||||
(syntax-rules ()
|
||||
[(_ on-stx (type-byte packet-pattern message-pattern) body ...)
|
||||
[(_ on-stx k-id (type-byte packet-pattern message-pattern) body ...)
|
||||
(on-stx (message (task ($ seq-id _) type-byte packet-pattern message-pattern))
|
||||
body ...
|
||||
(send! (task-complete seq-id)))]))
|
||||
(let ((k-id (lambda () (send! (task-complete seq-id)))))
|
||||
body ...))]))
|
||||
|
||||
(define-syntax-rule (with-assertion-presence ds assertion
|
||||
(define-syntax-rule (with-assertion-presence assertion
|
||||
#:on-present [body-present ...]
|
||||
#:on-absent [body-absent ...])
|
||||
(let ((assertion-present #f))
|
||||
(at ds (on (asserted assertion)
|
||||
(set! assertion-present #t)
|
||||
body-present ...))
|
||||
(sync! ds (when (not assertion-present)
|
||||
(void)
|
||||
body-absent ...))))
|
||||
(let/query ([present? (query-value #f assertion #t)])
|
||||
(if present?
|
||||
(let () body-present ... (void))
|
||||
(let () body-absent ... (void)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Key Exchange
|
||||
|
|
@ -277,7 +280,7 @@
|
|||
(exchange-hash-info local-id remote-id encoded-local-algs encoded-remote-algs))
|
||||
kex-alg
|
||||
supplied-host-key
|
||||
host-key-alg
|
||||
(string->bytes/utf-8 (symbol->string host-key-alg))
|
||||
(lambda (shared-secret exchange-hash hash-alg)
|
||||
(when (not (session-id)) (session-id exchange-hash)) ;; don't overwrite existing ID
|
||||
(define k-h-prefix (bit-string ((bit-string->integer shared-secret #t #f) :: (t:mpint))
|
||||
|
|
@ -319,87 +322,125 @@
|
|||
;; Service request manager and user authentication
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (service-request-handler conn-ds user-public-key-accepted? session-id)
|
||||
(define (service-request-handler conn-ds session-id)
|
||||
(define-field authentication-state #f)
|
||||
(begin/dataflow (log-info "authentication-state ~s" (authentication-state)))
|
||||
|
||||
(define (acceptable-ed25519-pk key-alg user-name pk-bytes)
|
||||
(and (equal? key-alg #"ssh-ed25519")
|
||||
(let ((pk (ssh-key->pieces pk-bytes)))
|
||||
(and pk
|
||||
(user-public-key-accepted? user-name pk)
|
||||
(pieces->public-key pk)))))
|
||||
|
||||
(define (run-userauth)
|
||||
(define expected-service #"ssh-connection")
|
||||
|
||||
(define remaining-methods '(publickey password))
|
||||
(define (give-up-on method)
|
||||
(set! remaining-methods (remq method remaining-methods)))
|
||||
|
||||
(at conn-ds
|
||||
(send! (outbound-packet (ssh-msg-userauth-banner #"Welcome to Racket SSH!\r\n" #"")))
|
||||
(send! (outbound-packet (ssh-msg-userauth-banner "Welcome to Racket SSH!\r\n" #"")))
|
||||
(react
|
||||
(define (auth-ok new-authentication-state)
|
||||
(define/query-set remaining-methods (SshAuthenticationMethodAcceptable $m)
|
||||
(parse-SshAuthMethod m))
|
||||
|
||||
(define (give-up-on method)
|
||||
(log-info "Giving up on ~v" method)
|
||||
(remaining-methods (set-remove (remaining-methods) method))
|
||||
(auth-fail))
|
||||
|
||||
(define (with-method-check method done! proc)
|
||||
(if (set-member? (remaining-methods) method)
|
||||
(proc)
|
||||
(begin (auth-fail)
|
||||
(done!))))
|
||||
|
||||
(define (auth-fail)
|
||||
(define remaining (map (lambda (m) (string->symbol (bytes->string/utf-8 (->preserve m))))
|
||||
(set->list (remaining-methods))))
|
||||
(send! (outbound-packet
|
||||
(ssh-msg-userauth-failure (if (null? remaining) '(none) remaining) #f))))
|
||||
|
||||
(define (auth-ok user-name)
|
||||
(stop-current-facet
|
||||
(send! (outbound-packet (ssh-msg-userauth-success)))
|
||||
(authentication-state new-authentication-state)
|
||||
(authentication-state (SshAuthenticatedUser user-name expected-service))
|
||||
;; RFC4252 section 5.1 page 6:
|
||||
(react (with-incoming-task (SSH_MSG_USERAUTH_REQUEST _ _)))
|
||||
(spawn #:name 'channel-manager (run-channel-manager conn-ds))))
|
||||
|
||||
(with-incoming-task
|
||||
#:done done!
|
||||
(SSH_MSG_USERAUTH_REQUEST
|
||||
_ (ssh-msg-userauth-request $user-name expected-service #"none" _))
|
||||
;; This is a request for available authentication methods.
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure remaining-methods #f))))
|
||||
_ (ssh-msg-userauth-request $user-name expected-service (SshAuthMethod-none) _))
|
||||
(with-method-check (SshAuthMethod-none) done!
|
||||
(lambda ()
|
||||
(on (asserted (SshAuthenticationAcceptable (SshAuthMethod-none)
|
||||
(SshAuthRequest-none user-name)
|
||||
$ok))
|
||||
(if ok
|
||||
(auth-ok user-name)
|
||||
(give-up-on (SshAuthMethod-none)))
|
||||
(done!)))))
|
||||
|
||||
(with-incoming-task
|
||||
#:done done!
|
||||
(SSH_MSG_USERAUTH_REQUEST
|
||||
_ (ssh-msg-userauth-request $user-name expected-service #"password" $extension))
|
||||
(log-info "SSH-MSG-USERAUTH-REQUEST ~s ~s ~s ~s" user-name expected-service #"password" extension)
|
||||
(bit-string-case extension
|
||||
([ (= #f :: (t:boolean))
|
||||
(password-bytes :: (t:string #:pack)) ]
|
||||
(log-info "User supplied password ~s" password-bytes)
|
||||
(auth-ok (SshAuthenticatedUser user-name expected-service)))
|
||||
(else
|
||||
(give-up-on 'password)
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure remaining-methods #f))))))
|
||||
_ (ssh-msg-userauth-request $user-name expected-service (SshAuthMethod-password) $extension))
|
||||
(with-method-check (SshAuthMethod-password) done!
|
||||
(lambda ()
|
||||
(bit-string-case extension
|
||||
([ (= #f :: (t:boolean)) (password :: (t:string/utf-8)) ]
|
||||
(on (asserted (SshAuthenticationAcceptable (SshAuthMethod-password)
|
||||
(SshAuthRequest-password user-name password)
|
||||
$ok))
|
||||
(if ok
|
||||
(auth-ok user-name)
|
||||
(give-up-on (SshAuthMethod-password)))
|
||||
(done!)))
|
||||
(else
|
||||
(give-up-on (SshAuthMethod-password))
|
||||
(done!))))))
|
||||
|
||||
(with-incoming-task
|
||||
#:done done!
|
||||
(SSH_MSG_USERAUTH_REQUEST
|
||||
_ (ssh-msg-userauth-request $user-name expected-service #"publickey" $extension))
|
||||
(log-info "SSH-MSG-USERAUTH-REQUEST ~s ~s ~s ~s" user-name expected-service #"publickey" extension)
|
||||
(bit-string-case extension
|
||||
([ (= #f :: (t:boolean))
|
||||
(key-alg :: (t:string #:pack))
|
||||
(pk-blob :: (t:string #:pack)) ]
|
||||
(if (acceptable-ed25519-pk key-alg user-name pk-blob)
|
||||
(send! (outbound-packet (ssh-msg-userauth-pk-ok key-alg pk-blob)))
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure remaining-methods #f)))))
|
||||
([ (= #t :: (t:boolean))
|
||||
(key-alg :: (t:string #:pack))
|
||||
(pk-bytes :: (t:string #:pack))
|
||||
(signature :: (t:string #:pack)) ]
|
||||
(let ((pk (acceptable-ed25519-pk key-alg user-name pk-bytes)))
|
||||
(if (not pk)
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure remaining-methods #f)))
|
||||
(let* ((exchange-hash
|
||||
(bit-string->bytes
|
||||
(bit-string ((session-id) :: (t:string))
|
||||
SSH_MSG_USERAUTH_REQUEST
|
||||
(user-name :: (t:string))
|
||||
(expected-service :: (t:string))
|
||||
(#"publickey" :: (t:string))
|
||||
(#t :: (t:boolean))
|
||||
(key-alg :: (t:string))
|
||||
(pk-bytes :: (t:string))))))
|
||||
(verify-key-signature! pk 'ssh-ed25519 exchange-hash signature)
|
||||
(auth-ok (SshAuthenticatedUser user-name expected-service))))))
|
||||
(else
|
||||
(give-up-on 'publickey)
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure remaining-methods #f)))))))))
|
||||
_ (ssh-msg-userauth-request $user-name expected-service (SshAuthMethod-publickey) $extension))
|
||||
(with-method-check (SshAuthMethod-publickey) done!
|
||||
(lambda ()
|
||||
(define (acceptable-pk key-alg pk-bytes ks)
|
||||
(let ((pk (ssh-key->pieces key-alg pk-bytes)))
|
||||
(if (not pk)
|
||||
(begin (auth-fail)
|
||||
(done!))
|
||||
(on (asserted (SshAuthenticationAcceptable (SshAuthMethod-publickey)
|
||||
(SshAuthRequest-publickey user-name pk)
|
||||
$ok))
|
||||
(if ok (ks pk) (auth-fail))
|
||||
(done!)))))
|
||||
|
||||
(bit-string-case extension
|
||||
([ (= #f :: (t:boolean))
|
||||
(key-alg :: (t:string #:pack))
|
||||
(pk-blob :: (t:string #:pack)) ]
|
||||
(acceptable-pk
|
||||
key-alg pk-blob
|
||||
(lambda (pk) (send! (outbound-packet (ssh-msg-userauth-pk-ok key-alg pk-blob))))))
|
||||
([ (= #t :: (t:boolean))
|
||||
(key-alg :: (t:string #:pack))
|
||||
(pk-bytes :: (t:string #:pack))
|
||||
(signature :: (t:string #:pack)) ]
|
||||
(acceptable-pk
|
||||
key-alg pk-bytes
|
||||
(lambda (pk)
|
||||
(let* ((exchange-hash
|
||||
(bit-string->bytes
|
||||
(bit-string ((session-id) :: (t:string))
|
||||
SSH_MSG_USERAUTH_REQUEST
|
||||
(user-name :: (t:string/utf-8))
|
||||
(expected-service :: (t:string))
|
||||
((->preserve (SshAuthMethod-publickey)) :: (t:string))
|
||||
(#t :: (t:boolean))
|
||||
(key-alg :: (t:string))
|
||||
(pk-bytes :: (t:string))))))
|
||||
(verify-key-signature! (pieces->public-key pk)
|
||||
key-alg
|
||||
exchange-hash
|
||||
signature)
|
||||
(auth-ok user-name)))))
|
||||
(else
|
||||
(give-up-on (SshAuthMethod-publickey))
|
||||
(done!)))))))))
|
||||
|
||||
(at conn-ds
|
||||
(assert #:when (authentication-state) (authentication-state))
|
||||
|
|
@ -555,7 +596,7 @@
|
|||
$maximum-packet-size
|
||||
$extra-request-data))
|
||||
(log-info "open ~s" (list channel-type remote-ref initial-window-size maximum-packet-size extra-request-data))
|
||||
(with-assertion-presence conn-ds (SshChannelTypeAvailable channel-type)
|
||||
(with-assertion-presence (SshChannelTypeAvailable channel-type)
|
||||
#:on-present [(define local-ref (allocate-local-ref remote-ref))
|
||||
(if (not local-ref)
|
||||
(send! (outbound-packet
|
||||
|
|
@ -646,8 +687,7 @@
|
|||
local-identification-string
|
||||
peer-identification-string
|
||||
session-role
|
||||
supplied-host-key
|
||||
user-public-key-accepted?)
|
||||
supplied-host-key)
|
||||
(define-field rekey-state (rekey-in-seconds-or-bytes -1 -1 0))
|
||||
(define-field session-id #f)
|
||||
(define-field total-transferred 0)
|
||||
|
|
@ -699,7 +739,7 @@
|
|||
(at conn-ds
|
||||
(stop-on (message 'enable-service-request-handler)
|
||||
(spawn #:name 'service-request-handler
|
||||
(service-request-handler conn-ds user-public-key-accepted? session-id)))))
|
||||
(service-request-handler conn-ds session-id)))))
|
||||
|
||||
(define (maybe-rekey)
|
||||
(match (rekey-state)
|
||||
|
|
@ -740,8 +780,7 @@
|
|||
;; performing key exchange. Dispatch it.
|
||||
(react
|
||||
(on-start (send! (task sequence-number packet-type-number payload message)))
|
||||
(with-assertion-presence conn-ds
|
||||
(Observe (:pattern (task ,_ packet-type-number ,_ ,_)) _)
|
||||
(with-assertion-presence (Observe (:pattern (task ,_ packet-type-number ,_ ,_)) _)
|
||||
#:on-present []
|
||||
#:on-absent [(send! (outbound-packet (ssh-msg-unimplemented sequence-number)))
|
||||
(send! (task-complete sequence-number))])
|
||||
|
|
|
|||
Loading…
Reference in New Issue