cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- fixed 'fs:split-path-elements' 

- before:

    (fs:split-path-elements "/a/b") ;=> ("" "a" "b")

    (fs:split-path-elements "/a/b") ;=> ("a" "b")

- [gopher] added 'client:request'.
This commit is contained in:
cage 2022-08-25 14:20:06 +02:00
parent 6196810bbb
commit a393b0ba88
4 changed files with 155 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/filesystem-utils.lisp
View File

@ -251,15 +251,16 @@
(nix:s-isdir (nix:stat-mode (nix:stat path))))))
(defun split-path-elements (path)
(cl-ppcre:split *directory-sep-regexp* path))
(let ((splitted (cl-ppcre:split *directory-sep-regexp* path)))
(substitute *directory-sep* "" splitted :test #'string=)))
(defun path-last-element (path)
(let ((elements (cl-ppcre:split *directory-sep-regexp* path)))
(let ((elements (split-path-elements path)))
(and elements
(last-elt elements))))
(defun path-first-element (path)
(let ((elements (cl-ppcre:split *directory-sep-regexp* path)))
(let ((elements (split-path-elements path)))
(and elements
(first-elt elements))))

107
src/gopher/client.lisp
View File

@ -15,3 +15,110 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :gopher-client)
(a:define-constant +request-terminal+ (format nil "~a~a" #\Return #\Newline) :test #'string=)
(a:define-constant +response-terminal+ (format nil ".~a~a" #\Return #\Newline) :test #'string=)
(a:define-constant +response-read-buffer-size+ 4096 :test #'=)
(defun make-collect-fn (collected)
(lambda (buffer)
(loop for b across buffer do
(vector-push-extend b collected 1024))))
(defun %request (host &key
(port 70)
(selector "")
(terminate-strategy :response-teminal)
(collect-fn (lambda (data) (format t "~a" (to-s data)))))
(flet ((open-socket (hostname port)
(usocket:socket-connect hostname
port
:element-type '(unsigned-byte 8)))
(end-response-p (read-so-far buffer)
(if (< read-so-far (length buffer))
t
(let ((maybe-terminal-data (subseq buffer
(- read-so-far
(length +response-terminal+))
read-so-far)))
(and (eq terminate-strategy :response-terminal)
(string= (to-s maybe-terminal-data)
+response-terminal+))))))
(let* ((socket (open-socket host port))
(stream (usocket:socket-stream socket)))
(write-sequence (babel:string-to-octets (format nil
"~a~a"
selector
+request-terminal+))
stream)
(finish-output stream)
(let* ((buffer (misc:make-fresh-array +response-read-buffer-size+
0
'(unsigned-byte 8)
t))
(first-chunk-size (read-sequence buffer stream)))
(funcall collect-fn (subseq buffer 0 first-chunk-size))
(loop for read-so-far = first-chunk-size
while (not (end-response-p read-so-far buffer))
do
(format t "~a~%" read-so-far)
(funcall collect-fn (subseq buffer 0 read-so-far)))))))
(defmacro gen-request-function (return-types strategies)
`(defun ,(format-fn-symbol t "request")
(host response-type
&key
(port 70)
(selector "")
(collect-fn (lambda (data) (format t "~a" (to-s data)))))
(cond
,@(append
(loop for return-type in return-types
for strategy in strategies
collect
`((string= response-type ,return-type)
(%request host
:port port
:selector selector
:terminate-strategy ,strategy
:collect-fn collect-fn)))
`(((string= response-type +line-type-uri+)
(open-message-link-window:open-message-link selector nil)))
`((t
(error 'conditions:not-implemented-error
:text (format nil (_ "This line type ~s in not supported") response-type))))))))
(gen-request-function (+line-type-file+
+line-type-dir+
+line-type-error+
+line-type-mac-hex-file+
+line-type-dos-archive-file+
+line-type-uuencoded-file+
+line-type-index-search+
+line-type-binary-file+
+line-type-gif-image-file+
+line-type-image-file+
+line-type-info+)
(:response-teminal
:response-teminal
:response-teminal
nil
nil
nil
:response-teminal
nil
nil
nil
:response-teminal))
(defun request-from-iri (iri &optional (collect-function (lambda (data)
(format t "~a" (to-s data)))))
(multiple-value-bind (host port type selector)
(parse-iri iri)
(request host
type
:port port
:selector selector
:collect-fn collect-function)))

22
src/gopher/package.lisp
View File

@ -25,6 +25,7 @@
:misc)
(:local-nicknames (:a :alexandria))
(:export
:+gopher-scheme+
:+line-type-file+
:+line-type-dir+
:+line-type-cso+
@ -35,7 +36,10 @@
:+line-type-index-search+
:+line-type-telnet-session+
:+line-type-binary-file+
:+gopher-scheme+
:+line-type-gif-image-file+
:+line-type-image-file+
:+line-type-info+
:+line-type-uri+
:line-file
:line-dir
:line-cso
@ -50,6 +54,7 @@
:line-tn3270-session
:line-gif-file
:line-image-file
:line-uri
:line-file-p
:line-dir-p
:line-cso-p
@ -64,18 +69,21 @@
:line-tn3270-session-p
:line-gif-file-p
:line-image-file-p
:parse-menu))
:line-image-uri-p
:parse-menu
:parse-iri))
(defpackage gopher-client
(:use
:cl
:cl-ppcre
:esrap
:config
:constants
:text-utils
:misc
:gemini-constants)
(:local-nicknames (:a :alexandria))
(:export
:+gopher-scheme+))
:gopher-parser)
(:local-nicknames (:a :alexandria)
(:parser :gopher-parser))
(:export
:request
:request-from-iri))

31
src/gopher/parser.lisp
View File

@ -40,7 +40,9 @@
(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")))
(image-file "I" "identifier for an image file")
(info "i" "information line")
(uri "h" "hyperlink")))
(a:define-constant +gopher-scheme+ "gopher" :test #'string=)
@ -80,6 +82,10 @@
(%gen-check-line-predicate image-file +line-type-image-file+)
(%gen-check-line-predicate info +line-type-info+)
(%gen-check-line-predicate uri +line-type-uri+)
(defclass gopher-line ()
((username
:initarg :username
@ -143,6 +149,10 @@
(gen-selector-class line-image-file)
(gen-selector-class line-info)
(gen-selector-class line-uri)
(defun check-line-type (data reference)
(typep data reference))
@ -179,6 +189,10 @@
(gen-check-line-predicate image-file 'line-image-file)
(gen-check-line-predicate info 'line-info)
(gen-check-line-predicate uri 'line-uri)
(defrule line-separator (and #\Return #\Newline)
(:constant :line-separator))
@ -273,9 +287,22 @@
((%line-type-gif-file-p line-type)
(make-instance 'line-gif-file))
((%line-type-image-file-p line-type)
(make-instance 'line-image-file)))))
(make-instance 'line-image-file))
((%line-type-info-p line-type)
(make-instance 'line-info))
((%line-type-uri-p line-type)
(make-instance 'line-uri)))))
(setf (username instance) (getf entry :user-name)
(selector instance) (getf entry :selector)
(host instance) (getf entry :host)
(port instance) (getf entry :port))
instance))))
(defun parse-iri (iri)
(let* ((parsed (iri:iri-parse iri))
(host (uri:host parsed))
(port (uri:port parsed))
(path (uri:path parsed))
(type (second (fs:split-path-elements path)))
(selector (subseq path (+ 2 (length type)))))
(values host port type selector)))