jadedctrl/ kaptchapelo
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Actions Packages Projects Eldonoj Wiki Activity

Actually serve captcha images

This commit is contained in:
Jaidyn Ann 2023-08-08 14:34:49 -05:00
parent 641ae57dbb
commit 1e669cb4d6
1 changed files with 18 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
kaptchapelo.lisp
View File

@ -57,28 +57,38 @@
captcha-md5-str))))) captcha-md5-str)))))
(defun index-response () (defun image-response (request-uri captcha-dir)
'(201 (:content-type "text/plain") #p"kaptchapelo.lisp")) (let ((image-path (str:replace-first "/captcha/" (format nil "~A" captcha-dir) request-uri)))
;; '(201 (:content-type "text/plain") ("You’ve installed Kaptĉapelo! Good work, guy!"))) (list 201 '(:content-type "image/png") (pathname image-path))))
(defun index-response ()
'(201 (:content-type "text/plain") ("You’ve installed Kaptĉapelo! Good work, guy!")))
(defun 404-response () (defun 404-response ()
'(404 (:content-type "text/plain") ("No such page."))) '(404 (:content-type "text/plain") ("No such page.")))
(defun server (env captcha-dir) (defun server (env captcha-dir)
(let* ((uri (quri:uri (getf env :request-uri))) (let* ((uri (quri:uri (getf env :request-uri)))
(uri-path (quri:uri-path uri))
(params (quri:uri-query-params uri))) (params (quri:uri-query-params uri)))
(cond ((string= (quri:uri-path uri) "/new") (format *error-output* "~A" uri-path)
(cond ((string= uri-path "/new")
(new-captcha-response captcha-dir)) (new-captcha-response captcha-dir))
((or (string= (quri:uri-path uri) "/") ((or (string= uri-path "/")
(string= (quri:uri-path uri) "/index.html")) (string= uri-path "/index.html"))
(index-response)) (index-response))
((str:starts-with? "/captcha/" uri-path)
;; (str:ends-with? ".png" uri-path))
(image-response uri-path captcha-dir))
('t ('t
(404-response))))) (404-response)))))
(defun start-server (&key (captcha-directory #p"captcha/")) (defun start-server (&key (address "0.0.0.0") (port 5001) (captcha-directory #p"captcha/"))
(clack:clackup (clack:clackup
(lambda (env) (lambda (env)
(funcall #'server env captcha-directory)))) (funcall #'server env captcha-directory))
:address address
:port port))