From e2e59bdf6cd06b6bf27667780b73c56f3c2c9bea Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Mon, 11 Jun 2012 12:24:57 -0400 Subject: [PATCH] Pack decoded messages for the benefit of unify.rkt. --- ssh-message-types.rkt | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/ssh-message-types.rkt b/ssh-message-types.rkt index 8a5b287..173053c 100644 --- a/ssh-message-types.rkt +++ b/ssh-message-types.rkt @@ -81,6 +81,16 @@ (else (kf))))) ((_ #f) (lambda (v) (bit-string (if v 1 0)))))) +(define-syntax t:packed-bytes + (syntax-rules () + ((_ #t n) (lambda (input ks kf) + (bit-string-case input + ([ (bs :: binary bytes n) (rest :: binary) ] + (ks (bit-string->bytes bs) rest)) + (else (kf))))) + ((_ #f n) (lambda (bs) + (bit-string (bs :: binary)))))) + (define-syntax t:string (syntax-rules () ((_ #t #:pack) (lambda (input ks kf) @@ -90,6 +100,7 @@ ([ (length :: integer bits 32) (body :: binary bytes length) (rest :: binary) ] (ks body rest)) (else (kf))))) + ((_ #f #:pack) (t:string #f)) ;; #:pack ignored on encoding ((_ #f) (lambda (bs) (bit-string ((bytes-length (bit-string->bytes bs)) :: integer bits 32) (bs :: binary)))))) @@ -119,11 +130,11 @@ (define-for-syntax (codec-options field-type) (syntax-case field-type (byte boolean uint32 uint64 string mpint name-list) (byte #'(integer bits 8)) - ((byte n) #'(binary bytes n)) + ((byte n) #'((t:packed-bytes n))) (boolean #'((t:boolean))) (uint32 #'(integer bits 32)) (uint64 #'(integer bits 64)) - (string #'((t:string))) + (string #'((t:string #:pack))) (mpint #'((t:mpint))) (name-list #'((t:name-list))) (extension #'(binary))))