Commit Diff


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 <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
@@ -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)