- [gopher] implemented a basic parser.

src/gemini/package.lisp

@@ -1,5 +1,5 @@
-;; tinmop: an humble gemini and pleroma client
+;; tinmop: an humble gemini kami and pleroma client
-;; Copyright (C) 2020  cage
+;; Copyright © 2022  cage
 
 ;; This program is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by

src/gopher/client.lisp

@@ -0,0 +1,17 @@
+;; tinmop: an humble gemini kami and pleroma client
+;; Copyright © 2022  cage
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(in-package :gopher-client)

src/gopher/package.lisp

@@ -0,0 +1,81 @@
+;; tinmop: an humble gemini kami and pleroma client
+;; Copyright © 2022  cage
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(defpackage gopher-parser
+  (:use
+   :cl
+   :cl-ppcre
+   :esrap
+   :config
+   :constants
+   :text-utils
+   :misc)
+  (:local-nicknames (:a :alexandria))
+  (:export
+   :+line-type-file+
+   :+line-type-dir+
+   :+line-type-cso+
+   :+line-type-error+
+   :+line-type-mac-hex-file+
+   :+line-type-dos-archive-file+
+   :+line-type-uuencoded-file+
+   :+line-type-index-search+
+   :+line-type-telnet-session+
+   :+line-type-binary-file+
+   :+gopher-scheme+
+   :line-file
+   :line-dir
+   :line-cso
+   :line-error
+   :line-mac-hex-file
+   :line-dos-archive-file
+   :line-dos-uuencoded-file
+   :line-index-search
+   :line-telnet-session
+   :line-binary-file
+   :line-redundant-server
+   :line-tn3270-session
+   :line-gif-file
+   :line-image-file
+   :line-file-p
+   :line-dir-p
+   :line-cso-p
+   :line-error-p
+   :line-mac-hex-file-p
+   :line-dos-archive-file-p
+   :line-uuencoded-file-p
+   :line-index-search-p
+   :line-telnet-session-p
+   :line-binary-file-p
+   :line-redundant-server-p
+   :line-tn3270-session-p
+   :line-gif-file-p
+   :line-image-file-p
+   :parse-menu))
+
+(defpackage gopher-client
+  (:use
+   :cl
+   :cl-ppcre
+   :esrap
+   :config
+   :constants
+   :text-utils
+   :misc
+   :gemini-constants)
+   (:local-nicknames (:a :alexandria))
+   (:export
+    :+gopher-scheme+))

src/gopher/parser.lisp

