http.l

@lib/http.l is the HTTP server library behind every PicoLisp web application. It accepts connections, forks a process per session, parses requests, dispatches URLs to Lisp functions or files, and writes responses. I first studied the 2016 version. This page now walks through the version in pil21 26.9 (dated 06aug26, 487 lines) and reproduces it in full below.

The shape of a PicoLisp web server

(load "@lib/http.l" "@lib/xhtml.l")

(allowed () "!work")

(de work ()
   (html 0 "Hello" NIL NIL
      (<h1> NIL "Hello from PicoLisp")
      (<p> NIL "Time is " (ht:Prin (tim$ (time) T))) ) )

(server 8080 "!work")

Run it with pil hello.l -wait (or + to debug) and open http://localhost:8080. I tested this on 26.9. Note that inside HTML functions literal strings are printed, but computed values must be printed explicitly with ht:Prin, which also escapes them. Key pieces:

• (server Port Url) opens the port, then loops on listen. For every connection it forks; the child handles the request. If the app creates a session, the child opens its own port (*SesId, the number you see in session URLs) and keeps talking to that one browser. That is the same fork-per-client pattern as the Chat program.
• URLs. !fun calls the Lisp function fun. Plain paths serve files (with MIME types from *Mimes). Arguments after ? are passed to the function, and arguments named *Var set that global, but only if it was allowed.
• Security. Only functions and files you list with (allowed ...) or allow can be reached. Everything else gives 403/404 (forbidden, http404).
• Responses. httpHead, httpEcho, respond, redirect, noContent and http404 write responses; ht.so (built from src/ht.l) speeds up HTML escaping and chunked output.
• (retire Min) makes the parent exit after the last session has been idle for Min minutes, so httpGate can restart it on demand.
• client is the matching HTTP client: (client "host" 80 "path" (while (line) (println @))).
• psh connects a terminal REPL to a running server’s session (bin/psh), which is a great debugging trick.

What changed since the 2016 version

• Namespace hygiene: internal helpers are declared with (private), so they don’t leak into your program.
• *Uri (the raw request URI) and *Retire were added; *SesAdr is gone.
• A clearer “Not Implemented” response (2026).
• HTTPS is still terminated outside (by httpGate or a reverse proxy), not inside http.l.

For HTML, see @lib/xhtml.l. For forms with server-side state, see @lib/form.l and Application Development. A complete example is The Health Application.

The source (pil21 26.9, lib/http.l)

# 06aug26 Software Lab. Alexander Burger

# *HPorts *Home *Gate *Host *Port *Port1 *Port% *Http1 *Chunked
# *Sock *Agent *ContL *ContLen *MPartLim *MPartEnd "*HtSet"
# *Post *Uri *Url *Timeout *SesId *ConId *Retire
# *Referer *Cookies "*Cookies"

(default
   *HPorts 0
   *Timeout (* 300 1000) )

(private) (Host Port Sock How Prg)

