commit 6b4d9ef20633b7e62988eb86b6e18da1e67519b2 from: Omar Polo date: Mon Nov 09 15:33:53 2020 UTC initial commit commit - /dev/null commit + 6b4d9ef20633b7e62988eb86b6e18da1e67519b2 blob - /dev/null blob + be303db03207df9fc05ba0ae7d7166e49d95740d (mode 644) --- /dev/null +++ .gitignore @@ -0,0 +1 @@ +*.fasl blob - /dev/null blob + 45045d9fb919400352637ac6886fd7fc68bb6901 (mode 644) --- /dev/null +++ README.md @@ -0,0 +1,8 @@ +# phos + +An experimental Gemini client written in Common Lisp. + +## License + +ISC + blob - /dev/null blob + f109d967bacfc70956ec2c0f243e931c24547d17 (mode 644) --- /dev/null +++ gemini.lisp @@ -0,0 +1,86 @@ +(in-package #:phos/gemini) + +(defparameter *default-port* 1965 + "The default port for gemini URL.") + +(defparameter *code-to-keyword* '((10 :input) + (11 :sensitive-input) + (20 :success) + (30 :redirect) + (31 :permanent-redirect) + (40 :temporary-failure) + (41 :server-unavailable) + (42 :cgi-error) + (43 :proxy-error) + (44 :slow-down) + (50 :permanent-failure) + (51 :not-found) + (52 :gone) + (53 :proxy-request-refused) + (59 :bad-request) + (60 :client-certificate-required) + (61 :certificate-not-authorised) + (62 :certificate-not-valid)) + "Maps status code to keyword name.") + +(define-condition malformed-response (error) + ((reason :initarg :reason :reader reason))) + +(defun parse-status (s) + (let* ((n (parse-integer s)) + (x (cadr (assoc n *code-to-keyword*)))) + (when x + (return-from parse-status x)) + (let* ((l (* (floor (/ n 10)) + 10)) + (x (cadr (assoc l *code-to-keyword*)))) + (if x + x + (error 'malformed-response :reason (format nil "unknown response number ~a" s)))))) + +(defun parse-response (res) + (unless (uiop:string-suffix-p res (format nil "~c~c" #\return #\newline)) + (error 'malformed-response :reason "response doesn't and with CRLF")) + (unless (< (length res) 1024) + (error 'malformed-response :reason "response is longer than 1024 bytes")) + (setf res (string-trim '(#\return #\newline) res)) + (destructuring-bind (status &optional meta) (cl-ppcre:split "\\s+" res :limit 2) + (unless meta + (error 'malformed-response :reason "missing meta")) + (list (parse-status status) meta))) + +(defun read-all-stream (in) + (with-output-to-string (out) + (loop with buffer = (make-array 1024 :element-type 'character) + for n-chars = (read-sequence buffer in) + while (< 0 n-chars) + do (write-sequence buffer out :start 0 + :end n-chars)))) + +(defun read-until (in char) + (with-output-to-string (out) + (loop for ch = (read-char in) + when (char= ch char) + return nil + do (write-char ch out)) + (write-char char out))) + +(defun do-request (host port req) + "Perform the request REQ to HOST on PORT, blocking until the +response is fetched, then return the meta and the (decoded) body." + (usocket:with-client-socket (socket stream host port) + (let ((ssl-stream (cl+ssl:make-ssl-client-stream + stream :unwrap-stream-p t + :external-format '(:utf8 :eol-style :lf) + :verify nil + :hostname host))) + (format ssl-stream "~a~c~c" req #\return #\newline) + (force-output ssl-stream) + (let ((resp (parse-response (read-until ssl-stream #\newline)))) + (values resp (read-all-stream ssl-stream)))))) + +(defun request (url) + (let* ((u (quri:uri url)) + (port (or (quri:uri-port u) 1965)) + (host (quri:uri-host u))) + (do-request host port url))) blob - /dev/null blob + a6728f74ef17bd880c198e6055a4b47da7729ec1 (mode 644) --- /dev/null +++ gemtext.lisp @@ -0,0 +1,114 @@ +(in-package #:phos/gemtext) + +(defclass element () + ((text :initarg :text))) + +(defclass title (element) + ((level :initarg :level))) + +(defclass link (element) + ((url :initarg :url))) + +(defclass item (element) + ()) + +(defclass paragraph (element) + ()) + +(defclass verbatim (element) + ((alt :initarg :alt))) + +(defun parse-title (s) + "Parse a line into a title." + (destructuring-bind (h text) + (cl-ppcre:split "\\s+" s :limit 2) + (make-instance 'title :level (length h) + :text text))) + +(defun make-link (url &optional text) + (make-instance 'link :url (quri:uri url) + :text text)) + +(defun parse-link (s) + "Parse a line into link." + (match (cl-ppcre:split "\\s+" s :limit 3) + ((list _ url) (make-link url)) + ((list _ url text) (make-link url text)))) + +(defun parse-item (s) + "Parse a line into an item" + (match (cl-ppcre:split "\\s+" s :limit 2) + ((list _ text) (make-instance 'item :text text)))) + +(defun parse-line (s) + (if (string= s "") + (make-instance 'paragraph :text s) + (case (char s 0) + (#\# (parse-title s)) + (#\= (parse-link s)) + (#\* (parse-item s)) + (otherwise (make-instance 'paragraph :text s))))) + +(defmacro markerp (line) + `(uiop:string-prefix-p "```" ,line)) + +(defun parse (in) + "Parse gemtext from the stream IN." + (loop with doc = nil + for line = (read-line in nil) + unless line + return (nreverse doc) + do (push + (if (markerp line) + (loop with label = (subseq line 3) + with content = nil + for line = (read-line in nil) + unless line + do (error "non-closed verbatim") + when (markerp line) + return (make-instance 'verbatim + :alt label + :text (format nil "~{~A~%~^~}" content)) + do (push line content)) + (parse-line line)) + doc))) + +(defun parse-string (str) + (with-input-from-string (s str) + (parse s))) + +;; (unparse +;; (with-open-file (stream #P"~/quicklisp/local-projects/phos/test.gmi") +;; (parse stream)) +;; *standard-output*) + +(defgeneric unparse (obj stream) + (:documentation "Print a textual representation of OBJ onto STREAM.")) + +(defmethod unparse ((l list) stream) + (dolist (item l) + (unparse item stream))) + +(defmethod unparse ((title title) stream) + (with-slots (text level) title + (dotimes (_ level) + (format stream "#")) + (format stream " ~a~%" text))) + +(defmethod unparse ((link link) stream) + (with-slots (url text) link + (format stream "=> ~a ~a~%" url text))) + +(defmethod unparse ((item item) stream) + (with-slots (text) item + (format stream "* ~a" text) + (terpri))) + +(defmethod unparse ((p paragraph) stream) + (with-slots (text) p + (format stream "~a" text) + (terpri))) + +(defmethod unparse ((v verbatim) stream) + (with-slots (alt text) v + (format stream "```~a~%~a```~%" alt text))) blob - /dev/null blob + 4dd6d7ccc81049f949f9085d7d6dfb50e2ff71d9 (mode 644) --- /dev/null +++ package.lisp @@ -0,0 +1,22 @@ +;;;; package.lisp + +(defpackage #:phos + (:use #:cl)) + +(defpackage #:phos/gemtext + (:documentation "Gemtext (text/gemini) parsing") + (:nicknames :gemtext) + (:use #:cl #:trivia) + (:export :element :title :link :item :paragraph :verbatim + :text :url :alt :level + :parse :parse-string :unparse)) + +(defpackage #:phos/gemini + (:documentation "Gemini (the protocol) implementation") + (:nicknames :gemini) + (:use #:cl #:trivia) + (:export :request)) + +(defpackage #:phos/ui + (:documentation "User Interface for phos") + (:use #:cl #:ltk)) blob - /dev/null blob + 0034e00ac26d68a3a2db8680e55c96e1fc5d99c4 (mode 644) --- /dev/null +++ phos.asd @@ -0,0 +1,13 @@ +;;;; phos.asd + +(asdf:defsystem #:phos + :description "An experimental Gemini client" + :author "Omar Polo " + :license "ISC" + :version "0.0.1" + :serial t + :depends-on ("quri" "cl-ppcre" "trivia" "ltk" "usocket" "cl+ssl" "cl-mime") + :components ((:file "package") + (:file "phos") + (:file "gemtext") + (:file "gemini"))) blob - /dev/null blob + 6357efcb84dbb45c6e5a960d46509d8556c152ce (mode 644) --- /dev/null +++ phos.lisp @@ -0,0 +1 @@ +(in-package #:phos) blob - /dev/null blob + 2ee8e0b5a5044bdb9ff2b474b60407e4fd0a556d (mode 644) --- /dev/null +++ test.gmi @@ -0,0 +1,18 @@ +# title 1 +## title 2 +### title 3 + +``` +verbatim text +``` + +```python +print("with alt text") +``` + +* a list +* another item + +=> gemini://gemini.omarpolo.com a capsule + +and, finally, even some text! blob - /dev/null blob + dbccf3c87a5ed3b58666dac25cd29027535476e4 (mode 644) --- /dev/null +++ ui.lisp @@ -0,0 +1,62 @@ +(in-package #:phos/ui) + +(defgeneric render (obj frame) + (:documentation "Render OBJ in the ltk FRAME")) + +(defmethod render ((l list) f) + (dolist (el l) + (render el f))) + +(defmethod render ((title gemtext:title) f) + (with-slots ((text phos/gemtext:text) + (level phos/gemtext:level)) + title + (let ((w (make-instance 'label + :master f + :text (format nil "#(level ~a) ~a" level text)))) + (pack w :side :top)))) + +(defmethod render ((link gemtext:link) f) + (with-slots ((text phos/gemtext:text) + (url phos/gemtext:url)) + link + (let ((w (make-instance 'button + :master f + :text (format nil "~a" (or text url))))) + (pack w :side :top)))) + +(defmethod render ((item gemtext:item) f) + (with-slots ((text phos/gemtext:text)) item + (let ((w (make-instance 'label + :master f + :text (format nil "* ~a" text)))) + (pack w :side :top)))) + +(defmethod render ((par gemtext:paragraph) f) + (with-slots ((text phos/gemtext:text)) par + (let ((w (make-instance 'label + :master f + :text text))) + (pack w :side :top)))) + +(defmethod render ((v gemtext:verbatim) f) + (with-slots ((text phos/gemtext:text) + (alt phos/gemtext:alt)) + v + (let ((w (make-instance 'label + :master f + :text (format nil "```~a~%~a~&```" + (or alt "") + text)))) + (pack w :side :top)))) + +(defun render-page (page) + (with-ltk () + (let ((frame (make-instance 'frame))) + (pack frame) + (render page frame)))) + +(defvar doc (with-open-file (stream #P"~/quicklisp/local-projects/phos/test.gmi") + (gemtext:parse stream))) + +;; (render-page doc)