Prefab SSH message structs
This commit is contained in:
parent
2afedd91fc
commit
30ec899976
|
@ -20,8 +20,7 @@
|
||||||
mpint-width
|
mpint-width
|
||||||
t:name-list)
|
t:name-list)
|
||||||
|
|
||||||
(provide (struct-out ssh-msg)
|
(provide (struct-out ssh-msg-kexinit)
|
||||||
(struct-out ssh-msg-kexinit)
|
|
||||||
(struct-out ssh-msg-kexdh-init)
|
(struct-out ssh-msg-kexdh-init)
|
||||||
(struct-out ssh-msg-kexdh-reply)
|
(struct-out ssh-msg-kexdh-reply)
|
||||||
(struct-out ssh-msg-disconnect)
|
(struct-out ssh-msg-disconnect)
|
||||||
|
@ -50,13 +49,9 @@
|
||||||
(struct-out ssh-msg-channel-failure)
|
(struct-out ssh-msg-channel-failure)
|
||||||
)
|
)
|
||||||
|
|
||||||
(struct ssh-msg () #:transparent)
|
(define encoder-map (make-hasheqv))
|
||||||
|
|
||||||
(define decoder-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 (ssh-message-decode packet)
|
||||||
(define type-code (bytes-ref packet 0))
|
(define type-code (bytes-ref packet 0))
|
||||||
(define decoder (hash-ref decoder-map type-code #f))
|
(define decoder (hash-ref decoder-map type-code #f))
|
||||||
|
@ -65,16 +60,15 @@
|
||||||
#f))
|
#f))
|
||||||
|
|
||||||
(define (ssh-message-encode m)
|
(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
|
(define-syntax define-ssh-message-type
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((_ name type-byte-value (field-type field-name) ...)
|
((_ name type-byte-value (field-type field-name) ...)
|
||||||
(begin
|
(begin
|
||||||
(struct name ssh-msg (field-name ...)
|
(struct name (field-name ...) #:prefab)
|
||||||
#:transparent
|
(hash-set! encoder-map 'name
|
||||||
#:property prop:ssh-message-encoder
|
(compute-ssh-message-encoder type-byte-value field-type ...))
|
||||||
(compute-ssh-message-encoder type-byte-value field-type ...))
|
|
||||||
(hash-set! decoder-map type-byte-value
|
(hash-set! decoder-map type-byte-value
|
||||||
(compute-ssh-message-decoder name type-byte-value field-type ...))))))
|
(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))))))
|
(map string->symbol (regexp-split #rx"," (bytes->string/utf-8 (bit-string->bytes bs))))))
|
||||||
|
|
||||||
(struct test-message (value)
|
(struct test-message (value) #:prefab)
|
||||||
#:transparent
|
(let ((test-decode (compute-ssh-message-decoder test-message 123 mpint))
|
||||||
#:property prop:ssh-message-encoder (compute-ssh-message-encoder 123 mpint))
|
(test-encode (compute-ssh-message-encoder 123 mpint)))
|
||||||
(let ((test-decode (compute-ssh-message-decoder test-message 123 mpint)))
|
|
||||||
(define (bidi-check msg enc-without-type-tag)
|
(define (bidi-check msg enc-without-type-tag)
|
||||||
(let ((enc (bytes-append (bytes 123) 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)))
|
(enc-msg (test-decode enc)))
|
||||||
(if (and (equal? msg-enc enc)
|
(if (and (equal? msg-enc enc)
|
||||||
(equal? enc-msg msg))
|
(equal? enc-msg msg))
|
||||||
|
|
Loading…
Reference in New Issue