Browse Source

Initial implementation

master
Alex Williams 8 months ago
parent
commit
7a858079c2
Signed by: aw GPG Key ID: 19EE4AAA361A7E2C
5 changed files with 215 additions and 0 deletions
  1. +2
    -0
      .gitignore
  2. +36
    -0
      Makefile
  3. +52
    -0
      client.l
  4. +10
    -0
      module.l
  5. +115
    -0
      server.l

+ 2
- 0
.gitignore View File

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

+ 36
- 0
Makefile View File

@ -0,0 +1,36 @@
# boawp-poc - https://github.com/boawp/boawp-poc
#
# Makefile for unit and integration tests
PIL_MODULE_DIR ?= .modules
PIL_SYMLINK_DIR ?= .lib
REPO_PREFIX ?= https://github.com/boawp
# BOAWP
BOAWP_REPO = $(REPO_PREFIX)/picolisp-boawp.git
BOAWP_DIR = $(PIL_MODULE_DIR)/picolisp-boawp/HEAD
BOAWP_REF = prototype
BOAWP_LIB = libpilrust.so
BOAWP_TARGET = .lib/$(BOAWP_LIB)
# Generic
.PHONY: check clean symlink
all: check symlink
$(BOAWP_DIR):
mkdir -p $(BOAWP_DIR) && \
git clone $(BOAWP_REPO) $(BOAWP_DIR) && \
cd $(BOAWP_DIR) && \
git checkout $(BOAWP_REF) && \
$(MAKE) all
symlink:
mkdir -p $(PIL_SYMLINK_DIR) && \
cd $(PIL_SYMLINK_DIR) && \
ln -sf ../$(BOAWP_DIR)/$(BOAWP_TARGET) $(BOAWP_LIB)
check: $(BOAWP_DIR)
clean:
rm -rf $(BOAWP_DIR) $(PIL_SYMLINK_DIR)

+ 52
- 0
client.l View File

