Browse Source

First version

prototype
Alex Williams 8 months ago
parent
commit
ab40b5e523
Signed by: aw GPG Key ID: 19EE4AAA361A7E2C
7 changed files with 341 additions and 0 deletions
  1. +2
    -0
      .gitignore
  2. +53
    -0
      Makefile
  3. +21
    -0
      integer.l
  4. +149
    -0
      libboawp.l
  5. +12
    -0
      module.l
  6. +81
    -0
      protocols.l
  7. +23
    -0
      string.l

+ 2
- 0
.gitignore View File

@ -0,0 +1,2 @@
.lib/
.modules/

+ 53
- 0
Makefile View File

@ -0,0 +1,53 @@
# picolisp-boawp Makefile
PIL_MODULE_DIR ?= .modules
PIL_SYMLINK_DIR ?= .lib
REPO_PREFIX ?= https://github.com/aw
## Edit below
BUILD_REPO = $(REPO_PREFIX)/pilrust.git
BUILD_DIR = $(PIL_MODULE_DIR)/pilrust/HEAD
BUILD_REF = master
LIB_NAME = libpilrust.so
TARGET = target/release/$(LIB_NAME)
## Edit above
# Unit testing
TEST_REPO = $(REPO_PREFIX)/picolisp-unit.git
TEST_DIR = $(PIL_MODULE_DIR)/picolisp-unit/HEAD
TEST_REF = v3.1.0
# Generic
.PHONY: all clean
all: $(BUILD_DIR) $(BUILD_DIR)/$(TARGET) symlink
$(BUILD_DIR):
mkdir -p $(BUILD_DIR) && \
git clone $(BUILD_REPO) $(BUILD_DIR)
$(TEST_DIR):
mkdir -p $(TEST_DIR) && \
git clone $(TEST_REPO) $(TEST_DIR) && \
cd $(TEST_DIR) && \
git checkout $(TEST_REF)
$(BUILD_DIR)/$(TARGET):
cd $(BUILD_DIR) && \
git checkout $(BUILD_REF) && \
cargo build --release && \
strip --strip-unneeded $(TARGET)
symlink:
mkdir -p $(PIL_SYMLINK_DIR) && \
cd $(PIL_SYMLINK_DIR) && \
ln -sf ../$(BUILD_DIR)/$(TARGET) $(LIB_NAME)
check: all $(TEST_DIR)
clean:
cd $(BUILD_DIR) && \
rm -f $(TARGET) && \
cd - && \
cd $(PIL_SYMLINK_DIR) && \
rm -f $(TARGET)

+ 21
- 0
integer.l View File