@@ -0,0 +1,281 @@
+;; tinmop: an humble gemini kami and pleroma client
+;; Copyright © 2022  cage
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(in-package :gopher-parser)
+
+(defmacro def-line-type-constant (name value documentation)
+  `(a:define-constant ,(format-fn-symbol t "+line-type-~a+" name) ,value
+     :test #'string=
+     :documentation ,documentation))
+
+(defmacro gen-line-constants (name-values-doc-list)
+  `(progn
+     ,@(loop for data in name-values-doc-list
+             collect
+             `(def-line-type-constant ,(first  data) ,(second data) ,(third data)))))
+
+(gen-line-constants ((file             "0" "identifier for a file")
+                     (dir              "1" "identifier for a directory")
+                     (cso              "2" "identifier for a CSO phone-book server")
+                     (error            "3" "identifier for an error")
+                     (mac-hex-file     "4" "identifier for a BinHexed Macintosh file")
+                     (dos-archive-file "5" "identifier for a DOS binary archive of some sort")
+                     (uuencoded-file   "6" "identifier for a UNIX uuencoded file")
+                     (index-search     "7" "identifier for Index-Search server")
+                     (telnet-session   "8" "identifier for a text-based telnet session.")
+                     (binary-file      "9" "identifier for a binary file")
+                     (redundant-server "+" "identifier for a redundant server")
+                     (tn3270-session   "T" "identifier for a tn3270 session")
+                     (gif-image-file   "g" "identifier for an image in GIF")
+                     (image-file       "I" "identifier for an image file")))
+
+(a:define-constant +gopher-scheme+ "gopher" :test #'string=)
+
+(defun %check-line-type (data reference)
+  (string= data reference))
+
+(defmacro %gen-check-line-predicate (name reference)
+  (a:with-gensyms (data)
+  `(defun ,(format-fn-symbol t "%line-type-~a-p" name) (,data)
+     (%check-line-type ,data ,reference))))
+
+(%gen-check-line-predicate file             +line-type-file+)
+
+(%gen-check-line-predicate dir              +line-type-dir+)
+
+(%gen-check-line-predicate cso              +line-type-cso+)
+
+(%gen-check-line-predicate error            +line-type-error+)
+
+(%gen-check-line-predicate mac-hex-file     +line-type-mac-hex-file+)
+
+(%gen-check-line-predicate dos-archive-file +line-type-dos-archive-file+)
+
+(%gen-check-line-predicate uuencoded-file   +line-type-uuencoded-file+)
+
+(%gen-check-line-predicate index-search     +line-type-index-search+)
+
+(%gen-check-line-predicate telnet-session   +line-type-telnet-session+)
+
+(%gen-check-line-predicate binary-file      +line-type-binary-file+)
+
+(%gen-check-line-predicate redundant-server +line-type-redundant-server+)
+
+(%gen-check-line-predicate tn3270-session   +line-type-tn3270-session+)
+
+(%gen-check-line-predicate gif-file         +line-type-gif-image-file+)
+
+(%gen-check-line-predicate image-file       +line-type-image-file+)
+
+(defclass gopher-line ()
+  ((username
+    :initarg :username
+    :initform ""
+    :accessor username
+    :type     string)
+   (selector
+    :initarg :selector
+    :initform ""
+    :accessor selector
+    :type     string)
+   (host
+    :initarg :host
+    :initform ""
+    :accessor host
+    :type     string)
+   (port
+    :initarg :port
+    :initform -1
+    :accessor port
+    :type     number)))
+
+(defmethod print-object ((object gopher-line) stream)
+  (with-accessors ((username username)
+                   (selector selector)
+                   (host     host)
+                   (port     port)) object
+    (print-unreadable-object (object stream :type t)
+      (format stream
+              "username: ~s selector: ~s host: ~s port ~a"
+              username selector host port))))
+
+(defmacro gen-selector-class (name)
+  `(defclass ,name (gopher-line) ()))
+
+(gen-selector-class line-file)
+
+(gen-selector-class line-dir)
+
+(gen-selector-class line-cso)
+
+(gen-selector-class line-error)
+
+(gen-selector-class line-mac-hex-file)
+
+(gen-selector-class line-dos-archive-file)
+
+(gen-selector-class line-uuencoded-file)
+
+(gen-selector-class line-index-search)
+
+(gen-selector-class line-telnet-session)
+
+(gen-selector-class line-binary-file)
+
+(gen-selector-class line-redundant-server)
+
+(gen-selector-class line-tn3270-session)
+
+(gen-selector-class line-gif-file)
+
+(gen-selector-class line-image-file)
+
+(defun check-line-type (data reference)
+  (typep data reference))
+
+(defmacro gen-check-line-predicate (name reference)
+  (a:with-gensyms (data)
+  `(defun ,(format-fn-symbol t "line-type-~a-p" name) (,data)
+     (check-line-type ,data ,reference))))
+
+(gen-check-line-predicate file             'line-file)
+
+(gen-check-line-predicate dir              'line-dir)
+
+(gen-check-line-predicate cso              'line-cso)
+
+(gen-check-line-predicate error            'line-error)
+
+(gen-check-line-predicate mac-hex-file     'line-mac-hex-file)
+
+(gen-check-line-predicate dos-archive-file 'line-dos-archive-file)
+
+(gen-check-line-predicate uuencoded-file   'line-uuencoded-file)
+
+(gen-check-line-predicate index-search     'line-index-search)
+
+(gen-check-line-predicate telnet-session   'line-telnet-session)
+
+(gen-check-line-predicate binary-file      'line-binary-file)
+
+(gen-check-line-predicate redundant-server 'line-redundant-server)
+
+(gen-check-line-predicate tn3270-session   'line-tn3270-session)
+
+(gen-check-line-predicate gif-file         'line-gif-image-file)
+
+(gen-check-line-predicate image-file       'line-image-file)
+
+(defrule line-separator (and #\Return #\Newline)
+  (:constant :line-separator))
+
+(defrule field-separator #\tab
+  (:constant :field-separator))
+
+(defrule null-char #\Nul
+  (:constant :field-separator))
+
+(defrule unascii (not (or field-separator line-separator null-char))
+  (:text t))
+
+(defrule last-line (and #\. line-separator)
+  (:constant :last-line))
+
+(defrule text-block (+ (not last-line))
+  (:text t))
+
+(defrule line-type unascii
+  (:text t))
+
+(defrule red-type (and #\+ #\.)
+  (:constant :red-type))
+
+(defrule user-name (* unascii)
+  (:text t))
+
+(defrule selector (* unascii)
+  (:text t))
+
+(defrule hostname-component (* (not (or field-separator line-separator null-char
+                                        #\.)))
+  (:text t))
+
+(defrule host (and (* (and hostname-component #\.))
+                   hostname-component)
+  (:text t))
+
+(defrule digit (character-ranges #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+  (:text t))
+
+(defrule digit-sequence (and digit (* digit))
+  (:text t))
+
+(defrule port digit-sequence
+  (:function parse-integer))
+
+(defrule dir-entity (and line-type user-name field-separator
+                         selector field-separator
+                         host field-separator
+                         port line-separator)
+  (:function (lambda (line)
+               (list :type (first line)
+                     :user-name (second line)
+                     :selector  (fourth line)
+                     :host      (sixth  line)
+                     :port      (elt    line 7)))))
+
+(defrule menu (and (* dir-entity) last-line)
+  (:function first))
+
+(defun parse-menu (data)
+  (let ((menu (parse 'menu data)))
+    (loop for entry in menu
+          collect
+          (let* ((line-type (getf entry :type))
+                 (instance  (cond
+                              ((%line-type-file-p line-type)
+                               (make-instance 'line-file))
+                              ((%line-type-dir-p line-type)
+                               (make-instance 'line-dir))
+                              ((%line-type-cso-p line-type)
+                               (make-instance 'line-cso))
+                              ((%line-type-error-p line-type)
+                               (make-instance 'line-error))
+                              ((%line-type-mac-hex-file-p line-type)
+                               (make-instance 'line-mac-hex-file))
+                              ((%line-type-dos-archive-file-p line-type)
+                               (make-instance 'line-dos-archive-file))
+                              ((%line-type-uuencoded-file-p line-type)
+                               (make-instance 'line-uuencoded-file))
+                              ((%line-type-index-search-p line-type)
+                               (make-instance 'line-index-search))
+                              ((%line-type-telnet-session-p line-type)
+                               (make-instance 'line-telnet-session))
+                              ((%line-type-binary-file-p line-type)
+                               (make-instance 'line-binary-file))
+                              ((%line-type-redundant-server-p line-type)
+                               (make-instance 'line-redundant-server))
+                              ((%line-type-tn3270-session-p line-type)
+                               (make-instance 'line-tn3270-session))
+                              ((%line-type-gif-file-p line-type)
+                               (make-instance 'line-gif-file))
+                              ((%line-type-image-file-p line-type)
+                               (make-instance 'line-image-file)))))
+            (setf (username instance) (getf entry :user-name)
+                  (selector instance) (getf entry :selector)
+                  (host     instance) (getf entry :host)
+                  (port     instance) (getf entry :port))
+            instance))))

tinmop.asd

@@ -100,6 +100,10 @@
                (:module kami
                 :components ((:file "package")
                              (:file "client")))
+               (:module gopher
+                :components ((:file "package")
+                             (:file "parser")
+                             (:file "client")))
                (:file "command-line")
                (:file "specials")
                (:file "keybindings")