Docstrings & formatting
This commit is contained in:
parent
3fc1dc1479
commit
d28f5ba05f
|
@ -1,16 +1,16 @@
|
||||||
;;; Copyright 2023, Jaidyn Ann <jadedctrl@posteo.at>
|
;;; Copyright 2023, Jaidyn Ann <jadedctrl@posteo.at>
|
||||||
;;;
|
;;;
|
||||||
;;; This program is free software: you can redistribute it and/or
|
;;; This program is free software: you can redistribute it and/or
|
||||||
;;; modify it under the terms of the GNU General Public License as
|
;;; modify it under the terms of the GNU Affero General Public License
|
||||||
;;; published by the Free Software Foundation, either version 3 of
|
;;; as published by the Free Software Foundation, either version 3 of
|
||||||
;;; the License, or (at your option) any later version.
|
;;; the License, or (at your option) any later version.
|
||||||
;;;
|
;;;
|
||||||
;;; This program is distributed in the hope that it will be useful,
|
;;; This program is distributed in the hope that it will be useful,
|
||||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;;; GNU General Public License for more details.
|
;;; GNU Affero General Public License for more details.
|
||||||
;;;
|
;;;
|
||||||
;;; You should have received a copy of the GNU General Public License
|
;;; You should have received a copy of the GNU Affero General Public License
|
||||||
;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(defpackage #:kaptchapelo
|
(defpackage #:kaptchapelo
|
||||||
|
@ -29,6 +29,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defun random-file (directory &key (file-ext ""))
|
(defun random-file (directory &key (file-ext ""))
|
||||||
|
"Select a random file from the given DIRECTORY of a specific FILE-EXTension."
|
||||||
(alexandria:random-elt
|
(alexandria:random-elt
|
||||||
(directory (str:concat (format nil "~A" directory)
|
(directory (str:concat (format nil "~A" directory)
|
||||||
"/*"
|
"/*"
|
||||||
|
@ -38,16 +39,17 @@
|
||||||
|
|
||||||
|
|
||||||
(defun new-captcha-json (captcha-image-uri captcha-text-file)
|
(defun new-captcha-json (captcha-image-uri captcha-text-file)
|
||||||
"Return the kocaptcha-formed JSON to be returned for a new captcha request."
|
"Create a Kocaptcha-compatibile captcha challenge in JSON-format."
|
||||||
(yason:with-output-to-string* ()
|
(yason:with-output-to-string* ()
|
||||||
(yason:encode-plist
|
(yason:encode-plist
|
||||||
(list "md5" (byte-array-to-hex-string captcha-text-file)
|
(list "md5" (byte-array-to-hex-string captcha-text-file)
|
||||||
"url" captcha-image-uri
|
"url" captcha-image-uri
|
||||||
|
;; I don’t know what Kocaptcha’s token does! :P
|
||||||
"token" "This_isnt_actually_used_lol"))))
|
"token" "This_isnt_actually_used_lol"))))
|
||||||
|
|
||||||
|
|
||||||
(defun new-captcha-response (captcha-dir)
|
(defun new-captcha-response (captcha-dir)
|
||||||
"Create an HTTP response for use with Clack with a new captcha."
|
"Create a Clack HTTP response with a new captcha."
|
||||||
(let* ((captcha-txt-file (random-file captcha-dir :file-ext "txt"))
|
(let* ((captcha-txt-file (random-file captcha-dir :file-ext "txt"))
|
||||||
(captcha-img-file (str:concat (pathname-name captcha-txt-file) ".png"))
|
(captcha-img-file (str:concat (pathname-name captcha-txt-file) ".png"))
|
||||||
(captcha-md5-str (byte-array-to-hex-string
|
(captcha-md5-str (byte-array-to-hex-string
|
||||||
|
@ -58,35 +60,52 @@
|
||||||
|
|
||||||
|
|
||||||
(defun image-response (request-uri captcha-dir)
|
(defun image-response (request-uri captcha-dir)
|
||||||
|
"Given a /captcha/… REQUEST-URI and the CAPTCHA-DIR where images can be found,
|
||||||
|
make a Clack HTTP response that serves the appropriate image."
|
||||||
(let ((image-path (str:replace-first "/captcha/" (format nil "~A" captcha-dir) request-uri)))
|
(let ((image-path (str:replace-first "/captcha/" (format nil "~A" captcha-dir) request-uri)))
|
||||||
(list 201 '(:content-type "image/png") (pathname image-path))))
|
(list 201 '(:content-type "image/png")
|
||||||
|
(pathname image-path))))
|
||||||
|
|
||||||
|
|
||||||
(defun index-response ()
|
(defun index-response ()
|
||||||
'(201 (:content-type "text/plain") ("You’ve installed Kaptĉapelo! Good work, guy!")))
|
"Return a friendly “salutations” Clack-response for those visting the root-page."
|
||||||
|
'(201 (:content-type "text/plain")
|
||||||
|
("You’ve installed Kaptĉapelo; good work! If you’d like a captcha challenge, visit /new !")))
|
||||||
|
|
||||||
|
|
||||||
(defun 404-response ()
|
(defun 404-response ()
|
||||||
|
"Create a 404-comlpaining HTTP Clack-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)
|
||||||
|
"The heart of the server; returns requests for Clack."
|
||||||
(let* ((uri (quri:uri (getf env :request-uri)))
|
(let* ((uri (quri:uri (getf env :request-uri)))
|
||||||
(uri-path (quri:uri-path uri))
|
(uri-path (quri:uri-path uri)))
|
||||||
(params (quri:uri-query-params uri)))
|
|
||||||
(format *error-output* "~A" uri-path)
|
(format *error-output* "~A" uri-path)
|
||||||
(cond ((string= uri-path "/new")
|
(cond
|
||||||
(new-captcha-response captcha-dir))
|
;; Create a new captcha at /new
|
||||||
((or (string= uri-path "/")
|
((string= uri-path "/new")
|
||||||
(string= uri-path "/index.html"))
|
(new-captcha-response captcha-dir))
|
||||||
(index-response))
|
;; For lost souls visiting /[index.html], say “hi.”
|
||||||
((str:starts-with? "/captcha/" uri-path)
|
((or (string= uri-path "/")
|
||||||
;; (str:ends-with? ".png" uri-path))
|
(string= uri-path "/index.html"))
|
||||||
(image-response uri-path captcha-dir))
|
(index-response))
|
||||||
('t
|
;; At /captcha/*.png, server the given image.
|
||||||
(404-response)))))
|
((and (str:starts-with? "/captcha/" uri-path)
|
||||||
|
(str:ends-with? ".png" uri-path))
|
||||||
|
(image-response uri-path captcha-dir))
|
||||||
|
;; Otherwise… IDK, 404! ¯\_(ツ)_/¯
|
||||||
|
('t
|
||||||
|
(404-response)))))
|
||||||
|
|
||||||
|
|
||||||
(defun start-server (&key (address "0.0.0.0") (port 5001) (captcha-directory #p"captcha/"))
|
(defun start-server (&key (address "0.0.0.0") (port 5001) (captcha-directory #p"captcha/"))
|
||||||
|
"Start the Kaptchapelo server, which takes captcha challenges from the given
|
||||||
|
CAPTCHA-DIRECTORY. Challenges are made up of two files:
|
||||||
|
* A challenge PNG file (ex. bird.png)
|
||||||
|
* An answer TXT file (ex. bird.txt)
|
||||||
|
Note that the The answer text-file should not contain a trailing newline."
|
||||||
(clack:clackup
|
(clack:clackup
|
||||||
(lambda (env)
|
(lambda (env)
|
||||||
(funcall #'server env captcha-directory))
|
(funcall #'server env captcha-directory))
|
||||||
|
|
Ŝarĝante…
Reference in New Issue