@ -0,0 +1,21 @@
### Integer
(de _boawp-list-to-int (Lst)
(let N 0
(for B Lst
(setq N (| B (>> -8 N))) )
N ]
(de _boawp-int-to-list (Int)
(let Iter (size (>> 1 Int))
(link Iter)
(while (gt0 Iter)
(link (& (hex "ff") (>> (* (- Iter 1) 8) Int)))
(dec 'Iter) ]
(de _boawp-twos-complement (Int Size)
(if (lt0 Int)
(+ Int (>> (- Size) 1))
(if (=0 (& Int (>> (- (- Size 1)) 1)))
Int
(- Int (>> (- Size) 1)) ]

+ 149
- 0
libboawp.l View File

@ -0,0 +1,149 @@
# 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-error (Code)
(let Msg (native "@" "strerror" 'S Code)
(setq *Msg (cons Code Msg))
(throw 'stomp-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-decode-headers (Buffer)
(case (length Buffer)
(1 (out 2 (println "Invalid headers length '1'")) (bye 1))
(2 (out 2 (println "Invalid headers length '2'")) (bye 1))
(3 (out 2 (println "Invalid headers length '3'")) (bye 1)) )
(make
(while (> (length Buffer) 3)
(let (Nlength (pop 'Buffer)
Nvalue (cond
((=0 Nlength) (out 2 (println "Invalid header name length")) (bye 1))
((> Nlength > (length Buffer)) (out 2 (println "Invalid header name length")) (bye 1))
((=0 (- (length Buffer) Nlength)) (out 2 (println "Invalid header name value '0'")) (bye 1))
((=1 (- (length Buffer) Nlength)) (out 2 (println "Invalid header name value '1'")) (bye 1))
(T (cut Nlength 'Buffer)) )
Vtype (char (pop 'Buffer))
Vlength (pop 'Buffer)
_Vlengt (when (> Vlength (length Buffer)) (out 2 (println "Invalid header value length")) (bye 1))
Nvalue_str (cond
((and (=1 Nlength) (not (assoc (car Nvalue) *BOAWP_header_names))) (out 2 (println "Unknown header name value")) (bye 1))
((=1 Nlength) (cdr (assoc (car Nvalue) *BOAWP_header_names)))
(T (_boawp-ascii-str Nvalue)) )
_Vtype (and (> Vlength 0) (or (= "n" Vtype) (= "t" Vtype) (= "f" Vtype)) (out 2 (println "Invalid header value length " Vlength " for type " Vtype)) (bye 1))
Hvalue (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 (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 (out 2 (println "Unknown header value type")) (bye 1))
) ) )
(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)) (out 2 (println "Unknown command")) (bye 1))
((not (assoc Command *BOAWP_commands)) (out 2 (println "Unknown command")) (bye 1))
((and (= 10 Command) (=0 Hlength) (=0 Blength)) T)
((= 10 Command) (out 2 (println "Invalid NOOP frame")) (bye 1))
(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)
(out 2 (println "Invalid protocol init string"))
(bye 1)
]
(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 (mapcar char (chop (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 (mapcar char (chop (; 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
]

+ 12
- 0
module.l View File

@ -0,0 +1,12 @@
[de MODULE_INFO
("name" "picolisp-boawp")
("version" "0.1.0")
("summary" "BOAWP encoder/decoder ffi-bindings for PicoLisp")
("source" "https://github.com/aw/picolisp-boawp.git")
("author" "Alexander Williams")
("license" "MIT")
("copyright" "(c) 2020~ Alexander Williams, On-Prem <license@on-premises.com>")
("install" "make")
("requires"
("picolisp-unit" "v3.1.0" "https://github.com/aw/picolisp-unit.git")
("pilrust" "master" "https://github.com/aw/pilrust.git") ]

+ 81
- 0
protocols.l View File

@ -0,0 +1,81 @@
### Protocols
(setq *BOAWP_commands
# BOAWP
'((10 . "NOOP") # \n
(33 . "ERROR") # !
# HTTP
(97 . "GET")
(98 . "HEAD")
(99 . "POST")
(100 . "PUT")
(101 . "DELETE")
(102 . "CONNECT")
(103 . "OPTIONS")
(104 . "TRACE")
(105 . "PATCH")
) )
(setq *BOAWP_header_names
# BOAWP
'((32 . "noop")
(65 . "protocol")
(66 . "max-headers")
(67 . "max-body")
(68 . "max-value")
(69 . "max-int")
(70 . "null")
(71 . "true")
(72 . "false")
(73 . "accept-version")
(74 . "content-type")
(75 . "content-encoding")
(76 . "date")
(77 . "host")
(78 . "keepalive")
(79 . "server")
(80 . "timestamp")
(81 . "user-agent")
# HTTP
(82 . "accept-charset")
(83 . "accept-encoding")
(84 . "accept-language")
(85 . "accept-ranges")
(86 . "accept")
(87 . "access-control-allow-origin")
(88 . "age")
(89 . "allow")
(90 . "authorization")
(48 . "cache-control")
(49 . "content-disposition")
(50 . "content-language")
(51 . "content-length")
(52 . "content-location")
(53 . "content-range")
(54 . "cookie")
(55 . "etag")
(56 . "expect")
(57 . "expires")
(97 . "from")
(98 . "if-match")
(99 . "if-modified-since")
(100 . "if-none-match")
(101 . "if-range")
(102 . "if-unmodified-since")
(103 . "last-modified")
(104 . "link")
(105 . "location")
(106 . "max-forwards")
(107 . "proxy-authenticate")
(108 . "proxy-authorization")
(109 . "range")
(110 . "referer")
(111 . "refresh")
(112 . "retry-after")
(113 . "set-cookie")
(114 . "strict-transport-security")
(115 . "transfer-encoding")
(116 . "vary")
(117 . "via")
(118 . "www-authenticate")
) )

+ 23
- 0
string.l View File

@ -0,0 +1,23 @@
### String
(de _boawp-utf8-str (Str)
(if (lst? Str)
(let P (native "@" "malloc" 'N (length Str))
(eval (append '(struct P NIL) Str (0))) # always add a terminating null byte
(if (=0 (native ".lib/libpilrust.so" "validate_utf8" 'I P))
(let Res (struct P 'S)
(native "@" "free" NIL P)
Res )
(out 2 (println "Invalid UTF-8 string"))
(bye 1) ) )
(if (=0 (native ".lib/libpilrust.so" "validate_utf8" 'I Str))
Str
(out 2 (println "Invalid UTF-8 string"))
(bye 1) ]
(de _boawp-ascii-str (Buffer)
(pack (mapcar '((S) (if (member S (range 33 126))
(char S)
(out 2 (println "Invalid header name ASCII encoding"))
(bye 1) ) )
Buffer) ]

Loading…
Cancel
Save