blob: 97d45d097577cb545ab65e700616ef987fd1760d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
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))))
'(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.")))))))))
|
