PicoLisp implementation of the BOAWP specification https://boawp.org
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

162 lines
5.5 KiB

# PicoLisp BOAWP library
(load "protocols.l" "integer.l" "string.l")
(setq *BOAWP_MAX_INT 64)
# FIXME: don't output & exit when there's an error decoding or encoding
###
(de _boawp-err (Msg)
(setq *Msg Msg)
(out 2 (prinl Msg))
(throw 'boawp-error Msg) ]
(de _boawp-error (Code)
(let Msg (native "@" "strerror" 'S Code)
(setq *Msg (cons Code Msg))
(throw 'boawp-error Msg) ]
(de _boawp-read (Fd Num)
(default Num 1)
(use Buf
(when (= -1 (native "@" "read" 'N Fd (list 'Buf (cons Num 'B Num)) Num))
(_boawp-error (errno)) )
Buf ]
### Decoder
(de _boawp-get-hvalue (Nvalue Vlength Vtype)
(if (= 32 (car Nvalue))
(let Buf (cut Vlength 'Buffer) NIL)
(case Vtype
("n" 'null)
("t" 'true)
("f" 'false)
("i" (let Buf (cut Vlength 'Buffer) (_boawp-twos-complement (_boawp-list-to-int Buf) (* 8 (+ 1 (length Buf))))))
("s" (let Buf (cut Vlength 'Buffer) (_boawp-utf8-str Buf)))
("b" (cut Vlength 'Buffer))
("h" (let Buf (cut Vlength 'Buffer) (boawp-decode-headers Buf)))
(T (_boawp-err "Unknown header value type"))
) ]
(de _boawp-get-nvalue-str (Nlength Nvalue)
(cond
((and (=1 Nlength) (not (assoc (car Nvalue) *BOAWP_header_names))) (_boawp-err "Unknown header name value"))
((=1 Nlength) (cdr (assoc (car Nvalue) *BOAWP_header_names)))
(T (_boawp-ascii-str Nvalue)) ]
(de _boawp-get-nvalue (Nlength)
(cond
((=0 Nlength) (_boawp-err "Invalid header name length"))
((> Nlength > (length Buffer)) (_boawp-err "Invalid header name length"))
((=0 (- (length Buffer) Nlength)) (_boawp-err "Invalid header name value '0'"))
((=1 (- (length Buffer) Nlength)) (_boawp-err "Invalid header name value '1'"))
(T (cut Nlength 'Buffer)) ]
(de boawp-decode-headers (Buffer)
(case (length Buffer)
(1 (_boawp-err "Invalid headers length '1'"))
(2 (_boawp-err "Invalid headers length '2'"))
(3 (_boawp-err "Invalid headers length '3'")) )
(make
(while (> (length Buffer) 3)
(let (Nlength (pop 'Buffer)
Nvalue (_boawp-get-nvalue Nlength)
Vtype (char (pop 'Buffer))
Vlength (pop 'Buffer)
_Vlengt (when (> Vlength (length Buffer)) (_boawp-err "Invalid header value length"))
Nvalue_str (_boawp-get-nvalue-str Nlength Nvalue)
_Vtype (and (> Vlength 0) (or (= "n" Vtype) (= "t" Vtype) (= "f" Vtype)) (_boawp-err "Invalid header value length " Vlength " for type " Vtype))
Hvalue (_boawp-get-hvalue Nvalue Vlength Vtype) )
(unless (and (=1 Nlength) (= 32 (car Nvalue)))
(link (cons Nvalue_str Hvalue)) ]
(de boawp-decode-fixed-header (Fd)
(let (Cmd (_boawp-read Fd 2)
Command (cadr Cmd)
Hlength (let Buf (_boawp-read Fd 2) (_boawp-list-to-int Buf))
Blength (let Buf (_boawp-read Fd 4) (_boawp-list-to-int Buf)) )
(cond
((n0 (car Cmd)) (_boawp-err "Unknown command"))
((not (assoc Command *BOAWP_commands)) (_boawp-err "Unknown command"))
((and (= 10 Command) (=0 Hlength) (=0 Blength)) T)
((= 10 Command) (_boawp-err "Invalid NOOP frame"))
(T T) )
(list (cdr (assoc Command *BOAWP_commands)) Hlength Blength)
]
(de boawp-decode-frame (Fd)
(use Fixed Headers Body
# fixed header
(setq Fixed (boawp-decode-fixed-header Fd))
# frame headers
(when (> (cadr Fixed) 0)
(let Data (_boawp-read Fd (cadr Fixed))
(setq Headers (boawp-decode-headers Data)) ) )
# body
(when (> (caddr Fixed) 0)
(setq Body (_boawp-read Fd (caddr Fixed))) )
(list Fixed Headers Body)
]
(de boawp-decode-init (Fd)
(let Init (_boawp-read Fd 4)
(if (= (66 48 65 10) Init)
(mapcar char Init)
(_boawp-err "Invalid protocol init string")) ]
(de boawp-validate (Fd)
(use Init Frame
# protocol init
(setq Init (boawp-decode-init Fd))
# frame
(setq Frame (boawp-decode-frame Fd))
(append (list Init) Frame)
]
### Encoder
(de boawp-encode-headers (Headers)
(mapcan '((S) (make
(if (rassoc (car S) *BOAWP_header_names)
(link 1 (car @))
(link (length (car S)))
(chain (mapcar char (chop (car S)))) )
(cond
((= NIL (cdr S)) (link (char "s") 0))
((= 'null (cdr S)) (link (char "n") 0))
((= 'true (cdr S)) (link (char "t") 0))
((= 'false (cdr S)) (link (char "f") 0))
((num? (cdr S)) (link (char "i")) (_boawp-int-to-list (_boawp-twos-complement (cdr S) *BOAWP_MAX_INT)))
((and (lst? (cdr S)) (lst? (cadr S))) (link (char "h")) (let H (boawp-encode-headers (cdr S)) (link (length H)) (chain H)))
((lst? (cdr S)) (link (char "b") (size (cdr S))) (chain (cdr S)))
((str? (cdr S)) (link (char "s") (size (cdr S))) (chain (_boawp-utf8-list (cdr S))))
) ) )
Headers )
]
(de boawp-encode (Data)
(let (Init (car Data)
Cmd (list (car (; Data 2)) (car (rassoc (cadr (; Data 2)) *BOAWP_commands)))
Headers_encoded (boawp-encode-headers (; Data 3))
Body_encoded (_boawp-utf8-list (; Data 4))
HLength (length Headers_encoded)
BLength (length Body_encoded)
)
(append
Init
Cmd
(need 2 (cdr (make (_boawp-int-to-list HLength))) 0)
(need 4 (cdr (make (_boawp-int-to-list BLength))) 0)
Headers_encoded
Body_encoded
]