;CL-GOPHER - Provide a GOPHER protocol (RFC 1436) client. ;Copyright (C) 2019 Prince Trippy programmer@verisimilitudes.net . ;This program is free software: you can redistribute it and/or modify it under the terms of the ;GNU Affero General Public License version 3 as published by the Free Software Foundation. ;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 Affero General Public License for more details. ;You should have received a copy of the GNU Affero General Public License along with this program. ;If not, see . #-ascii (error "The CL-GOPHER program may misbehave if the Common Lisp doesn't support ASCII.") (cl:defpackage #:cl-gopher (:documentation "This package implements a Gopher protocol client, but not an interface.") (:use #:common-lisp) (:export #:gopher-error #:gopher-entry-error #:gopher-error-type #:gopher-error-value #:entry #:entry-type #:entry-name #:entry-selector #:entry-host #:entry-port #:entry+ #:entry-resource #:parse-menu #:parse-entry #:write-selector) (:nicknames #:gopher)) (cl:in-package #:cl-gopher) (defconstant crlf (format nil "~c~c" (code-char 13) (code-char 10)) "This is the CARRIAGE RETURN followed by LINE FEED line separator.") (defconstant tab (code-char 9) "This is the HORIZONTAL TAB field separator.") (defvar types (pairlis '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\+ #\T #\g #\I #\h #\i #\s) '(:text :menu :CCSO :error :binhex :dos :uuencode :search :telnet :binary :redundant :tn3270 :gif :image :html :information :sound)) "This is the alist of Gopher type to KEYWORD mappings.") (define-condition gopher-error (error) () (:documentation "This is the base condition for all CL-GOPHER conditions.")) (define-condition gopher-entry-error (gopher-error) ((type :initarg :type :reader gopher-error-type :type (or character (member :type :name :selector :host :port :+)) :initform (error "A GOPHER-ENTRY-ERROR must have a TYPE.") :documentation "The Gopher entry slot related to the error.") (value :initarg :value :reader gopher-error-value :initform (error "A GOPHER-ENTRY-ERROR must have a VALUE.") :documentation "The Gopher entry slot value related to the error.")) (:documentation "This is the error associated with individual Gopher menu entries.") (:report (lambda (condition stream) (format stream "A Gopher entry field, ~(~s~), has a value of ~s." (gopher-error-type condition) (gopher-error-value condition))))) (defclass entry () ((type :accessor entry-type :initarg :type :type (or character keyword) :initform (error 'gopher-error :type :type :value nil) :documentation "The type of the entry's resource.") (name :accessor entry-name :initarg :name :initform "" :type string :documentation "The user display string of the entry.") (selector :accessor entry-selector :initarg :selector :initform "" :type string :documentation "The server identity of the entry.") (host :accessor entry-host :initarg :host :initform "" :type string :documentation "The host of the entry's resource.") (port :accessor entry-port :initarg :port :initform 70 :type unsigned-byte :documentation "The port on the host of the entry's resource.") (+ :accessor entry+ :initarg :+ :initform () :type list :documentation "The Gopher+ and other extra data of the entry.") (resource :accessor entry-resource :initarg :resource :initform nil :type t :documentation "The Gopher resource of the entry."))) (defun write-selector (string &optional (stream *standard-output*) &aux (*standard-output* stream)) "Write the selector STRING to STREAM." (write-string string) (write-string crlf)) (defun parse-entry (string) "Translate a string of a single line representing a Gopher menu entry into an ENTRY object. For malformed entries, GOPHER-ENTRY-ERROR will be signalled with a STORE-VALUE restart ready. If the string is entirely empty, a GOPHER-ENTRY-ERROR is signalled without a restart." (and (zerop (length string)) (error 'gopher-entry-error :type :type :value nil)) (destructuring-bind (&optional name selector host port &rest +) (loop :with first = 1 :for second :from 1 :to (1- (length string)) :if (char= tab (char string second)) :collect (subseq string first second) and do (setq first (1+ second)) :if (= second (1- (length string))) :collect (subseq string first)) (macrolet ((restart (symbol string &rest list) `(loop (if ,symbol (return) (restart-case (error 'gopher-entry-error :value ,symbol ,@list) (store-value (use-value) :report ,string :interactive (lambda () (list (read-line *query-io*))) (setq ,symbol use-value))))))) (restart name "Provide a name string to be used." :type :name) (restart selector "Provide a selector string to be used." :type :selector) (restart host "Provide the host name to be used." :type :host) (loop (let ((integer (cond ((integerp port) port) ((stringp port) (ignore-errors (parse-integer port)))))) (if (integerp integer) (progn (setq port integer) (return)) (restart-case (error 'gopher-entry-error :type :port :value port) (store-value (use-value) :report "Provide a port number as an integer or a string." :interactive (lambda (&aux *read-eval*) (list (read *query-io*))) (setq port use-value))))))) (make-instance 'entry :type (or (cdr (assoc (char string 0) types)) (char string 0)) :name name :selector selector :host host :port port :+ +))) (defun parse-menu (string) "Translate a string representing a Gopher menu, into a list of ENTRY objects. An invalid entry can be ignored through the DISCARD-ENTRY restart. A continuable GOPHER-ERROR will be signalled if the menu ends improperly." (loop :for first = 0 :then (+ 2 position) :for position = (ignore-errors (search crlf string :start2 first :test 'string=)) :for subseq = (subseq string first position) :until (string= "." subseq) :for entry = (restart-case (parse-entry subseq) (discard-entry () :report (lambda (stream) (format stream "Discard invalid menu entry: ~s" subseq)))) :if entry :collect entry :while position :finally (if (string/= "." subseq) (cerror "The menu ended improperly." 'gopher-error)))) .