Proof-of-Concept BOAWP client/server implementation in PicoLisp 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.
 
 

118 lines
3.4 KiB

#!/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") )
(setq *BOAWP_commands (append *BOAWP_default_commands *BOAWP_gemini_commands))
(setq *BOAWP_header_names (append *BOAWP_default_header_names *BOAWP_gemini_header_names))
(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))
Msg )
Encoded (boawp-encode Response) )
(out *Sock (apply wr Encoded) ]
(poc-boawp-listen)
(bye)