(mapc allow '(*Adr *Gate *Cipher *Host *ContL))

(zero *Http1)

(de *Mimes
   (`(chop "html") "text/html; charset=utf-8")
   (`(chop "svg") "image/svg+xml; charset=utf-8")
   (`(chop "au") "audio/basic" 3600)
   (`(chop "wav") "audio/x-wav" 3600)
   (`(chop "mp3") "audio/x-mpeg" 3600)
   (`(chop "mp4") "video/mp4" 3600)
   (`(chop "gif") "image/gif" 3600)
   (`(chop "tif") "image/tiff" 3600)
   (`(chop "tiff") "image/tiff" 3600)
   (`(chop "bmp") "image/bmp" 86400)
   (`(chop "png") "image/png" 86400)
   (`(chop "jpg") "image/jpeg" 3600)
   (`(chop "jpeg") "image/jpeg" 3600)
   (`(chop "txt") "text/octet-stream" 1 T)
   (`(chop "csv") "text/csv; charset=utf-8" 1 T)
   (`(chop "css") "text/css" 86400)
   (`(chop "js") "application/x-javascript" 86400)
   (`(chop "ps") "application/postscript" 1)
   (`(chop "pdf") "application/pdf" 1)
   (`(chop "epub") "application/epub+zip" 86400)
   (`(chop "zip") "application/zip" 1)
   (`(chop "apk") "application/vnd.android.package-archive" 1)
   (`(chop "jar") "application/java-archive" 86400) )

(de mime (S . @)
   (let L (chop S)
      (if (assoc L *Mimes)
         (con @ (rest))
         (push '*Mimes (cons L (rest))) ) ) )

(de mimetype (File Typ)
   (in (list 'file "-b" (if Typ "--mime-type" "--mime") File)
      (line T) ) )

### HTTP-Client ###
(de client (Host Port How . Prg)
   (let? Sock (connect Host Port)
      (prog1
         (out Sock
            (if (atom How)
               (prinl "GET /" How " HTTP/1.0\r")
               (prinl "POST /" (car How) " HTTP/1.0\r")
               (prinl "Content-Length: " (size (cdr How)) "\r") )
            (prinl "User-Agent: PicoLisp\r")
            (prinl "Host: " Host "\r")
            (prinl "Accept-Charset: utf-8\r")
            (prinl "\r")
            (and (pair How) (prin (cdr @)))
            (flush)
            (in Sock (run Prg 1)) )
         (close Sock) ) ) )

# Local Password
(de pw (N)
   (if N
      (out "~/.pil/pw"
         (prinl (in "/dev/urandom" (rd N))) )
      (in "~/.pil/pw"
         (line T) ) ) )

# PicoLisp Shell
(de psh (Pw Tty Term)
   (cond
      ((not Pw) (println *Port) (bye))
      ((<> Pw (pw)) (quit "Bad pw"))
      ((ctty Tty)
         (sys "TERM" Term)
         (or *SesId (off *Run))
         (println *Pid)
         (unless *Dbg
            (on *Dbg)
            (symbols '(pico)
               (and (info "~/.pil/rc") (load @@))
               (load "@lib/lint.l" "@lib/debug.l" "@lib/vip.l" "@lib/sq.l") ) )
         (load "@lib/too.l")
         (off *Err)
         (quit) ) ) )

### HTTP-Server ###
(de -server ()
   (server (format (opt)) (opt)) )

(de server (Port Home Flg)
   (setq
      *Port Port
      *Port1 (or (sys "NAME") Port)
      *Home (cons Home (chop Home))
      Port (port *Port) )
   (gc)
   (loop
      (setq *Sock (listen Port))
      (T Flg
         (task Port
            (when (accept @)
               (task @ (let *SesId NIL (http @))) ) ) )
      (NIL (fork) (close Port))
      (close *Sock) )
   (task *Sock (http @))
   (http *Sock)
   (or *SesId (bye))
   (task *Sock
      (when (accept @)
         (task @ (http @)) ) ) )

(de retire (Min . Prg)
   (when (sys "PORT")
      (task -60000 60000  X (cons Min Min Prg)
         (cond
            (*Adr (off *Adr) (set X (cadr X)))
            ((diff (kids) *Retire) (set X (cadr X)))
            ((=0 (dec X)) (run (cddr X)) (bye)) ) ) ) )

(de baseHRef (Port . @)
   (pass pack
      (or *Gate "http") "://" *Host
      (if *Gate "/" ":")
      (or Port (if *SesId *Port *Port1))
      "/" ) )

(de https @
   (pass pack "https://" *Host "/" *Port "/" *SesId) )

(de ext.html (Sym)
   (pack (ht:Fmt Sym) ".html") )

(de disallowed ()
   (and
      *Allow
      (not (idx *Allow *Url))
      (or
         (sub? ".." *Url)
         (not (find pre? (cdr *Allow) *Url)) ) ) )

(de notAllowed (X)
   (unless (= X "favicon.ico")
      (msg X " [" *Adr "] not allowed") ) )

# Application startup
(de app ()
   (unless *SesId
      (setq
         *SesId (pack (in "/dev/urandom" (rd 7)) "~")
         *Sock (port *HPorts '*Port)
         *Port% (not *Gate) )
      (timeout *Timeout)
      (out 2 (prinl *Pid " = " *Port " " *SesId)) ) )

# Set a cookie
(de cookie @
   (let A (next)
      (if (assoc A "*Cookies")
         (con @ (rest))
         (push '"*Cookies" (cons A (rest))) ) ) )

# Handle HTTP-Transaction
(de http (*HtSock)
   (use (*Post U L @X)
      (off *Post *Port% *ContL *ContLen *Cookies "*Cookies" "*HtSet")
      (catch 'http
         (in *HtSock
            (finally (alarm 0)
               (case
                  (prog2
                     (alarm 2 (throw 'http))
                     (till " " T)
                     (alarm 1200 (throw 'http)) )
                  ("GET" (_htHead))
                  ("POST"
                     (on *Post)
                     (off *MPartLim *MPartEnd)
                     (_htHead)
                     (cond
                        (*MPartLim (_htMultipart))
                        ((=0 *ContLen))
                        ((cond (*ContL (line)) (*ContLen (ht:Read @)))
                           (for L (split @ '&)
                              (when (setq L (split L "="))
                                 (let? S (_htSet (car L) (ht:Pack (cadr L) T))
                                    (and
                                       (cddr L)
                                       (format (car @))
                                       (unless (out (tmp S) (echo @))
                                          (%@ "unlink" NIL (tmp S)) ) ) ) ) ) )
                        (T (throw 'http)) ) )
                  (T
                     (when @
                        (out *HtSock
                           (httpStat 501 (text "HTTP @1: Not Implemented" @)) ) )
                     (task (close *HtSock))
                     (off *HtSock)
                     (throw 'http) ) ) )
            (if (<> *ConId *SesId)
               (prog (task (close *HtSock)) (off *HtSock))
               (setq
                  L (split (setq *Uri U) "?")
                  U (car L)
                  L (mapcan
                     '((A)
                        (cond
                           ((cdr (setq A (split A "=")))
                              (nil (_htSet (car A) (htArg (cadr A)))) )
                           ((tail '`(chop ".html") (car A))
                              (cons (pack (car A))) )
                           (T (cons (htArg (car A)))) ) )
                     (split (cadr L) "&") ) )
               (unless (setq *Url (ht:Pack U T))
                  (setq  *Url (car *Home)  U (cdr *Home)) )
               (out *HtSock
                  (cond
                     ((match '("-" @X "." "h" "t" "m" "l") U)
                        (and *SesId (timeout *Timeout))
                        (apply try L 'html> (extern (ht:Pack @X T))) )
                     ((disallowed)
                        (notAllowed *Url)
                        (http404) )
                     ((= "!" (car U))
                        (and *SesId (timeout *Timeout))
                        (apply (val (intern (ht:Pack (cdr U) T))) L) )
                     ((head '("%" "2" "1") U)
                        (and *SesId (timeout *Timeout))
                        (apply (val (intern (ht:Pack (cdddr U) T))) L) )
                     ((tail '("." "l") U)
                        (and *SesId (timeout *Timeout))
                        (apply script L *Url) )
                     ((=T (car (info *Url)))
                        (if (info (setq *Url (pack *Url "/default")))
                           (apply script L *Url)
                           (http404) ) )
                     ((assoc (stem U ".") *Mimes)
                        (apply httpEcho (cdr @) *Url) )
                     (T (httpEcho *Url "application/octet-stream" 1 T)) ) ) ) ) )
      (and *HtSock (=0 *Http1) (task (close *HtSock))) ) )

