From 1aa5acda7cbbfa00a6b4cde56c6963fa684f391b Mon Sep 17 00:00:00 2001 From: Piotr Szarmanski Date: Fri, 4 Aug 2023 19:39:32 +0200 Subject: New HTTP backend. --- extra/http/README | 14 ++++++++ extra/http/client.lisp | 33 +++++++++++++++++ extra/http/eris-http-client.asd | 8 +++++ extra/http/eris-http-server.asd | 27 ++++++++++++++ extra/http/eris-http-tests.asd | 12 +++++++ extra/http/http-tests.lisp | 72 +++++++++++++++++++++++++++++++++++++ extra/http/package-client.lisp | 3 ++ extra/http/package.lisp | 4 +++ extra/http/server.lisp | 78 +++++++++++++++++++++++++++++++++++++++++ src/backend.lisp | 2 +- 10 files changed, 252 insertions(+), 1 deletion(-) create mode 100644 extra/http/README create mode 100644 extra/http/client.lisp create mode 100644 extra/http/eris-http-client.asd create mode 100644 extra/http/eris-http-server.asd create mode 100644 extra/http/eris-http-tests.asd create mode 100644 extra/http/http-tests.lisp create mode 100644 extra/http/package-client.lisp create mode 100644 extra/http/package.lisp create mode 100644 extra/http/server.lisp diff --git a/extra/http/README b/extra/http/README new file mode 100644 index 0000000..8dba5ab --- /dev/null +++ b/extra/http/README @@ -0,0 +1,14 @@ +This is an implementation of ERIS over HTTP [https://eris.codeberg.page/eer/http.xml]. + +In addition to the barebones specification, the following extensions are implemented: + +1. Uploading blocks. Users authorized with the standard basic HTTP authorization +can POST a block in order to upload it to the server, remotely. + +2. When accessing entire URNs, one can also specify the MIMETYPE as an additional query parameter: + +GET /uri-res/N2R?urn:eris:...&type=text/html + +This can be used to directly access the content in a web browser. + + diff --git a/extra/http/client.lisp b/extra/http/client.lisp new file mode 100644 index 0000000..a694612 --- /dev/null +++ b/extra/http/client.lisp @@ -0,0 +1,33 @@ +(in-package #:eris-http-client) + +(defclass http-backend (eris:encoding-backend eris:decoding-backend) + ((endpoint :initarg :endpoint :type quri:uri + :documentation "HTTP endpoint to use.") + (auth :initarg :auth :type cons + :documentation "A login:password pair for HTTP Basic auth."))) + +(defmethod initialize-instance ((http-backend http-backend) &rest initargs + &key (endpoint nil endpoint-p) + (auth nil) + &allow-other-keys) + (declare (ignore initargs)) + (unless endpoint-p + (error 'simple-error "An endpoint must be specified.")) + (let ((uri (quri:uri endpoint))) + ;; To prevent confusion of what part of the endpoint should be included + (unless (string-suffix-p "/uri-res/" (quri:uri-path uri)) + (error 'simple-error "Endpoint must end in /uri-res/.")) + (with-slots (eris:output-function eris:fetch-function) http-backend + (setf (quri:uri-path uri) (concatenate 'string (quri:uri-path uri) "N2R")) + (setf eris:fetch-function + (lambda (reference) + (setf (quri:uri-query uri) (eris:reference-to-block-urn reference)) + (mvlet ((body status (dexador:get uri))) + (if (eql status 404) + (error 'eris:missing-block) + body))) + eris:output-function + (lambda (block reference) + (setf (quri:uri-query uri) (eris:reference-to-block-urn reference)) + (dexador:post uri :force-binary t :content block :basic-auth auth) + block))))) diff --git a/extra/http/eris-http-client.asd b/extra/http/eris-http-client.asd new file mode 100644 index 0000000..7adecbb --- /dev/null +++ b/extra/http/eris-http-client.asd @@ -0,0 +1,8 @@ +(defsystem "eris-http-client" + :name "eris-http-client" + :author "mail@ykonai.net" + :license "LGPLv3 or later" + :depends-on ("ironclad" "alexandria" "serapeum" "dexador" "eris") + :serial t + :components ((:file "package-client") + (:file "client"))) diff --git a/extra/http/eris-http-server.asd b/extra/http/eris-http-server.asd new file mode 100644 index 0000000..f7cafd6 --- /dev/null +++ b/extra/http/eris-http-server.asd @@ -0,0 +1,27 @@ +(defsystem "eris-http-server" + :name "eris-http-server" + :author "mail@ykonai.net" + :license "LGPLv3 or later" + :depends-on ("ironclad" "alexandria" "serapeum" "quri" "clack" "eris") + :serial t + :components ((:file "package") + (:file "server")) +;; :in-order-to ((test-op (test-op :eris/test))) + ) + + +;; (defsystem "eris/test" +;; :name "eris/test" +;; :depends-on ("eris" "fiveam" "ironclad" "alexandria" "serapeum") +;; :perform (test-op (op c) (symbol-call :fiveam :run! +;; (find-symbol* :eris-tests :eris/test))) +;; :components ((:module "tests" +;; :serial t +;; :components ((:file "package") +;; (:file "common") +;; (:file "encode-tests") +;; (:file "decode-tests") +;; (:file "rfc") +;; (:file "autogenerated-tests") +;; (:file "backend-tests") +;; #+unix (:file "parallel-tests"))))) diff --git a/extra/http/eris-http-tests.asd b/extra/http/eris-http-tests.asd new file mode 100644 index 0000000..5e99760 --- /dev/null +++ b/extra/http/eris-http-tests.asd @@ -0,0 +1,12 @@ +(defsystem "eris-http-tests" + :name "eris-http-tests" + :author "mail@ykonai.net" + :license "LGPLv3 or later" + :depends-on ("eris-http-server" "eris-http-client" "alexandria" "serapeum" "eris" "fiveam") + :serial t + :components ((:file "http-tests")) + :perform (test-op (op c) (symbol-call :fiveam :run! (find-symbol* :eris-http-tests :eris-http-tests)))) + + + + diff --git a/extra/http/http-tests.lisp b/extra/http/http-tests.lisp new file mode 100644 index 0000000..38dfac8 --- /dev/null +++ b/extra/http/http-tests.lisp @@ -0,0 +1,72 @@ +(defpackage #:eris-http-tests + (:use #:common-lisp #:serapeum #:fiveam #:eris-http-server #:eris-http-client)) + +(in-package :eris-http-tests) + + +(defun make-temporary-dir () + (let* ((tmpdir (uiop:temporary-directory)) + (tmp-tmpdir (make-pathname + :directory (serapeum:append1 + (pathname-directory tmpdir) + (ironclad:byte-array-to-hex-string (ironclad:random-data 10))) + :defaults tmpdir))) + (ensure-directories-exist tmp-tmpdir) + tmp-tmpdir)) + +(defmacro with-temporary-dir (sym &body expr) + `(let ((,sym (make-temporary-dir))) + (unwind-protect + (progn ,@expr) + (uiop:delete-directory-tree ,sym :validate t)))) + +(defmacro with-clack (handler &body expr) + (alexandria:with-gensyms (v) + `(let ((,v (clack:clackup ,handler))) + (unwind-protect (progn ,@expr) + (progn (format t "STOPPING CLACK ~%") (clack:stop ,v)))))) + +;; (base64:string-to-base64-string "test:test") +(alexandria:define-constant auth '("dGVzdDp0ZXN0") :test #'equal) + +(def-suite* eris-http-tests) + +(test basic-http-rw + (with-temporary-dir tdir + (with-clack (eris-handler tdir :auth auth) + (let ((backend (make-instance 'http-backend :endpoint "http://127.0.0.1:5000/uri-res/" + :auth '("test" . "test")))) + (for-all ((buffer (gen-buffer :length (gen-integer :min 1 :max 80000)))) + (is (equalp (alexandria:read-stream-content-into-byte-vector + (eris:fetch-data + (eris:store-data buffer backend) + backend)) + buffer)) + (is (equalp (alexandria:read-stream-content-into-byte-vector + (eris:fetch-data + (eris:store-data (make-array 40000 :element-type 'octet :initial-element 2) backend) + backend)) + (make-array 40000 :element-type 'octet :initial-element 2)))))))) + +(test bad-inputs + (with-temporary-dir tdir + (with-clack (eris-handler tdir :auth auth) + (signals error + (dexador:get "http://127.0.0.1:5000/lole")) + (signals error + (dexador:get "http://127.0.0.1:5000/../../")) + (signals error + (dexador:get "http://127.0.0.1:5000/uri-res/N2R?urn:blake2b:../../passwd")) + (signals error + (dexador:get "http://127.0.0.1:5000/uri-res/N2R?urn:blake2b:not")) + (signals error + (dexador:get "http://127.0.0.1:5000/uri-res/random-data")) + (signals error + (dexador:get "http://127.0.0.1:5000/../../../shadow")) + (signals error + (dexador:get "http://127.0.0.1:5000/uri-res/../something"))))) + + + + + diff --git a/extra/http/package-client.lisp b/extra/http/package-client.lisp new file mode 100644 index 0000000..e31375b --- /dev/null +++ b/extra/http/package-client.lisp @@ -0,0 +1,3 @@ +(defpackage #:eris-http-client + (:use #:common-lisp #:serapeum) + (:export #:http-backend)) diff --git a/extra/http/package.lisp b/extra/http/package.lisp new file mode 100644 index 0000000..5c713ce --- /dev/null +++ b/extra/http/package.lisp @@ -0,0 +1,4 @@ +(defpackage #:eris-http-server + (:use #:common-lisp #:serapeum) + (:local-nicknames (#:a #:alexandria)) + (:export #:eris-handler)) diff --git a/extra/http/server.lisp b/extra/http/server.lisp new file mode 100644 index 0000000..0ad85e4 --- /dev/null +++ b/extra/http/server.lisp @@ -0,0 +1,78 @@ +(in-package #:eris-http-server) + +(a:define-constant forbid '(403 (:content-type "text/plain") ("FORBIDDEN.")) + :test #'equal) + +(a:define-constant unauth '(401 (:content-type "text/plain") ("Unauthorized.")) + :test #'equal) + +(defmacro clack-write-stream (stream) + "Writes a stream as a response using Clack's responders." + `(lambda (responder) + (block lambda + ;; if errors out during stream creation, 404 + (let ((stream (handler-case ,stream + (error (c) + (declare (ignore c)) + (funcall (funcall responder '(404 (:content-type "text/plain") nil) nil :close t)) + (return-from lambda))))) + (let ((writer (funcall responder '(200 (:content-type "application/octet-stream"))))) + ;; read-sequence -> write + (loop with buffer = (serapeum:make-octet-vector 4096) + for bytes-read = (read-sequence buffer stream) + if (= bytes-read 4096) + do (funcall writer buffer) + else + do (funcall writer (serapeum:nsubseq buffer 0 bytes-read) :close t))))))) + + +(defun request-get (query-string directory file-backend) + (let ((uri (quri:uri query-string))) + (unless (quri:urn-p uri) (return-from request-get forbid)) + (case-using #'equal (quri:urn-nid uri) + ("blake2b" (let ((f (merge-pathnames directory (string-upcase (quri:urn-nss uri))))) + ;; Using merge-pathnames should prevent things like urn:...:/../../etc/passwd + ;; since it'll only fill the filename. + (if (uiop:file-exists-p f) + `(200 (:content-type "application/octet-stream") ,f) + `(404 (:content-type "text/plain") ("Missing block."))))) + ("eris" (clack-write-stream + (eris:fetch-data (eris:urn-to-read-capability query-string) file-backend))) + (otherwise forbid)))) + +(defun request-post (query body directory) + (let* ((uri (quri:uri query))) + ;; Using merge-pathnames should prevent things like urn:...:/../../blah + (unless (quri:urn-p uri) (return-from request-post forbid)) + (let ((path (merge-pathnames directory (string-upcase (quri:urn-nss uri))))) + (unless (uiop:file-exists-p path) + (with-open-file (f path :direction :output :if-does-not-exist :create :element-type 'octet) + (alexandria:copy-stream body f :element-type 'octet :buffer #.(make-octet-vector 4096))))) + '(200 (:content-type "text/plain") ("Unauthorized.")))) + + +(defun eris-handler (directory &key auth) + "Return a Clack handler for a file-backend based ERIS store. + +AUTH should be NIL or a list containing HTTP Basic Auth tokens (ie. base64 +encoded logic:pass strings). If NIL, all POST requests will be denied. Note that +due to the limitations of ERIS, the server absolutely trusts the uploader, +meaning that malicious users could potentially cause harm (as well as upload +arbitrary files)." + (let ((file-backend (make-instance 'eris:file-backend :directory directory))) + (lambda (env) + (destructuring-bind (&key request-method query-string raw-body path-info (headers (make-hash-table)) + content-length &allow-other-keys) env + (if (not (equal path-info "/uri-res/N2R")) + '(404 (:content-type "text/plain") ("No resource.")) + (case request-method + (:get (if (stringp query-string) (request-get query-string directory file-backend) + forbid)) + (:post (if (and + auth ;; if no auth always deny + (member (subseq (href headers "authorization") 6) auth :test #'equal) + (typep content-length '(member 1024 32768)) + (stringp query-string)) + (request-post query-string raw-body directory) + unauth)) + (t '(405 (:content-type "text/plain") ("Method not allowed."))))))))) diff --git a/src/backend.lisp b/src/backend.lisp index 381c96c..5568132 100644 --- a/src/backend.lisp +++ b/src/backend.lisp @@ -48,7 +48,7 @@ protect the data from attacks against convergent encryption.")) (if (> (etypecase input (stream (file-length input)) (vector (length input))) - (* 2 16384)) + 16384) 32kib 1kib) output-function -- cgit v1.2.3