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

Prefab SSH message structs

This commit is contained in:
Tony Garnock-Jones 2012-05-15 14:22:00 -04:00
parent 2afedd91fc
commit 30ec899976
1 changed files with 10 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
ssh-message-types.rkt
View File

@ -20,8 +20,7 @@
mpint-width
t:name-list)
(provide (struct-out ssh-msg)
(struct-out ssh-msg-kexinit)
(provide (struct-out ssh-msg-kexinit)
(struct-out ssh-msg-kexdh-init)
(struct-out ssh-msg-kexdh-reply)
(struct-out ssh-msg-disconnect)
@ -50,13 +49,9 @@
(struct-out ssh-msg-channel-failure)
)
(struct ssh-msg () #:transparent)
(define encoder-map (make-hasheqv))
(define decoder-map (make-hasheqv))
(define-values (prop:ssh-message-encoder ssh-message-encoder? ssh-message-encoder)
(make-struct-type-property 'ssh-message-encoder))
(define (ssh-message-decode packet)
(define type-code (bytes-ref packet 0))
(define decoder (hash-ref decoder-map type-code #f))
@ -65,16 +60,15 @@
#f))
(define (ssh-message-encode m)
(bit-string->bytes ((ssh-message-encoder m) m)))
(bit-string->bytes ((hash-ref encoder-map (prefab-struct-key m)) m)))
(define-syntax define-ssh-message-type
(syntax-rules ()
((_ name type-byte-value (field-type field-name) ...)
(begin
(struct name ssh-msg (field-name ...)
#:transparent
#:property prop:ssh-message-encoder
(compute-ssh-message-encoder type-byte-value field-type ...))
(struct name (field-name ...) #:prefab)
(hash-set! encoder-map 'name
(compute-ssh-message-encoder type-byte-value field-type ...))
(hash-set! decoder-map type-byte-value
(compute-ssh-message-decoder name type-byte-value field-type ...))))))
@ -185,13 +179,12 @@
'()
(map string->symbol (regexp-split #rx"," (bytes->string/utf-8 (bit-string->bytes bs))))))
(struct test-message (value)
#:transparent
#:property prop:ssh-message-encoder (compute-ssh-message-encoder 123 mpint))
(let ((test-decode (compute-ssh-message-decoder test-message 123 mpint)))
(struct test-message (value) #:prefab)
(let ((test-decode (compute-ssh-message-decoder test-message 123 mpint))
(test-encode (compute-ssh-message-encoder 123 mpint)))
(define (bidi-check msg enc-without-type-tag)
(let ((enc (bytes-append (bytes 123) enc-without-type-tag)))
(let ((msg-enc (ssh-message-encode msg))
(let ((msg-enc (bit-string->bytes (test-encode msg)))
(enc-msg (test-decode enc)))
(if (and (equal? msg-enc enc)
(equal? enc-msg msg))