1.1--- a/lisp/lib/io/io.asd Tue May 21 22:20:29 2024 -0400
1.2+++ b/lisp/lib/io/io.asd Wed May 22 18:19:23 2024 -0400
1.3@@ -4,7 +4,8 @@
1.4 :version "0.1.0"
1.5 :serial t
1.6 :components ((:file "pkg")
1.7- (:file "xsubseq"))
1.8+ (:file "xsubseq")
1.9+ (:file "smart-buffer"))
1.10 :in-order-to ((test-op (test-op "io/tests"))))
1.11
1.12 (defsystem :io/tests
2.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2+++ b/lisp/lib/io/smart-buffer.lisp Wed May 22 18:19:23 2024 -0400
2.3@@ -0,0 +1,120 @@
2.4+;;; io/smart-buffer.lisp --- Smart Octet Buffers
2.5+
2.6+;; This is ported from Fukamachi's SMART-BUFFER
2.7+
2.8+;;; Code:
2.9+
2.10+(defpackage io/smart-buffer
2.11+ (:use #:cl
2.12+ #:io/xsubseq)
2.13+ (:export #:*default-memory-limit*
2.14+ #:*default-disk-limit*
2.15+
2.16+ #:smart-buffer
2.17+ #:make-smart-buffer
2.18+ #:write-to-buffer
2.19+ #:finalize-buffer
2.20+ #:with-smart-buffer
2.21+ #:buffer-on-memory-p
2.22+ #:delete-stream-file
2.23+ #:delete-temporary-files
2.24+
2.25+ #:buffer-limit-exceeded))
2.26+(in-package :smart-buffer)
2.27+
2.28+(defvar *default-memory-limit* (expt 2 20))
2.29+(defvar *default-disk-limit* (expt 2 30))
2.30+
2.31+(defvar *temporary-directory*
2.32+ (uiop:ensure-directory-pathname
2.33+ (merge-pathnames (format nil "smart-buffer-~36R" (random (expt 36 #-gcl 8 #+gcl 5)))
2.34+ (uiop:default-temporary-directory))))
2.35+
2.36+(defstruct (smart-buffer (:conc-name :buffer-)
2.37+ (:constructor %make-smart-buffer))
2.38+ (memory-limit *default-memory-limit*)
2.39+ (disk-limit *default-disk-limit*)
2.40+ (current-len 0)
2.41+ (on-memory-p t)
2.42+ (memory-buffer (make-concatenated-xsubseqs))
2.43+ (disk-buffer nil))
2.44+
2.45+(defun make-smart-buffer (&rest initargs &key memory-limit disk-limit &allow-other-keys)
2.46+ (let ((buffer (apply #'%make-smart-buffer initargs)))
2.47+ (when (and memory-limit
2.48+ disk-limit
2.49+ (< disk-limit memory-limit))
2.50+ (setf (buffer-memory-limit buffer) disk-limit))
2.51+ buffer))
2.52+
2.53+(define-condition buffer-limit-exceeded (error)
2.54+ ((limit :initarg :limit
2.55+ :initform nil))
2.56+ (:report (lambda (condition stream)
2.57+ (format stream "Buffer exceeded the limit~:[~;~:*: ~A~]"
2.58+ (slot-value condition 'limit)))))
2.59+
2.60+(defun write-to-buffer (buffer seq &optional (start 0) (end (length seq)))
2.61+ (check-type seq (array (unsigned-byte 8) (*)))
2.62+ (incf (buffer-current-len buffer) (- end start))
2.63+ (check-limit buffer)
2.64+ (if (buffer-on-memory-p buffer)
2.65+ (xnconcf (buffer-memory-buffer buffer) (xsubseq seq start end))
2.66+ (with-open-file (out (buffer-disk-buffer buffer)
2.67+ :direction :output
2.68+ :element-type '(unsigned-byte 8)
2.69+ :if-exists :append)
2.70+ (write-sequence seq out :start start :end end))))
2.71+
2.72+(defun check-limit (buffer)
2.73+ (cond
2.74+ ((and (buffer-on-memory-p buffer)
2.75+ (< (buffer-memory-limit buffer)
2.76+ (buffer-current-len buffer)))
2.77+ (when (< (buffer-disk-limit buffer)
2.78+ (buffer-current-len buffer))
2.79+ (error 'buffer-limit-exceeded :limit (buffer-disk-limit buffer)))
2.80+ (setf (buffer-disk-buffer buffer)
2.81+ (uiop:with-temporary-file (:stream stream :pathname tmp
2.82+ :directory *temporary-directory*
2.83+ :direction :output
2.84+ :element-type '(unsigned-byte 8)
2.85+ :keep t)
2.86+ (typecase (buffer-memory-buffer buffer)
2.87+ (null-concatenated-xsubseqs)
2.88+ (t (write-sequence (coerce-to-sequence (buffer-memory-buffer buffer)) stream)))
2.89+ tmp)
2.90+ (buffer-on-memory-p buffer) nil
2.91+ (buffer-memory-buffer buffer) nil))
2.92+ ((and (not (buffer-on-memory-p buffer))
2.93+ (< (buffer-disk-limit buffer)
2.94+ (buffer-current-len buffer)))
2.95+ (error 'buffer-limit-exceeded :limit (buffer-disk-limit buffer)))))
2.96+
2.97+(defun finalize-buffer (buffer)
2.98+ (if (buffer-on-memory-p buffer)
2.99+ (flex:make-in-memory-input-stream
2.100+ (typecase (buffer-memory-buffer buffer)
2.101+ (null-concatenated-xsubseqs #())
2.102+ (t (coerce-to-sequence (buffer-memory-buffer buffer)))))
2.103+ (open (buffer-disk-buffer buffer) :direction :input :element-type '(unsigned-byte 8))))
2.104+
2.105+(defmacro with-smart-buffer ((buffer &key
2.106+ (memory-limit '*default-memory-limit*)
2.107+ (disk-limit '*default-disk-limit*))
2.108+ &body body)
2.109+ `(let ((,buffer (make-smart-buffer :memory-limit ,memory-limit :disk-limit ,disk-limit)))
2.110+ ,@body
2.111+ (finalize-buffer ,buffer)))
2.112+
2.113+(defun delete-stream-file (stream)
2.114+ (when (typep stream 'file-stream)
2.115+ (ignore-errors (delete-file (pathname stream))))
2.116+ (values))
2.117+
2.118+(defun delete-temporary-files (&key (stale-seconds 0))
2.119+ (let ((now (get-universal-time)))
2.120+ (mapc #'uiop:delete-file-if-exists
2.121+ (remove-if-not (lambda (file)
2.122+ (< stale-seconds (- now (file-write-date file))))
2.123+ (uiop:directory-files *temporary-directory*)))))
3.1--- a/lisp/lib/net/net.asd Tue May 21 22:20:29 2024 -0400
3.2+++ b/lisp/lib/net/net.asd Wed May 22 18:19:23 2024 -0400
3.3@@ -5,7 +5,7 @@
3.4 :depends-on
3.5 (:sb-concurrency :sb-posix
3.6 :sb-bsd-sockets :cl-ppcre
3.7- :dat :obj
3.8+ :dat :obj :io :parse
3.9 ;; :swank ;; HACK 2024-05-12: temporarily disable, incompatible with current upstream
3.10 ;; :swank-client
3.11 :dexador ;; fetch
3.12@@ -25,7 +25,7 @@
3.13 (:file "osc")))
3.14 (:module "proto"
3.15 :components (;; (:file "crew") ;; HACK 2024-05-12: temporarily disable, incompatible with current upstream
3.16- ;; (:file "http")
3.17+ (:file "http")
3.18 (:file "dns")
3.19 (:file "ssh")))
3.20 (:file "fetch"))
4.1--- a/lisp/lib/net/pkg.lisp Tue May 21 22:20:29 2024 -0400
4.2+++ b/lisp/lib/net/pkg.lisp Wed May 22 18:19:23 2024 -0400
4.3@@ -22,7 +22,7 @@
4.4 ;; (defpackage :net/sans-io
4.5 ;; (:use :cl :obj :dat/proto :std :net/core :sb-bsd-sockets)
4.6 ;; (:export))
4.7-
4.8+
4.9 (defpackage :net/udp
4.10 (:nicknames :udp)
4.11 (:use :cl :std :net/core :sb-bsd-sockets)
4.12@@ -156,8 +156,82 @@
4.13 (:export))
4.14
4.15 (defpackage :net/proto/http
4.16- (:use :cl :std :net/core :sb-bsd-sockets :parse/bytes)
4.17- (:export))
4.18+ (:use :cl :std :net/core :sb-bsd-sockets :parse/bytes :io/xsubseq :io/smart-buffer)
4.19+ (:export
4.20+ :make-parser
4.21+ :http-request
4.22+ :http-response
4.23+ :make-http-request
4.24+ :make-http-response
4.25+ :http-request-p
4.26+ :http-response-p
4.27+ :make-callbacks
4.28+ :http-version
4.29+ :http-major-version
4.30+ :http-minor-version
4.31+ :http-method
4.32+ :http-resource
4.33+ :http-status
4.34+ :http-status-text
4.35+ :http-content-length
4.36+ :http-chunked-p
4.37+ :http-upgrade-p
4.38+ :http-headers
4.39+ ;; multipart parser
4.40+ :make-multipart-parser
4.41+ ;; Low-level parser API
4.42+ :http
4.43+ :http-p
4.44+ :make-http
4.45+ :parse-request
4.46+ :parse-response
4.47+ :http-multipart-parse
4.48+ :ll-multipart-parser
4.49+ :make-ll-multipart-parser
4.50+ ;; Error
4.51+ :http-error
4.52+ :callback-error
4.53+ :cb-message-begin
4.54+ :cb-url
4.55+ :cb-first-line
4.56+ :cb-header-field
4.57+ :cb-header-value
4.58+ :cb-headers-complete
4.59+ :cb-body
4.60+ :cb-message-complete
4.61+ :cb-status
4.62+
4.63+ :parsing-error
4.64+ :invalid-eof-state
4.65+ :header-overflow
4.66+ :closed-connection
4.67+ :invalid-version
4.68+ :invalid-status
4.69+ :invalid-method
4.70+ :invalid-url
4.71+ :invalid-host
4.72+ :invalid-port
4.73+ :invalid-path
4.74+ :invalid-query-string
4.75+ :invalid-fragment
4.76+ :lf-expected
4.77+ :invalid-header-token
4.78+ :invalid-content-length
4.79+ :invalid-chunk-size
4.80+ :invalid-constant
4.81+ :invalid-internal-state
4.82+ :strict-error
4.83+ :paused-error
4.84+ :unknown-error
4.85+
4.86+ :multipart-parsing-error
4.87+ :invalid-multipart-body
4.88+ :invalid-boundary
4.89+
4.90+ :header-value-parsing-error
4.91+ :invalid-header-value
4.92+ :invalid-parameter-key
4.93+ :invalid-parameter-value))
4.94
4.95 (uiop:define-package :net/fetch
4.96 (:nicknames :fetch)
5.1--- a/lisp/lib/net/proto/http.lisp Tue May 21 22:20:29 2024 -0400
5.2+++ b/lisp/lib/net/proto/http.lisp Wed May 22 18:19:23 2024 -0400
5.3@@ -1,10 +1,16 @@
5.4-;;; TODO
5.5 ;;; lib/net/proto/http.lisp --- HTTP Support
5.6
5.7-;; based on https://github.com/fukamachi/fast-http (maybe)
5.8+;; based on https://github.com/fukamachi/fast-http
5.9
5.10 ;; see also: https://github.com/orthecreedence/http-parse
5.11
5.12+;;; Commentary:
5.13+
5.14+;; Fukamachi has implemented the current state-of-the-art HTTP libraries
5.15+;; (fast-http, dexador, etc). For the time being we'll be using these with
5.16+;; minimal changes. At some point in the future it would be ideal to
5.17+;; re-implement this in a sans-io style.
5.18+
5.19 ;;; Code:
5.20 (in-package :net/proto/http)
5.21
5.22@@ -147,7 +153,7 @@
5.23
5.24 (declaim (inline number-string-p))
5.25 (defun number-string-p (string)
5.26- (declare (type #+ecl string #-ecl simple-string string)
5.27+ (declare (type simple-string string)
5.28 (optimize (speed 3) (safety 2)))
5.29 ;; empty string
5.30 (when (zerop (length string))
5.31@@ -196,9 +202,9 @@
5.32 (when header-value-buffer
5.33 (let ((header-value
5.34 (locally (declare (optimize (speed 3) (safety 0)))
5.35- (coerce
5.36- header-value-buffer
5.37- 'string))))
5.38+ (coerce-to-string
5.39+ (the (or octet-concatenated-xsubseqs octet-xsubseq) header-value-buffer)))))
5.40+
5.41 (if (string= parsing-header-field "set-cookie")
5.42 (push header-value (gethash "set-cookie" headers))
5.43 (multiple-value-bind (previous-value existp)
5.44@@ -235,14 +241,14 @@
5.45 (type simple-byte-vector data)
5.46 (type pointer start end))
5.47 (collect-prev-header-value)
5.48- ;; (setq header-value-buffer (make-concatenated-xsubseqs))
5.49+ (setq header-value-buffer (make-concatenated-xsubseqs))
5.50 (setq parsing-header-field
5.51 (ascii-octets-to-lower-string data :start start :end end)))
5.52 :header-value (lambda (http data start end)
5.53 (declare (ignore http)
5.54 (type simple-byte-vector data)
5.55 (type pointer start end))
5.56- (nconcf header-value-buffer
5.57+ (xnconcf header-value-buffer
5.58 (subseq (subseq (the simple-byte-vector data) start end) 0)))
5.59 :headers-complete (lambda (http)
5.60 (collect-prev-header-value)
5.61@@ -285,8 +291,8 @@
5.62 (when data-buffer
5.63 (setq data
5.64 (coerce 'list
5.65- (nconc (subseq data-buffer 0)
5.66- (subseq (the simple-byte-vector data) start (or end (length data))))))
5.67+ (xnconc (xsubseq data-buffer 0)
5.68+ (xsubseq (the simple-byte-vector data) start (or end (length data))))))
5.69 (setq data-buffer nil
5.70 start 0
5.71 end nil))
5.72@@ -317,6 +323,125 @@
5.73 (when parsing-boundary
5.74 (return-from find-boundary (subseq data start end)))))))
5.75
5.76+;;; byte-vector
5.77+(defconstant +cr+ (char-code #\Return))
5.78+(defconstant +lf+ (char-code #\Newline))
5.79+(defconstant +space+ (char-code #\Space))
5.80+(defconstant +tab+ (char-code #\Tab))
5.81+(defconstant +page+ (char-code #\Page))
5.82+(defconstant +dash+ #.(char-code #\-))
5.83+
5.84+(define-constant +crlf+
5.85+ (make-array 2 :element-type '(unsigned-byte 8)
5.86+ :initial-contents (list +cr+ +lf+))
5.87+ :test 'equalp)
5.88+
5.89+(deftype simple-byte-vector (&optional (len '*))
5.90+ `(simple-array (unsigned-byte 8) (,len)))
5.91+
5.92+(declaim (inline digit-byte-char-p
5.93+ digit-byte-char-to-integer
5.94+ alpha-byte-char-p
5.95+ alpha-byte-char-to-lower-char
5.96+ alphanumeric-byte-char-p
5.97+ mark-byte-char-p))
5.98+
5.99+(defun digit-byte-char-p (byte)
5.100+ (declare (type (unsigned-byte 8) byte)
5.101+ (optimize (speed 3) (safety 0)))
5.102+ (<= #.(char-code #\0) byte #.(char-code #\9)))
5.103+
5.104+(declaim (ftype (function ((unsigned-byte 8)) fixnum) digit-byte-char-to-integer))
5.105+(defun digit-byte-char-to-integer (byte)
5.106+ (declare (type (unsigned-byte 8) byte)
5.107+ (optimize (speed 3) (safety 0)))
5.108+ (the fixnum (- byte #.(char-code #\0))))
5.109+
5.110+(defun alpha-byte-char-p (byte)
5.111+ (declare (type (unsigned-byte 8) byte)
5.112+ (optimize (speed 3) (safety 0)))
5.113+ (or (<= #.(char-code #\A) byte #.(char-code #\Z))
5.114+ (<= #.(char-code #\a) byte #.(char-code #\z))))
5.115+
5.116+(defun alpha-byte-char-to-lower-char (byte)
5.117+ (declare (type (unsigned-byte 8) byte)
5.118+ (optimize (speed 3) (safety 0)))
5.119+ (the character
5.120+ (cond
5.121+ ((<= #.(char-code #\A) byte #.(char-code #\Z))
5.122+ (code-char (+ byte #x20)))
5.123+ (T #+nil(<= #.(char-code #\a) byte #.(char-code #\z))
5.124+ (code-char byte)))))
5.125+
5.126+(defun alphanumeric-byte-char-p (byte)
5.127+ (declare (type (unsigned-byte 8) byte))
5.128+ (or (alpha-byte-char-p byte)
5.129+ (digit-byte-char-p byte)))
5.130+
5.131+(defun mark-byte-char-p (byte)
5.132+ (declare (type (unsigned-byte 8) byte)
5.133+ (optimize (speed 3) (safety 0)))
5.134+ (or (= byte #.(char-code #\-))
5.135+ (= byte #.(char-code #\_))
5.136+ (= byte #.(char-code #\.))
5.137+ (= byte #.(char-code #\!))
5.138+ (= byte #.(char-code #\~))
5.139+ (= byte #.(char-code #\*))
5.140+ (= byte #.(char-code #\'))
5.141+ (= byte #.(char-code #\())
5.142+ (= byte #.(char-code #\)))))
5.143+
5.144+(declaim (ftype (function ((unsigned-byte 8)) (unsigned-byte 8)) byte-to-ascii-lower)
5.145+ (inline byte-to-ascii-lower))
5.146+(defun byte-to-ascii-lower (x)
5.147+ (declare (type (unsigned-byte 8) x)
5.148+ (optimize (speed 3) (safety 0)))
5.149+ (if (<= #.(char-code #\A) x #.(char-code #\Z))
5.150+ (- x #.(- (char-code #\A) (char-code #\a)))
5.151+ x))
5.152+
5.153+(declaim (inline ascii-octets-to-string))
5.154+(defun ascii-octets-to-string (octets &key (start 0) (end (length octets)))
5.155+ (declare (type simple-byte-vector octets)
5.156+ (type (unsigned-byte 64) start end)
5.157+ (optimize (speed 3) (safety 0)))
5.158+ (let* ((len (the (unsigned-byte 64) (- end start)))
5.159+ (string (make-string len :element-type 'character)))
5.160+ (declare (type (unsigned-byte 64) len)
5.161+ (type simple-string string))
5.162+ (do ((i 0 (1+ i))
5.163+ (j start (1+ j)))
5.164+ ((= j end) string)
5.165+ (setf (aref string i)
5.166+ (code-char (aref octets j))))))
5.167+
5.168+(declaim (inline ascii-octets-to-lower-string))
5.169+(defun ascii-octets-to-lower-string (octets &key (start 0) (end (length octets)))
5.170+ (declare (type simple-byte-vector octets)
5.171+ (type (unsigned-byte 64) start end)
5.172+ (optimize (speed 3) (safety 0)))
5.173+ (let* ((len (the (unsigned-byte 64) (- end start)))
5.174+ (string (make-string len :element-type 'character)))
5.175+ (declare (type (unsigned-byte 64) len)
5.176+ (type simple-string string))
5.177+ (do ((i 0 (1+ i))
5.178+ (j start (1+ j)))
5.179+ ((= j end) string)
5.180+ (setf (aref string i)
5.181+ (code-char (byte-to-ascii-lower (aref octets j)))))))
5.182+
5.183+(defun append-byte-vectors (vec1 vec2)
5.184+ (declare (type simple-byte-vector vec1 vec2)
5.185+ (optimize (speed 3) (safety 0)))
5.186+ (let* ((vec1-len (length vec1))
5.187+ (vec2-len (length vec2))
5.188+ (result (make-array (+ vec1-len vec2-len)
5.189+ :element-type '(unsigned-byte 8))))
5.190+ (declare (type simple-byte-vector result))
5.191+ (replace result vec1 :start1 0)
5.192+ (replace result vec2 :start1 vec1-len)
5.193+ result))
5.194+
5.195 ;;; multipart-parser
5.196 (defstruct (ll-multipart-parser (:constructor make-ll-multipart-parser
5.197 (&key boundary
5.198@@ -386,7 +511,7 @@
5.199 (setf (ll-multipart-parser-boundary-buffer parser) nil)))))
5.200 (let* ((p start)
5.201 (byte (aref data p)))
5.202- #+fast-http-debug
5.203+ #+http-debug
5.204 (log:debug (code-char byte))
5.205 (tagbody
5.206 (macrolet ((go-state (tag &optional (advance 1))
5.207@@ -396,13 +521,13 @@
5.208 (1 '(incf p))
5.209 (otherwise `(incf p ,advance)))
5.210 (setf (ll-multipart-parser-state parser) ,tag)
5.211- #+fast-http-debug
5.212+ #+http-debug
5.213 (log:debug ,(princ-to-string tag))
5.214 ,@(and (not (eql advance 0))
5.215 `((when (= p end)
5.216 (go exit-loop))
5.217 (setq byte (aref data p))
5.218- #+fast-http-debug
5.219+ #+http-debug
5.220 (log:debug (code-char byte))))
5.221 (go ,tag))))
5.222 (tagcasev (ll-multipart-parser-state parser)
5.223@@ -608,7 +733,7 @@
5.224 :header-field (lambda (parser data start end)
5.225 (declare (ignore parser))
5.226 (collect-prev-header-value)
5.227- ;; (setq header-value-buffer (make-concatenated-xsubseqs))
5.228+ (setq header-value-buffer (make-concatenated-xsubseqs))
5.229
5.230 (let ((header-name
5.231 (ascii-octets-to-lower-string data :start start :end end)))
5.232@@ -617,7 +742,7 @@
5.233 (setq parsing-header-field header-name)))
5.234 :header-value (lambda (parser data start end)
5.235 (declare (ignore parser))
5.236- (nconcf header-value-buffer
5.237+ (xnconcf header-value-buffer
5.238 (subseq (subseq data start end) 0)))
5.239 :headers-complete (lambda (parser)
5.240 (declare (ignore parser))
5.241@@ -819,125 +944,6 @@
5.242 (define-condition invalid-parameter-value (header-value-parsing-error)
5.243 ((description :initform "invalid parameter value")))
5.244
5.245-;;; byte-vector
5.246-(defconstant +cr+ (char-code #\Return))
5.247-(defconstant +lf+ (char-code #\Newline))
5.248-(defconstant +space+ (char-code #\Space))
5.249-(defconstant +tab+ (char-code #\Tab))
5.250-(defconstant +page+ (char-code #\Page))
5.251-(defconstant +dash+ #.(char-code #\-))
5.252-
5.253-(define-constant +crlf+
5.254- (make-array 2 :element-type '(unsigned-byte 8)
5.255- :initial-contents (list +cr+ +lf+))
5.256- :test 'equalp)
5.257-
5.258-(deftype simple-byte-vector (&optional (len '*))
5.259- `(simple-array (unsigned-byte 8) (,len)))
5.260-
5.261-(declaim (inline digit-byte-char-p
5.262- digit-byte-char-to-integer
5.263- alpha-byte-char-p
5.264- alpha-byte-char-to-lower-char
5.265- alphanumeric-byte-char-p
5.266- mark-byte-char-p))
5.267-
5.268-(defun digit-byte-char-p (byte)
5.269- (declare (type (unsigned-byte 8) byte)
5.270- (optimize (speed 3) (safety 0)))
5.271- (<= #.(char-code #\0) byte #.(char-code #\9)))
5.272-
5.273-(declaim (ftype (function ((unsigned-byte 8)) fixnum) digit-byte-char-to-integer))
5.274-(defun digit-byte-char-to-integer (byte)
5.275- (declare (type (unsigned-byte 8) byte)
5.276- (optimize (speed 3) (safety 0)))
5.277- (the fixnum (- byte #.(char-code #\0))))
5.278-
5.279-(defun alpha-byte-char-p (byte)
5.280- (declare (type (unsigned-byte 8) byte)
5.281- (optimize (speed 3) (safety 0)))
5.282- (or (<= #.(char-code #\A) byte #.(char-code #\Z))
5.283- (<= #.(char-code #\a) byte #.(char-code #\z))))
5.284-
5.285-(defun alpha-byte-char-to-lower-char (byte)
5.286- (declare (type (unsigned-byte 8) byte)
5.287- (optimize (speed 3) (safety 0)))
5.288- (the character
5.289- (cond
5.290- ((<= #.(char-code #\A) byte #.(char-code #\Z))
5.291- (code-char (+ byte #x20)))
5.292- (T #+nil(<= #.(char-code #\a) byte #.(char-code #\z))
5.293- (code-char byte)))))
5.294-
5.295-(defun alphanumeric-byte-char-p (byte)
5.296- (declare (type (unsigned-byte 8) byte))
5.297- (or (alpha-byte-char-p byte)
5.298- (digit-byte-char-p byte)))
5.299-
5.300-(defun mark-byte-char-p (byte)
5.301- (declare (type (unsigned-byte 8) byte)
5.302- (optimize (speed 3) (safety 0)))
5.303- (or (= byte #.(char-code #\-))
5.304- (= byte #.(char-code #\_))
5.305- (= byte #.(char-code #\.))
5.306- (= byte #.(char-code #\!))
5.307- (= byte #.(char-code #\~))
5.308- (= byte #.(char-code #\*))
5.309- (= byte #.(char-code #\'))
5.310- (= byte #.(char-code #\())
5.311- (= byte #.(char-code #\)))))
5.312-
5.313-(declaim (ftype (function ((unsigned-byte 8)) (unsigned-byte 8)) byte-to-ascii-lower)
5.314- (inline byte-to-ascii-lower))
5.315-(defun byte-to-ascii-lower (x)
5.316- (declare (type (unsigned-byte 8) x)
5.317- (optimize (speed 3) (safety 0)))
5.318- (if (<= #.(char-code #\A) x #.(char-code #\Z))
5.319- (- x #.(- (char-code #\A) (char-code #\a)))
5.320- x))
5.321-
5.322-(declaim (inline ascii-octets-to-string))
5.323-(defun ascii-octets-to-string (octets &key (start 0) (end (length octets)))
5.324- (declare (type simple-byte-vector octets)
5.325- (type (unsigned-byte 64) start end)
5.326- (optimize (speed 3) (safety 0)))
5.327- (let* ((len (the (unsigned-byte 64) (- end start)))
5.328- (string (make-string len :element-type 'character)))
5.329- (declare (type (unsigned-byte 64) len)
5.330- (type simple-string string))
5.331- (do ((i 0 (1+ i))
5.332- (j start (1+ j)))
5.333- ((= j end) string)
5.334- (setf (aref string i)
5.335- (code-char (aref octets j))))))
5.336-
5.337-(declaim (inline ascii-octets-to-lower-string))
5.338-(defun ascii-octets-to-lower-string (octets &key (start 0) (end (length octets)))
5.339- (declare (type simple-byte-vector octets)
5.340- (type (unsigned-byte 64) start end)
5.341- (optimize (speed 3) (safety 0)))
5.342- (let* ((len (the (unsigned-byte 64) (- end start)))
5.343- (string (make-string len :element-type 'character)))
5.344- (declare (type (unsigned-byte 64) len)
5.345- (type simple-string string))
5.346- (do ((i 0 (1+ i))
5.347- (j start (1+ j)))
5.348- ((= j end) string)
5.349- (setf (aref string i)
5.350- (code-char (byte-to-ascii-lower (aref octets j)))))))
5.351-
5.352-(defun append-byte-vectors (vec1 vec2)
5.353- (declare (type simple-byte-vector vec1 vec2)
5.354- (optimize (speed 3) (safety 0)))
5.355- (let* ((vec1-len (length vec1))
5.356- (vec2-len (length vec2))
5.357- (result (make-array (+ vec1-len vec2-len)
5.358- :element-type '(unsigned-byte 8))))
5.359- (declare (type simple-byte-vector result))
5.360- (replace result vec1 :start1 0)
5.361- (replace result vec2 :start1 vec1-len)
5.362- result))
5.363-
5.364 ;;; parser
5.365 ;;
5.366 ;; Variables
5.367@@ -1530,7 +1536,7 @@
5.368 (defun parse-request (http callbacks data &key (start 0) end (head-request nil))
5.369 (declare (type http http)
5.370 (type simple-byte-vector data)
5.371- (ignore head-request))
5.372+ (ignorable head-request))
5.373 (let ((end (or end (length data))))
5.374 (declare (type pointer start end))
5.375 (handler-bind ((match-failed
6.1--- a/lisp/lib/net/tests.lisp Tue May 21 22:20:29 2024 -0400
6.2+++ b/lisp/lib/net/tests.lisp Wed May 22 18:19:23 2024 -0400
6.3@@ -5,7 +5,7 @@
6.4
6.5 (defsuite :net)
6.6 (in-suite :net)
6.7-
6.8+(in-readtable :std)
6.9 (deftest sanity ())
6.10
6.11 (deftest sans-io ()
6.12@@ -120,3 +120,22 @@
6.13 ;; (eval-repeatedly-async-state pool work-form 10 #'update-state))))
6.14
6.15 (deftest crew ())
6.16+
6.17+(deftest http ()
6.18+ (let ((req (make-http-request))
6.19+ (cb (make-callbacks)))
6.20+ (parse-request
6.21+ req cb
6.22+ (sb-ext:string-to-octets #"GET /cookies HTTP/1.1
6.23+Host: 127.0.0.1:8080
6.24+Connection: keep-alive
6.25+Cache-Control: max-age=0Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
6.26+User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.17 (KHTML, like Gecko) Chrome/24.0.1312.56 Safari/537.17
6.27+Accept-Encoding: gzip,deflate,sdch
6.28+Accept-Language: en-US,en;q=0.8
6.29+Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.3
6.30+Cookie: name=wookie
6.31+
6.32+"#))
6.33+ (is req)
6.34+ (is cb)))
7.1--- a/lisp/lib/parse/pkg.lisp Tue May 21 22:20:29 2024 -0400
7.2+++ b/lisp/lib/parse/pkg.lisp Wed May 22 18:19:23 2024 -0400
7.3@@ -66,7 +66,6 @@
7.4 :match-i-case
7.5 :match-failed))
7.6
7.7-
7.8 (uiop:define-package :parse
7.9 (:use :cl :std)
7.10- (:use-reexport :parse/lex :parse/yacc :parse/bytes))
7.11+ (:use-reexport :parse/lex :parse/yacc))