(de _htHead ()
   (unless
      (and
         (char)
         (= "/" (char))
         (prog (setq U (till " ")) (char))
         (= "HTTP/1" (till "." T))
         (char)
         (setq *Http1 (format (line T))) )
      (task (close *HtSock))
      (off *HtSock)
      (throw 'http) )
   (setq *Chunked (gt0 *Http1))
   (if (index "~" U)
      (setq
         *ConId (head @ U)
         U (cdr (nth U @))
         *ConId (pack (if (member "/" *ConId) (cdr @) *ConId)) )
      (off *ConId) )
   (while
      (case (lowc (till " \r\n" T))
         ("host:" (setq *Host (cdr (line))))
         ("referer:" (setq *Referer (cdr (line))))
         ("cookie:"
            (setq *Cookies
               (mapcar
                  '((L)
                     (setq L (split L "="))
                     (cons (htArg (clip (car L))) (htArg (cadr L))) )
                  (split (cdr (line)) ";") ) ) )
         ("user-agent:" (setq *Agent (cdr (line))))
         ("content-length:" (setq *ContLen (format (cdr (line)))))
         ("content-type:"
            (if (= " multipart/form-data; boundary" (lowc (till "=\r\n" T)))
               (setq
                  *MPartLim (append '(- -) (cdr (line)))
                  *MPartEnd (append *MPartLim '(- -)) )
               (line) ) )
         ("x-pil:"
            (for (L (split (cdr (line)) "," "=")  L)
               (_htSet (++ L) (ht:Pack (++ L) T)) ) )
         (T (if (eol) (char) (line T))) ) )
   (unless *Gate
      (and (member ":" *Host) (con (prior @ *Host))) ) )

# rfc1867 multipart/form-data
(de _htMultipart ()
   (use Var
      (let L (line)
         (while (= *MPartLim L)
            (unless (= "content-disposition: form-data; name=" (lowc (till "\"" T)))
               (line)
               (throw 'http) )
            (char)
            (setq Var (till "\""))
            (char)
            (nond
               ((line)
                  (while (line))
                  (_htSet Var
                     (pack
                        (make
                           (until
                              (or
                                 (= *MPartLim (setq L (line)))
                                 (= *MPartEnd L) )
                              (when (eof)
                                 (throw 'http) )
                              (when (made)
                                 (link "\n") )
                              (link (trim L)) ) ) ) ) )
               ((head '`(chop "; filename=") (setq L @))
                  (while (line)) )
               (NIL
                  (while (line))
                  (setq L (cdr (rot (nth L 13))))
                  (if (_htSet Var (pack (stem L "/" "\\")))
                     (let F (tmp @)
                        (unless (out F (echo (pack "\r\n" *MPartLim)))
                           (%@ "unlink" NIL F) ) )
                     (out "/dev/null" (echo (pack "\r\n" *MPartLim))) )
                  (setq L (if (= "-" (car (line))) *MPartEnd *MPartLim)) ) ) ) ) ) )

(de _htSet (L Val)
   (let "Var" (intern (ht:Pack (car (setq L (split L ":"))) T))
      (cond
         ((and *Allow (not (idx *Allow "Var")))
            (notAllowed "Var")
            (throw 'http) )
         ((cadr L)
            (let? N (format (car (setq L (split @ "."))))
               (case (caadr L)
                  ("x" (setq Val (cons (format Val))))
                  ("y" (setq Val (cons NIL (format Val)))) )
               (nond
                  ((memq "Var" "*HtSet")
                     (push '"*HtSet" "Var")
                     (set "Var" (cons (cons N Val)))
                     Val )
                  ((assoc N (val "Var"))
                     (queue "Var" (cons N Val))
                     Val )
                  (NIL
                     (let X @
                        (cond
                           ((nand (cadr L) (cdr X)) (con X Val))
                           ((car Val) (set (cdr X) @))
                           (T (con (cdr X) (cdr Val))) ) ) ) ) ) )
         (T
            (if (= "*" (caar L))
               (set "Var" Val)
               (put "Var" 'http Val) ) ) ) ) )

(de htArg (Lst)
   (case (car Lst)
      ("$" (intern (ht:Pack (cdr Lst) T)))
      ("+" (format (cdr Lst)))
      ("-" (extern (ht:Pack (cdr Lst) T)))
      ("_" (mapcar htArg (split (cdr Lst) "_")))
      (T (ht:Pack Lst T)) ) )

# Http Transfer Header
(de http1 (Typ Upd File Att)
   (prinl "HTTP/1." *Http1 " 200 OK\r")
   (prinl "Server: PicoLisp\r")
   (prin "Date: ")
   (httpDate (date T) (time T))
   (when Upd
      (prinl "Cache-Control: max-age=" Upd "\r")
      (when (=0 Upd)
         (prinl "Cache-Control: no-store\r") ) )
   (prinl "Content-Type: " (or Typ "text/html; charset=utf-8") "\r")
   (when File
      (prinl
         "Content-Disposition: "
         (if Att "attachment" "inline")
         "; filename=\"" File "\"\r" ) ) )

(de httpCookies ()
   (mapc
      '((L)
         (prin "Set-Cookie: "
            (ht:Fmt (++ L)) "=" (ht:Fmt (++ L))
            "; path=" (or (++ L) "/") )
         (and (++ L) (prin "; expires=" @))
         (and (++ L) (prin "; domain=" @))
         (and (++ L) (prin "; secure"))
         (and (++ L) (prin "; HttpOnly"))
         (prinl) )
      "*Cookies" ) )

(de respond (S)
   (http1 "application/octet-stream" 0)
   (prinl "Content-Length: " (size S) "\r\n\r")
   (prin S) )

(de httpHead (Typ Upd File Att)
   (http1 Typ Upd File Att)
   (and *Chunked (prinl "Transfer-Encoding: chunked\r"))
   (httpCookies)
   (prinl "\r") )

(de httpDate (Dat Tim)
   (let D (date Dat)
      (prinl
         (day Dat *Day) ", "
         (pad 2 (caddr D)) " "
         (get *Mon (cadr D)) " "
         (car D) " "
         (tim$ Tim T) " GMT\r" ) ) )

# Http Echo
(de httpEcho (File Typ Upd Att Name)
   (and *Tmp (pre? *Tmp File) (one Upd))
   (ifn (info File)
      (http404)
      (let I @
         (http1
            (or Typ (mimetype File))
            Upd
            (or Name (stem (chop File) "/"))
            Att )
         (prinl "Content-Length: " (car I) "\r")
         (prin "Last-Modified: ")
         (httpDate (cadr I) (cddr I))
         (prinl "\r")
         (in File (echo)) ) ) )

(de srcUrl (Url)
   (if (or (pre? "http:" Url) (pre? "https:" Url))
      Url
      (baseHRef *Port1 Url) ) )

(de sesId (Url)
   (if
      (or
         (pre? "http:" Url)
         (pre? "https:" Url)
         (pre? "mailto:" Url)
         (pre? "javascript:" Url)
         (pre? "tel:" Url) )
      Url
      (pack *SesId Url) ) )

(de httpStat (N X . @)
   (let B (fin X)
      (if (pair X)
         (setq X (car X))
         (setq B (pack "<H1>" B "</H1>")) )
      (prinl "HTTP/1." *Http1 " " N " " X "\r")
      (prinl "Server: PicoLisp\r")
      (while (args)
         (prinl (next) "\r") )
      (prinl "Content-Type: text/html\r")
      (httpCookies)
      (prinl "Content-Length: " (+ 59 (length N) (length X) (length B)) "\r")
      (prinl "\r")
      (prinl "<HTML>")
      (prinl "<HEAD><TITLE>" N " " X "</TITLE></HEAD>")
      (prinl "<BODY>" B "</BODY>")
      (prinl "</HTML>") ) )

(de noContent ()
   (prinl "HTTP/1.0 204 No Content\r")
   (prinl "\r") )

(de redirect @
   (httpStat 303 "See Other" (pass pack "Location: ")) )

(de forbidden (X)
   (httpStat 403 "No Permission")
   (and X (msg *Pid " No permission: " @))
   (throw 'http) )

(de http404 ()
   (httpStat 404 "Not Found") )