@ -0,0 +1,52 @@
#!/usr/bin/env pil
#
# BOAWP proof-of-concept client
#
# Usage: ./client.l <host> <port>
(if (= 3 (length (argv)))
(and
(setq *Host (opt))
(setq *Port (format (opt)))
(setq *Uri (opt)) )
(out 2 (prinl "Usage: client.l <host> <port> <uri>"))
(bye 1) )
(chdir ".modules/picolisp-boawp/HEAD"
(load "libboawp.l") )
(de poc-boawp-connect ()
(let Fd (connect *Host *Port)
(if Fd
(prog
(poc-boawp-send Fd)
(poc-boawp-receive Fd) )
(out 2 (prinl "Could not connect to " *Host " on port " *Port))
(bye 1) ]
(de poc-boawp-send (Fd)
(let (Msg
(list
(list (char "B") (char "0") (char "A") (char "^J")) # "B0A\n"
(list 0 "GET")
(list (cons "protocol" "GEMINI") (cons "path" *Uri)) )
Encoded (boawp-encode Msg) )
(out Fd (apply wr Encoded)) ]
(de poc-boawp-receive (Fd)
(catch 'boawp-error
(let Res (boawp-validate Fd)
# TODO: validate the response
(println "Received response: " Res)
(let P (native "@" "malloc" 'N (last (cadr Res)))
(eval (append '(struct P NIL) (last Res) (0)))
(if (=0 (native ".lib/libpilrust.so" "validate_utf8" 'I P))
(let Res (struct P 'S)
(native "@" "free" NIL P)
(prinl Res) )
(println (last Res)) ]
(poc-boawp-connect)
(bye)

+ 10
- 0
module.l View File

@ -0,0 +1,10 @@
[de APP_INFO
("name" "boawp-poc")
("version" "0.1.0")
("summary" "Proof-of-Concept BOAWP client/server implementation in PicoLisp")
("source" "https://github.com/boawp/boawp-poc")
("author" "Alexander Williams")
("license" "MIT")
("copyright" "(c) 2020 Alexander Williams, On-Prem <license@on-premises.com>")
("requires"
("picolisp-boawp" "prototype" "https://github.com/boawp/picolisp-boawp.git") ]

+ 115
- 0
server.l View File

@ -0,0 +1,115 @@
#!/usr/bin/env pil
#
# BOAWP proof-of-concept server
#
# Usage: ./server.l <port> <dir>
(setq
*BOAWP_DEFAULT_ENCODING "UTF-8"
*BOAWP_DEFAULT_PROTOCOL "GEMINI"
*BOAWP_DEFAULT_FORMAT "text/gemini"
*BOAWP_DEFAULT_FILE "/index.gmi" )
(if (= 2 (length (argv)))
(and
(setq *Port (format (opt)))
(setq *Dir (opt)) )
(out 2 (prinl "Usage: server.l <port> <dir>"))
(bye 1) )
(chdir ".modules/picolisp-boawp/HEAD"
(load "libboawp.l") )
(de poc-boawp-listen ()
(prinl "[parent]=" *Pid " started")
(use (*Portsock *Sock)
(setq *Portsock (port *Port))
(finally
(poc-boawp-cleanup)
(poc-boawp-listen-loop)
(finally
(poc-boawp-child-exit)
(poc-boawp-child)
(bye) ]
(de poc-boawp-cleanup ()
(prinl "[parent]=" *Pid " exiting") ]
(de poc-boawp-listen-loop ()
(loop
(setq *Sock (listen *Portsock))
(NIL (fork) (close *Portsock))
(close *Sock) ]
(de poc-boawp-child-exit ()
(prinl "[child]=" *Pid " exiting") ]
(de poc-boawp-child ()
(prinl "[child]=" *Pid " [parent]=" *PPid " received connection")
(catch 'boawp-error
(finally (when *Msg (poc-boawp-error))
(poc-boawp-validate) ]
(de poc-boawp-validate ()
(let Res (boawp-validate *Sock)
(if (= *BOAWP_DEFAULT_PROTOCOL (cdr (assoc "protocol" (; Res 3))))
(let Data (poc-boawp-data (; Res 3))
(println "Received request: " Res)
(if Data
(poc-boawp-ok Data)
(poc-boawp-error 51 "Not Found") ) )
(setq *Msg "Invalid protocol")
(poc-boawp-error) ) )
(bye) ]
(de poc-boawp-data (Headers)
(let Path (assoc "path" Headers)
(when Path
(let Fullpath (poc-validate-path (cdr Path))
(when (info Fullpath) Fullpath) ]
(de poc-validate-path (Path)
(let (File (let Dir (chop Path) (pack (unless (= "/" (car Dir)) "/") Dir))
Newdir (in (list 'realpath "-s" "-e" *Dir) (line T))
Newfile (in (list 'realpath "-s" "-e" (pack *Dir File)) (line T)) )
(when (pre? Newdir Newfile) # disallow invalid path traversal
(if (=T (car (info Newfile)))
(pack Newfile *BOAWP_DEFAULT_FILE)
Newfile) ]
(de poc-boawp-ok (File)
(let (Filetype (in (list 'file "-b" "--mime-type" File) (till NIL T))
Response
(list
(list (char "B") (char "0") (char "A") (char "^J")) # "B0A\n"
(list 0 "OK")
(list (cons "status" 20) (cons "content-type" (poc-boawp-mimetype File)))
(in File (till NIL T)) )
Encoded (boawp-encode Response) )
(out *Sock (apply wr Encoded) ]
(de poc-boawp-mimetype (File)
(let Chopped (chop File)
(cond
((= '("g" "m" "i") (tail 3 Chopped)) "text/gemini")
((= '("m" "d") (tail 2 Chopped)) "text/markdown")
(T (in (list 'file "-b" "--mime-type" File) (line T))) ]
(de poc-boawp-error (Code Msg)
(default Code 59 Msg *Msg)
(let (Response
(list
(list (char "B") (char "0") (char "A") (char "^J")) # "B0A\n"
(list 0 "ERROR")
(list (cons "protocol" *BOAWP_DEFAULT_PROTOCOL) (cons "status" Code) (cons "content-type" *BOAWP_DEFAULT_FORMAT))
Msg )
Encoded (boawp-encode Response) )
(out *Sock (apply wr Encoded) ]
(poc-boawp-listen)
(bye)

Loading…
Cancel
Save