syndicate-lang
/
racket-ssh-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Make handlers etc *required* to return a transition structure.

This commit is contained in:
Tony Garnock-Jones 2012-07-23 17:21:47 -04:00
parent e94acab878
commit ff2cd74339
3 changed files with 137 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
new-server.rkt
View File

@ -47,17 +47,16 @@
(define (spy marker) (define (spy marker)
(role (or (topic-subscriber (wild) #:monitor? #t) (role (or (topic-subscriber (wild) #:monitor? #t)
(topic-publisher (wild) #:monitor? #t)) (topic-publisher (wild) #:monitor? #t))
#:state state
[message [message
(write `(,marker ,message)) (write `(,marker ,message))
(newline) (newline)
(flush-output) (flush-output)
state])) (void)]))
(define-syntax-rule (wait-for topic-of-interest #:state state action ...) (define-syntax-rule (wait-for topic-of-interest action ...)
(role/fresh role-name topic-of-interest (role/fresh role-name topic-of-interest
#:state state #:state state
#:on-presence (sequence-actions state #:on-presence (sequence-actions (transition state)
(delete-role role-name) (delete-role role-name)
action ...))) action ...)))
@ -78,7 +77,7 @@
(transition state (kill))] (transition state (kill))]
[(tcp-channel _ _ (? bytes? remote-identification)) [(tcp-channel _ _ (? bytes? remote-identification))
(check-remote-identification! remote-identification) (check-remote-identification! remote-identification)
(sequence-actions state (sequence-actions (transition state)
;; First, set the incoming mode to bytes. ;; First, set the incoming mode to bytes.
(at-meta-level (cin (tcp-mode 'bytes))) (at-meta-level (cin (tcp-mode 'bytes)))
;; Then initialise the reader, switching to packet-reading mode. ;; Then initialise the reader, switching to packet-reading mode.
@ -91,9 +90,7 @@
;; the reader we are ready for a single packet and spawn ;; the reader we are ready for a single packet and spawn
;; the session manager. ;; the session manager.
(wait-for (topic-subscriber (inbound-packet (wild) (wild) (wild) (wild)) #:monitor? #t) (wait-for (topic-subscriber (inbound-packet (wild) (wild) (wild) (wild)) #:monitor? #t)
#:state state
(wait-for (topic-publisher (outbound-packet (wild)) #:monitor? #t) (wait-for (topic-publisher (outbound-packet (wild)) #:monitor? #t)
#:state state
(send-message (inbound-credit 1)) (send-message (inbound-credit 1))
(spawn (ssh-session local-identification (spawn (ssh-session local-identification
remote-identification remote-identification
@ -188,7 +185,7 @@
(ch-do send-feedback inbound-stream (channel-stream-ok)))] (ch-do send-feedback inbound-stream (channel-stream-ok)))]
[(channel-stream-notify #"env" _) [(channel-stream-notify #"env" _)
;; Don't care ;; Don't care
state] (transition state)]
[(channel-stream-request #"shell" _) [(channel-stream-request #"shell" _)
(match-define (repl-instance-state c2s-in _ s2c-in s2c-out) state) (match-define (repl-instance-state c2s-in _ s2c-in s2c-out) state)
(define buffer-size 1024) (define buffer-size 1024)
@ -197,10 +194,7 @@
(transition state (transition state
(ch-do send-feedback inbound-stream (channel-stream-ok)) (ch-do send-feedback inbound-stream (channel-stream-ok))
(role (topic-subscriber (cons (thread-dead-evt repl-thread) (wild))) (role (topic-subscriber (cons (thread-dead-evt repl-thread) (wild)))
#:state state [_ (kill #:reason "REPL thread exited")])
[_
(transition state
(kill #:reason "REPL thread exited"))])
(role (topic-subscriber (cons (peek-bytes-avail!-evt dummy-buffer 0 #f s2c-in) (wild))) (role (topic-subscriber (cons (peek-bytes-avail!-evt dummy-buffer 0 #f s2c-in) (wild)))
;; We're using peek-bytes-avail!-evt rather than ;; We're using peek-bytes-avail!-evt rather than
;; read-bytes-avail!-evt because of potential overwriting ;; read-bytes-avail!-evt because of potential overwriting
@ -225,7 +219,7 @@
(close-output-port (repl-instance-state-c2s-out state)) (close-output-port (repl-instance-state-c2s-out state))
;; ^ this signals the repl thread to exit. ;; ^ this signals the repl thread to exit.
;; Now, wait for it to do so. ;; Now, wait for it to do so.
state] (transition state)]
[(channel-stream-data bs) [(channel-stream-data bs)
(write-bytes bs (repl-instance-state-c2s-out state)) (write-bytes bs (repl-instance-state-c2s-out state))
(flush-output (repl-instance-state-c2s-out state)) (flush-output (repl-instance-state-c2s-out state))
@ -233,7 +227,7 @@
(ch-do send-feedback inbound-stream (channel-stream-credit (bytes-length bs))))] (ch-do send-feedback inbound-stream (channel-stream-credit (bytes-length bs))))]
[m [m
(write `(channel inbound ,m)) (newline) (write `(channel inbound ,m)) (newline)
state])) (transition state)]))
(match (channel-name-type cname) (match (channel-name-type cname)
[#"session" [#"session"
(define-values (c2s-in c2s-out) (make-pipe)) (define-values (c2s-in c2s-out) (make-pipe))
@ -251,10 +245,9 @@
(handle-channel-message state body)])) (handle-channel-message state body)]))
(at-meta-level (at-meta-level
(role (topic-publisher (channel-message outbound-stream (wild))) (role (topic-publisher (channel-message outbound-stream (wild)))
#:state state
[m [m
(write `(channel outbound ,cname ,m)) (newline) (write `(channel outbound ,cname ,m)) (newline)
state])))] (void)])))]
[type [type
(transition 'no-instance-state (transition 'no-instance-state
(at-meta-level (send-message (at-meta-level (send-message

244
ssh-session.rkt
View File

@ -179,7 +179,7 @@
;; PacketHandler for handling SSH_MSG_IGNORE. ;; PacketHandler for handling SSH_MSG_IGNORE.
(define (handle-msg-ignore packet message conn) (define (handle-msg-ignore packet message conn)
conn) (transition conn))
;; PacketHandler for handling SSH_MSG_UNIMPLEMENTED. ;; PacketHandler for handling SSH_MSG_UNIMPLEMENTED.
(define (handle-msg-unimplemented packet message conn) (define (handle-msg-unimplemented packet message conn)
@ -191,7 +191,7 @@
;; PacketHandler for handling SSH_MSG_DEBUG. ;; PacketHandler for handling SSH_MSG_DEBUG.
(define (handle-msg-debug packet message conn) (define (handle-msg-debug packet message conn)
(log-debug (format "Received SSHv2 SSH_MSG_DEBUG packet ~v" message)) (log-debug (format "Received SSHv2 SSH_MSG_DEBUG packet ~v" message))
conn) (transition conn))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Key Exchange ;; Key Exchange
@ -251,33 +251,35 @@
dh:oakley-group-2)) ;; yes, SSH's group1 == Oakley/RFC2409 group 2 dh:oakley-group-2)) ;; yes, SSH's group1 == Oakley/RFC2409 group 2
(define-values (private-key public-key) (generate-key group)) (define-values (private-key public-key) (generate-key group))
(define public-key-as-integer (bit-string->integer public-key #t #f)) (define public-key-as-integer (bit-string->integer public-key #t #f))
(oneshot-handler conn (transition
SSH_MSG_KEXDH_INIT (oneshot-handler conn
(lambda (packet message conn) SSH_MSG_KEXDH_INIT
(define e (ssh-msg-kexdh-init-e message)) (lambda (packet message conn)
(define e-width (mpint-width e)) (define e (ssh-msg-kexdh-init-e message))
(define e-as-bytes (integer->bit-string e (* 8 e-width) #t)) (define e-width (mpint-width e))
(define shared-secret (compute-key private-key e-as-bytes)) (define e-as-bytes (integer->bit-string e (* 8 e-width) #t))
(define hash-alg sha1) (define shared-secret (compute-key private-key e-as-bytes))
(define-values (host-key-private host-key-public) (define hash-alg sha1)
(host-key-algorithm->keys host-key-alg)) (define-values (host-key-private host-key-public)
(define host-key-bytes (host-key-algorithm->keys host-key-alg))
(pieces->ssh-host-key (public-key->pieces host-key-public))) (define host-key-bytes
(define exchange-hash (pieces->ssh-host-key (public-key->pieces host-key-public)))
(dh-exchange-hash hash-info (define exchange-hash
host-key-bytes (dh-exchange-hash hash-info
e host-key-bytes
public-key-as-integer e
(bit-string->integer shared-secret #t #f))) public-key-as-integer
(define h-signature (host-key-signature host-key-private (bit-string->integer shared-secret #t #f)))
host-key-alg (define h-signature (host-key-signature host-key-private
exchange-hash)) host-key-alg
(sequence-actions conn exchange-hash))
(send-message (outbound-packet (sequence-actions (transition conn)
(ssh-msg-kexdh-reply (bit-string->bytes host-key-bytes) (send-message (outbound-packet
public-key-as-integer (ssh-msg-kexdh-reply (bit-string->bytes host-key-bytes)
(bit-string->bytes h-signature)))) public-key-as-integer
(lambda (conn) (finish shared-secret exchange-hash hash-alg conn)))))] (bit-string->bytes h-signature))))
(lambda (conn)
(finish shared-secret exchange-hash hash-alg conn))))))]
[else (disconnect-with-error SSH_DISCONNECT_KEY_EXCHANGE_FAILED [else (disconnect-with-error SSH_DISCONNECT_KEY_EXCHANGE_FAILED
"Bad key-exchange algorithm ~v" kex-alg)])) "Bad key-exchange algorithm ~v" kex-alg)]))
@ -293,31 +295,33 @@
dh:oakley-group-2)) ;; yes, SSH's group1 == Oakley/RFC2409 group 2 dh:oakley-group-2)) ;; yes, SSH's group1 == Oakley/RFC2409 group 2
(define-values (private-key public-key) (generate-key group)) (define-values (private-key public-key) (generate-key group))
(define public-key-as-integer (bit-string->integer public-key #t #f)) (define public-key-as-integer (bit-string->integer public-key #t #f))
(sequence-actions conn (sequence-actions (transition conn)
(send-message (outbound-packet (ssh-msg-kexdh-init public-key-as-integer))) (send-message (outbound-packet (ssh-msg-kexdh-init public-key-as-integer)))
(lambda (conn) (lambda (conn)
(oneshot-handler conn (transition
SSH_MSG_KEXDH_REPLY (oneshot-handler conn
(lambda (packet message conn) SSH_MSG_KEXDH_REPLY
(define f (ssh-msg-kexdh-reply-f message)) (lambda (packet message conn)
(define f-width (mpint-width f)) (define f (ssh-msg-kexdh-reply-f message))
(define f-as-bytes (integer->bit-string f (* 8 f-width) #t)) (define f-width (mpint-width f))
(define shared-secret (compute-key private-key f-as-bytes)) (define f-as-bytes (integer->bit-string f (* 8 f-width) #t))
(define hash-alg sha1) (define shared-secret (compute-key private-key f-as-bytes))
(define host-key-bytes (ssh-msg-kexdh-reply-host-key message)) (define hash-alg sha1)
(define host-public-key (define host-key-bytes (ssh-msg-kexdh-reply-host-key message))
(pieces->public-key (ssh-host-key->pieces host-key-bytes))) (define host-public-key
(define exchange-hash (pieces->public-key (ssh-host-key->pieces host-key-bytes)))
(dh-exchange-hash hash-info (define exchange-hash
host-key-bytes (dh-exchange-hash hash-info
public-key-as-integer host-key-bytes
f public-key-as-integer
(bit-string->integer shared-secret #t #f))) f
(verify-host-key-signature! host-public-key (bit-string->integer shared-secret #t #f)))
host-key-alg (verify-host-key-signature! host-public-key
exchange-hash host-key-alg
(ssh-msg-kexdh-reply-h-signature message)) exchange-hash
(finish shared-secret exchange-hash hash-alg conn)))))] (ssh-msg-kexdh-reply-h-signature
message))
(finish shared-secret exchange-hash hash-alg conn))))))]
[else (disconnect-with-error SSH_DISCONNECT_KEY_EXCHANGE_FAILED [else (disconnect-with-error SSH_DISCONNECT_KEY_EXCHANGE_FAILED
"Bad key-exchange algorithm ~v" kex-alg)])) "Bad key-exchange algorithm ~v" kex-alg)]))
@ -409,41 +413,42 @@
(extend (bytes-append key (hash-alg (bit-string->bytes (extend (bytes-append key (hash-alg (bit-string->bytes
(bit-string (k-h-prefix :: binary) (bit-string (k-h-prefix :: binary)
(key :: binary)))))))))) (key :: binary))))))))))
(oneshot-handler (struct-copy connection conn (transition
[session-id session-id]) ;; just in case it changed (oneshot-handler (struct-copy connection conn
SSH_MSG_NEWKEYS [session-id session-id]) ;; just in case it changed
(lambda (newkeys-packet newkeys-message conn) SSH_MSG_NEWKEYS
;; First, send our SSH_MSG_NEWKEYS, (lambda (newkeys-packet newkeys-message conn)
;; incrementing the various counters, and then ;; First, send our SSH_MSG_NEWKEYS,
;; apply the new algorithms. Also arm our rekey ;; incrementing the various counters, and then
;; timer. ;; apply the new algorithms. Also arm our rekey
(define new-rekey-state (rekey-in-seconds-or-bytes ;; timer.
(rekey-interval) (define new-rekey-state (rekey-in-seconds-or-bytes
(rekey-volume) (rekey-interval)
(connection-total-transferred conn))) (rekey-volume)
(transition (connection-total-transferred conn)))
(set-handlers (struct-copy connection conn [rekey-state new-rekey-state]) (transition
SSH_MSG_SERVICE_REQUEST handle-msg-service-request) (set-handlers
(send-message (outbound-packet (ssh-msg-newkeys))) (struct-copy connection conn [rekey-state new-rekey-state])
(send-message SSH_MSG_SERVICE_REQUEST handle-msg-service-request)
(new-keys (connection-is-server? conn) (send-message (outbound-packet (ssh-msg-newkeys)))
derive-key (send-message
c2s-enc s2c-enc (new-keys (connection-is-server? conn)
c2s-mac s2c-mac derive-key
c2s-zip s2c-zip)) c2s-enc s2c-enc
(send-message (set-timer 'rekey-timer c2s-mac s2c-mac
(* (rekey-wait-deadline new-rekey-state) 1000) c2s-zip s2c-zip))
'absolute)))))) (send-message (set-timer 'rekey-timer
(* (rekey-wait-deadline new-rekey-state) 1000)
'absolute)))))))
(let ((t (if should-discard-first-kex-packet (sequence-actions (continue-after-discard conn)
(struct-copy connection (continue-after-discard conn) [discard-next-packet? #t]) (when should-discard-first-kex-packet
(continue-after-discard conn)))) (lambda (conn) (transition (struct-copy connection conn [discard-next-packet? #t]))))
(sequence-actions t (lambda (conn)
(lambda (conn) (if (rekey-wait? (connection-rekey-state conn))
(if (rekey-wait? (connection-rekey-state conn)) (transition (struct-copy connection conn [rekey-state (rekey-local local-algs)])
(transition (struct-copy connection conn [rekey-state (rekey-local local-algs)]) (send-message (outbound-packet local-algs)))
(send-message (outbound-packet local-algs))) (transition conn)))))
conn)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Service request manager ;; Service request manager
@ -456,11 +461,12 @@
(if (connection-authentication-state conn) (if (connection-authentication-state conn)
(disconnect-with-error SSH_DISCONNECT_SERVICE_NOT_AVAILABLE (disconnect-with-error SSH_DISCONNECT_SERVICE_NOT_AVAILABLE
"Repeated authentication is not permitted") "Repeated authentication is not permitted")
(sequence-actions conn (sequence-actions (transition conn)
(send-message (outbound-packet (ssh-msg-service-accept service))) (send-message (outbound-packet (ssh-msg-service-accept service)))
(lambda (conn) (oneshot-handler conn (lambda (conn) (transition
SSH_MSG_USERAUTH_REQUEST (oneshot-handler conn
handle-msg-userauth-request))))] SSH_MSG_USERAUTH_REQUEST
handle-msg-userauth-request)))))]
[else [else
(disconnect-with-error SSH_DISCONNECT_SERVICE_NOT_AVAILABLE (disconnect-with-error SSH_DISCONNECT_SERVICE_NOT_AVAILABLE
"Service ~v not supported" "Service ~v not supported"
@ -477,7 +483,7 @@
[(and (positive? (bytes-length user-name)) [(and (positive? (bytes-length user-name))
(equal? service-name #"ssh-connection")) (equal? service-name #"ssh-connection"))
;; TODO: Actually implement client authentication ;; TODO: Actually implement client authentication
(sequence-actions conn (sequence-actions (transition conn)
(send-message (outbound-packet (ssh-msg-userauth-success))) (send-message (outbound-packet (ssh-msg-userauth-success)))
(lambda (conn) (lambda (conn)
(start-connection-service (start-connection-service
@ -594,7 +600,7 @@
(list (delete-role (list cname 'outbound)) (list (delete-role (list cname 'outbound))
(delete-role (list cname 'inbound)))] (delete-role (list cname 'inbound)))]
[else (list)])])))] [else (list)])])))]
[else conn])) [else (transition conn)]))
(define (channel-roles cname initial-message-producer) (define (channel-roles cname initial-message-producer)
(define inbound-stream-name (channel-stream-name #t cname)) (define inbound-stream-name (channel-stream-name #t cname))
@ -605,11 +611,9 @@
(role (topic-subscriber (channel-message outbound-stream-name (wild))) (role (topic-subscriber (channel-message outbound-stream-name (wild)))
#:name (list cname 'outbound) #:name (list cname 'outbound)
#:state conn #:state conn
#:on-presence #:on-presence (transition conn
(transition conn (initial-message-producer inbound-stream-name outbound-stream-name))
(initial-message-producer inbound-stream-name outbound-stream-name)) #:on-absence (maybe-close-channel cname conn 'local)
#:on-absence
(maybe-close-channel cname conn 'local)
[(channel-message _ body) [(channel-message _ body)
(define ch (findf (ssh-channel-name=? cname) (connection-channels conn))) (define ch (findf (ssh-channel-name=? cname) (connection-channels conn)))
(define remote-ref (ssh-channel-remote-ref ch)) (define remote-ref (ssh-channel-remote-ref ch))
@ -672,19 +676,20 @@
(define arbitrary-locally-originated-traffic (define arbitrary-locally-originated-traffic
(channel-message arbitrary-locally-originated-stream (wild))) (channel-message arbitrary-locally-originated-stream (wild)))
(sequence-actions (sequence-actions
(set-handlers conn (transition
;; TODO: SSH_MSG_GLOBAL_REQUEST handle-msg-global-request (set-handlers conn
SSH_MSG_CHANNEL_OPEN handle-msg-channel-open ;; TODO: SSH_MSG_GLOBAL_REQUEST handle-msg-global-request
SSH_MSG_CHANNEL_OPEN_CONFIRMATION handle-msg-channel-open-confirmation SSH_MSG_CHANNEL_OPEN handle-msg-channel-open
SSH_MSG_CHANNEL_OPEN_FAILURE handle-msg-channel-open-failure SSH_MSG_CHANNEL_OPEN_CONFIRMATION handle-msg-channel-open-confirmation
SSH_MSG_CHANNEL_WINDOW_ADJUST handle-msg-channel-window-adjust SSH_MSG_CHANNEL_OPEN_FAILURE handle-msg-channel-open-failure
SSH_MSG_CHANNEL_DATA handle-msg-channel-data SSH_MSG_CHANNEL_WINDOW_ADJUST handle-msg-channel-window-adjust
SSH_MSG_CHANNEL_EXTENDED_DATA handle-msg-channel-extended-data SSH_MSG_CHANNEL_DATA handle-msg-channel-data
SSH_MSG_CHANNEL_EOF handle-msg-channel-eof SSH_MSG_CHANNEL_EXTENDED_DATA handle-msg-channel-extended-data
SSH_MSG_CHANNEL_CLOSE handle-msg-channel-close SSH_MSG_CHANNEL_EOF handle-msg-channel-eof
SSH_MSG_CHANNEL_REQUEST handle-msg-channel-request SSH_MSG_CHANNEL_CLOSE handle-msg-channel-close
SSH_MSG_CHANNEL_SUCCESS handle-msg-channel-success SSH_MSG_CHANNEL_REQUEST handle-msg-channel-request
SSH_MSG_CHANNEL_FAILURE handle-msg-channel-failure) SSH_MSG_CHANNEL_SUCCESS handle-msg-channel-success
SSH_MSG_CHANNEL_FAILURE handle-msg-channel-failure))
;; Start responding to channel interest coming from the ;; Start responding to channel interest coming from the
;; application. We are responding to channels appearing from the ;; application. We are responding to channels appearing from the
;; remote peer by virtue of our installation of the handler for ;; remote peer by virtue of our installation of the handler for
@ -702,7 +707,7 @@
(transition (update-channel cname values conn) (transition (update-channel cname values conn)
(channel-roles cname (lambda (inbound-stream outbound-stream) (channel-roles cname (lambda (inbound-stream outbound-stream)
'()))) '())))
conn)])))) (transition conn))]))))
(define (handle-msg-channel-open packet message conn) (define (handle-msg-channel-open packet message conn)
(match-define (ssh-msg-channel-open channel-type* (match-define (ssh-msg-channel-open channel-type*
@ -766,7 +771,7 @@
(define ch (get-channel conn local-ref)) (define ch (get-channel conn local-ref))
(define description (bit-string->bytes description*)) (define description (bit-string->bytes description*))
(define inbound-stream (channel-stream-name #t (ssh-channel-name ch))) (define inbound-stream (channel-stream-name #t (ssh-channel-name ch)))
(sequence-actions conn (sequence-actions (transition conn)
(send-message (channel-message inbound-stream (send-message (channel-message inbound-stream
(channel-stream-open-failure reason description))) (channel-stream-open-failure reason description)))
(lambda (conn) (maybe-close-channel (ssh-channel-name ch) conn 'remote)))) (lambda (conn) (maybe-close-channel (ssh-channel-name ch) conn 'remote))))
@ -828,8 +833,9 @@
"Not authenticated")))) "Not authenticated"))))
(define ((bump-total amount) conn) (define ((bump-total amount) conn)
(struct-copy connection conn (transition
[total-transferred (+ (connection-total-transferred conn) amount)])) (struct-copy connection conn
[total-transferred (+ (connection-total-transferred conn) amount)])))
;; (K V A -> A) A Hash<K,V> -> A ;; (K V A -> A) A Hash<K,V> -> A
(define (hash-fold fn seed hash) (define (hash-fold fn seed hash)
@ -843,7 +849,7 @@
(let ((algs ((local-algorithm-list)))) (let ((algs ((local-algorithm-list))))
(transition (struct-copy connection conn [rekey-state (rekey-local algs)]) (transition (struct-copy connection conn [rekey-state (rekey-local algs)])
(send-message (outbound-packet algs)))) (send-message (outbound-packet algs))))
conn)) (transition conn)))
;; PacketDispatcher. Handles the core transport message types. ;; PacketDispatcher. Handles the core transport message types.
(define base-packet-dispatcher (define base-packet-dispatcher
@ -874,23 +880,23 @@
(role (topic-subscriber (timer-expired 'rekey-timer (wild))) (role (topic-subscriber (timer-expired 'rekey-timer (wild)))
#:state conn #:state conn
[(timer-expired 'rekey-timer now) [(timer-expired 'rekey-timer now)
(sequence-actions conn (sequence-actions (transition conn)
maybe-rekey)]) maybe-rekey)])
(role (topic-subscriber (outbound-byte-credit (wild))) (role (topic-subscriber (outbound-byte-credit (wild)))
#:state conn #:state conn
[(outbound-byte-credit amount) [(outbound-byte-credit amount)
(sequence-actions conn (sequence-actions (transition conn)
(bump-total amount) (bump-total amount)
maybe-rekey)]) maybe-rekey)])
(role (topic-subscriber (inbound-packet (wild) (wild) (wild) (wild))) (role (topic-subscriber (inbound-packet (wild) (wild) (wild) (wild)))
#:state conn #:state conn
[(inbound-packet sequence-number payload message transfer-size) [(inbound-packet sequence-number payload message transfer-size)
(sequence-actions conn (sequence-actions (transition conn)
(lambda (conn) (lambda (conn)
(if (connection-discard-next-packet? conn) (if (connection-discard-next-packet? conn)
(struct-copy connection conn [discard-next-packet? #f]) (transition (struct-copy connection conn [discard-next-packet? #f]))
(dispatch-packet sequence-number payload message conn))) (dispatch-packet sequence-number payload message conn)))
(bump-total transfer-size) (bump-total transfer-size)
(send-message (inbound-credit 1)) (send-message (inbound-credit 1))

5
ssh-transport.rkt
View File

@ -385,7 +385,7 @@
(wild) (wild))) (wild) (wild)))
#:state state #:state state
[(? new-keys? nk) [(? new-keys? nk)
(struct-copy ssh-reader-state state [config (apply-negotiated-options nk #f)])]) (transition (struct-copy ssh-reader-state state [config (apply-negotiated-options nk #f)]))])
(role (topic-publisher (inbound-packet (wild) (wild) (wild) (wild)))))) (role (topic-publisher (inbound-packet (wild) (wild) (wild) (wild))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -438,4 +438,5 @@
(wild) (wild))) (wild) (wild)))
#:state state #:state state
[(? new-keys? nk) [(? new-keys? nk)
(struct-copy ssh-writer-state state [config (apply-negotiated-options nk #t)])]))) (transition
(struct-copy ssh-writer-state state [config (apply-negotiated-options nk #t)]))])))