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

Pack decoded messages for the benefit of unify.rkt.

This commit is contained in:
Tony Garnock-Jones 2012-06-11 12:24:57 -04:00
parent 0fb207acc6
commit e2e59bdf6c
1 changed files with 13 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
ssh-message-types.rkt
View File

@ -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))))