Switch to fake-tcp

This commit is contained in:
Tony Garnock-Jones 2012-07-18 11:31:15 -04:00
parent e4e69844b3
commit 7636862e31
3 changed files with 29 additions and 44 deletions

View File

@ -16,8 +16,6 @@
(require "ssh-exceptions.rkt")
(require "os2-support.rkt")
(define server-addr (tcp-listener 2322))
(define (main)
(ground-vm
(transition 'no-state
@ -29,15 +27,9 @@
(define listener
(transition 'no-state
(role 'connection-waiter (topic-subscriber (tcp-channel (wild) server-addr (wild))
#:monitor? #t)
#:state state
(role 'connection-waiter (tcp-listener 2322)
#:topic t
#:on-presence (match t
[(topic 'publisher (tcp-channel remote-addr (== server-addr) _) #f)
(transition state
(spawn (session-vm server-addr remote-addr)
#:debug-name (debug-name 'ssh-session-vm remote-addr)))]))))
#:on-presence (spawn (session-vm t) #:debug-name (debug-name 'ssh-session-vm t)))))
;;---------------------------------------------------------------------------
@ -184,26 +176,23 @@
state]))
(define-syntax-rule (wait-for topic-of-interest #:state state action ...)
(let ((role-name (gensym 'wait-for)))
(role role-name topic-of-interest
#:state state
#:on-presence (sequence-actions state
(delete-role role-name)
action ...))))
(role/fresh role-name topic-of-interest
#:state state
#:on-presence (sequence-actions state
(delete-role role-name)
action ...)))
(define (session-vm local-addr remote-addr)
(define (session-vm new-connection-topic)
(define-values (cin cout in-topic out-topic) (tcp-accept new-connection-topic))
(define local-identification #"SSH-2.0-RacketSSH_0.0")
(define (issue-identification-string)
(at-meta-level
(send-message (tcp-channel local-addr
remote-addr
(bytes-append local-identification #"\r\n")))))
(at-meta-level (cout (bytes-append local-identification #"\r\n"))))
(define (read-handshake-and-become-reader)
(transition 'handshake-is-stateless ;; but, crucially, the ssh-reader proper isn't!
(at-meta-level
(role 'socket-reader (topic-subscriber (tcp-channel remote-addr local-addr (wild)))
(role 'socket-reader in-topic
#:state state
[(tcp-channel _ _ (? eof-object?))
(transition state (kill))]
@ -211,11 +200,11 @@
(check-remote-identification! remote-identification)
(sequence-actions state
;; First, set the incoming mode to bytes.
(at-meta-level (send-tcp-mode remote-addr local-addr 'bytes))
(at-meta-level (cin (tcp-mode 'bytes)))
;; Then initialise the reader, switching to packet-reading mode.
(lambda (ignored-state) (ssh-reader local-addr remote-addr))
(lambda (ignored-state) (ssh-reader new-connection-topic))
;; Finally, spawn the remaining processes and issue the initial credit to the reader.
(spawn (ssh-writer local-addr remote-addr)
(spawn (ssh-writer new-connection-topic)
#:exit-signal? #t
#:debug-name 'ssh-writer)
;; Wait for the reader and writer get started, then tell
@ -258,7 +247,7 @@
inert-exception-handler)
(nested-vm
(debug-name 'ssh-session-vm remote-addr)
(debug-name 'ssh-session-vm new-connection-topic)
;; TODO: use (not-yet-existing) macro variant of nested-vm to avoid
;; spuriously binding nested-boot-pid without blaming the wrong
;; process in case of error.
@ -272,8 +261,8 @@
;; Expect identification string, then update (!) our inbound
;; subscription handler to switch to packet mode.
(at-meta-level (send-tcp-mode remote-addr local-addr 'lines))
(at-meta-level (send-tcp-credit remote-addr local-addr 1))
(at-meta-level (cin (tcp-mode 'lines)))
(at-meta-level (cin (tcp-credit 1)))
(spawn (read-handshake-and-become-reader)
#:exit-signal? #t

View File

@ -4,9 +4,9 @@
(require "../racket-matrix/os2.rkt")
(require "../racket-matrix/os2-event-relay.rkt")
(require "../racket-matrix/os2-timer.rkt")
(require "../racket-matrix/os2-tcp.rkt")
(require "../racket-matrix/fake-tcp.rkt")
(provide (all-from-out "../racket-matrix/os2.rkt"))
(provide (all-from-out "../racket-matrix/os2-event-relay.rkt"))
(provide (all-from-out "../racket-matrix/os2-timer.rkt"))
(provide (all-from-out "../racket-matrix/os2-tcp.rkt"))
(provide (all-from-out "../racket-matrix/fake-tcp.rkt"))

View File

@ -279,19 +279,18 @@
(struct ssh-reader-state (mode config sequence-number remaining-credit) #:prefab)
(define (ssh-reader local-addr remote-addr)
(define (ssh-reader new-connection-topic)
(define-values (cin cout in-topic out-topic) (tcp-accept new-connection-topic))
(define packet-size-limit (default-packet-limit))
(define (issue-credit state)
(match-define (ssh-reader-state _ (crypto-configuration _ desc _ _) _ message-credit) state)
(when (positive? message-credit)
(at-meta-level
(send-tcp-credit remote-addr local-addr (supported-cipher-block-size desc)))))
(at-meta-level (cin (tcp-credit (supported-cipher-block-size desc))))))
(transition (ssh-reader-state 'packet-header initial-crypto-configuration 0 0)
(at-meta-level
(role 'socket-reader
(topic-subscriber (tcp-channel remote-addr local-addr (wild)))
(role 'socket-reader in-topic
#:state (and state
(ssh-reader-state mode
(crypto-configuration cipher
@ -318,8 +317,7 @@
,packet-length
,payload-length
,packet)])
(at-meta-level
(send-tcp-credit remote-addr local-addr mac-byte-count)))
(at-meta-level (cin (tcp-credit mac-byte-count))))
(finish-packet 0 packet-length payload-length packet)))
(define (finish-packet mac-byte-count packet-length payload-length packet)
@ -352,8 +350,7 @@
[mode `(packet-body ,packet-length
,payload-length
,first-block)])
(at-meta-level
(send-tcp-credit remote-addr local-addr remaining-to-read)))
(at-meta-level (cin (tcp-credit remaining-to-read))))
(check-hmac packet-length payload-length first-block))]
[`(packet-body ,packet-length ,payload-length ,first-block)
@ -398,7 +395,8 @@
(struct ssh-writer-state (config sequence-number) #:prefab)
(define (ssh-writer local-addr remote-addr)
(define (ssh-writer new-connection-topic)
(define-values (cin cout in-topic out-topic) (tcp-accept new-connection-topic))
(transition (ssh-writer-state initial-crypto-configuration 0)
(role 'packet-listener
(set (topic-subscriber (outbound-packet (wild)))
@ -431,11 +429,9 @@
(define computed-hmac-bytes (apply-hmac hmac sequence-number packet))
(define mac-byte-count (bytes-length computed-hmac-bytes))
(transition (struct-copy ssh-writer-state state [sequence-number (+ sequence-number 1)])
(at-meta-level
(send-message (tcp-channel local-addr remote-addr encrypted-packet)))
(at-meta-level (cout encrypted-packet))
(when (positive? mac-byte-count)
(at-meta-level
(send-message (tcp-channel local-addr remote-addr computed-hmac-bytes))))
(at-meta-level (cout computed-hmac-bytes)))
(send-message (outbound-byte-credit (+ (bytes-length encrypted-packet) mac-byte-count))))])
(role 'key-change-listener
(topic-subscriber (new-keys (wild)