commit - /dev/null
commit + 6b4d9ef20633b7e62988eb86b6e18da1e67519b2
blob - /dev/null
blob + be303db03207df9fc05ba0ae7d7166e49d95740d (mode 644)
--- /dev/null
+++ .gitignore
+*.fasl
blob - /dev/null
blob + 45045d9fb919400352637ac6886fd7fc68bb6901 (mode 644)
--- /dev/null
+++ README.md
+# phos
+
+An experimental Gemini client written in Common Lisp.
+
+## License
+
+ISC
+
blob - /dev/null
blob + f109d967bacfc70956ec2c0f243e931c24547d17 (mode 644)
--- /dev/null
+++ gemini.lisp
+(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
+(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
+;;;; 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
+;;;; phos.asd
+
+(asdf:defsystem #:phos
+ :description "An experimental Gemini client"
+ :author "Omar Polo <op@omarpolo.com>"
+ :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
+(in-package #:phos)
blob - /dev/null
blob + 2ee8e0b5a5044bdb9ff2b474b60407e4fd0a556d (mode 644)
--- /dev/null
+++ test.gmi
+# 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
+(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)