From 6196810bbb6ac2377aeaf2d3dd1f0fe6d3ec5386 Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 21 Aug 2022 11:39:40 +0200 Subject: [PATCH] - [gopher] implemented a basic parser. --- src/gemini/package.lisp | 4 +- src/gopher/client.lisp | 17 +++ src/gopher/package.lisp | 81 ++++++++++++ src/gopher/parser.lisp | 281 ++++++++++++++++++++++++++++++++++++++++ tinmop.asd | 4 + 5 files changed, 385 insertions(+), 2 deletions(-) create mode 100644 src/gopher/client.lisp create mode 100644 src/gopher/package.lisp create mode 100644 src/gopher/parser.lisp diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index cb76ccd..9312a5a 100644 --- a/src/gemini/package.lisp +++ b/src/gemini/package.lisp @@ -1,5 +1,5 @@ -;; tinmop: an humble gemini and pleroma client -;; Copyright (C) 2020 cage +;; 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 diff --git a/src/gopher/client.lisp b/src/gopher/client.lisp new file mode 100644 index 0000000..b4ed41c --- /dev/null +++ b/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 . + +(in-package :gopher-client) diff --git a/src/gopher/package.lisp b/src/gopher/package.lisp new file mode 100644 index 0000000..f4aec43 --- /dev/null +++ b/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 . + +(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+)) diff --git a/src/gopher/parser.lisp b/src/gopher/parser.lisp new file mode 100644 index 0000000..b3ade66 --- /dev/null +++ b/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 . + +(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)))) diff --git a/tinmop.asd b/tinmop.asd index 2245660..0d0f4c4 100644 --- a/tinmop.asd +++ b/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")