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

- moved to an internal wrapping of 'mkstemp' to allow extensions in filename; 

- [gemini] rendering all stream with MIME type "text/*" with this program.
This commit is contained in:
cage 2021-04-01 17:08:42 +02:00
parent 9a20e187e9
commit 61c39b6c62
6 changed files with 166 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
etc/shared.conf
View File

@ -176,4 +176,6 @@ color-regexp = ":rendering" cyan
# if you want to open some kind of file with tinmop try the following
# valid values are "tinmop" "me" "internal"
# ▼▼▼▼▼▼▼▼
open "gmi$" with "tinmop"
open "gmi$" with "tinmop"
open "txt$" with "tinmop"
open ".sh$" with "tinmop"

31
src/filesystem-utils.lisp
View File

@ -166,7 +166,8 @@
(nix:s-isreg (nix:stat-mode (nix:stat path))))
(defun dirp (path)
(nix:s-isdir (nix:stat-mode (nix:stat path))))
(and (nix:stat path)
(nix:s-isdir (nix:stat-mode (nix:stat path)))))
(defun split-path-elements (path)
(cl-ppcre:split *directory-sep-regexp* path))
@ -265,20 +266,28 @@
(text-utils:strcat home *directory-sep*)
home)))
(cffi:defcfun (ffi-mkstemp "mkstemp") :int (template :pointer))
(defun %mkstemp (prefix suffix)
(let ((template (text-utils:strcat prefix "XXXXXX" suffix)))
(cffi:with-foreign-string (ptr-template template)
(ffi-mkstemp ptr-template)
(cffi:foreign-string-to-lisp ptr-template))))
(defparameter *temporary-files-created* ())
(defun temporary-file (&optional (temp-directory nil))
(defun temporary-file (&key (temp-directory nil) (extension ""))
(let ((tmpdir (or temp-directory
(os-utils:default-temp-dir))))
(multiple-value-bind (x filename)
(if tmpdir
(nix:mkstemp (format nil "~a~a~a" tmpdir *directory-sep*
config:+program-name+))
(nix:mkstemp (format nil "~atmp~a~a" *directory-sep* *directory-sep*
config:+program-name+)))
(declare (ignore x))
(push filename *temporary-files-created*)
filename)))
(let ((filepath (if tmpdir
(%mkstemp (format nil "~a~a~a" tmpdir *directory-sep*
config:+program-name+)
extension)
(%mkstemp (format nil "~atmp~a~a" *directory-sep* *directory-sep*
config:+program-name+)
extension))))
(push filepath *temporary-files-created*)
filepath)))
(defun clean-temporary-files ()
(dolist (temporary-file *temporary-files-created*)

225
src/gemini-viewer.lisp
View File

@ -335,53 +335,69 @@
(swconf:gemini-default-favicon)))))))
(defun request-stream-gemini-document-thread (wrapper-object host
port path query fragment favicon)
port path query fragment favicon
gemini-format-p)
(with-accessors ((download-socket download-socket)
(download-stream download-stream)
(octect-count octect-count)
(support-file support-file)) wrapper-object
(flet ((maybe-render-line (line-event)
(when (eq (stream-status wrapper-object) :rendering)
(program-events:push-event line-event))))
(labels ((maybe-render-line (line-event)
(when (eq (stream-status wrapper-object) :rendering)
(program-events:push-event line-event)))
(maybe-render-preformat-wrapper (file-stream wrapper-object)
(when (not gemini-format-p)
(let* ((preformat-line (format nil "~a~%" gemini-parser:+preformatted-prefix+))
(preformat-wrapper-event (make-gemini-download-event preformat-line
wrapper-object
t)))
(maybe-render-line preformat-wrapper-event)
(write-sequence preformat-line file-stream)))))
(lambda ()
(when-let ((extension (fs:get-extension path)))
(setf support-file (fs:temporary-file :extension extension)))
(with-open-support-file (file-stream support-file character)
(let* ((url (gemini-parser:make-gemini-iri host
path
:query query
:port port
:fragment fragment))
(url-header (format nil "~a ~a~2%" favicon url))
(parsed-url (gemini-parser:parse-gemini-file url-header))
(url-response (gemini-client:make-gemini-file-response nil
nil
nil
parsed-url
nil
""
nil))
(url-event (make-instance 'program-events:gemini-got-line-event
:wrapper-object wrapper-object
:payload url-response
:append-text nil)))
(let* ((url (gemini-parser:make-gemini-iri host
path
:query query
:port port
:fragment fragment))
(url-header (format nil "~a ~a~2%" favicon url))
(parsed-url (gemini-parser:parse-gemini-file url-header))
(url-response (gemini-client:make-gemini-file-response nil
nil
nil
parsed-url
nil
""
nil))
(url-event (make-instance 'program-events:gemini-got-line-event
:wrapper-object wrapper-object
:payload url-response
:append-text nil)))
(write-sequence url-header file-stream)
(increment-bytes-count wrapper-object url-header :convert-to-octects t)
(maybe-render-line url-event)
(maybe-render-preformat-wrapper file-stream wrapper-object)
(loop
named download-loop
for line-as-array = (read-line-into-array download-stream)
while line-as-array do
(gemini-client:debug-gemini "[stream] gemini file stream raw data line : ~a"
line-as-array)
(if (downloading-allowed-p wrapper-object)
(let* ((line (babel:octets-to-string line-as-array :errorp nil))
(event (make-gemini-download-event line wrapper-object t)))
(gemini-client:debug-gemini "[stream] gemini file stream got data line : ~a"
line)
(write-sequence line file-stream)
(increment-bytes-count wrapper-object line :convert-to-octects t)
(maybe-render-line event))
(progn
(return-from download-loop nil))))
named download-loop
for line-as-array = (read-line-into-array download-stream)
while line-as-array do
(gemini-client:debug-gemini "[stream] gemini file stream raw data line : ~a"
line-as-array)
(if (downloading-allowed-p wrapper-object)
(let* ((line (babel:octets-to-string line-as-array :errorp nil))
(event (make-gemini-download-event line
wrapper-object
t)))
(gemini-client:debug-gemini "[stream] gemini file stream got data line : ~a"
line)
(write-sequence line file-stream)
(increment-bytes-count wrapper-object line :convert-to-octects t)
(maybe-render-line event))
(progn
(return-from download-loop nil))))
(maybe-render-preformat-wrapper file-stream wrapper-object)
(if (not (downloading-allowed-p wrapper-object))
(ui:notify (_ "Gemini document downloading aborted"))
(progn
@ -410,6 +426,8 @@
(support-file support-file)) wrapper-object
(lambda ()
(when-let ((extension (fs:get-extension path)))
(setf support-file (fs:temporary-file :extension extension)))
(with-open-support-file (file-stream support-file)
(labels ((%fill-buffer ()
(when (downloading-allowed-p wrapper-object)
@ -422,7 +440,7 @@
(force-output file-stream)
(setf (stream-status wrapper-object) :completed)
(gemini-client:close-ssl-socket socket)
(os-utils:xdg-open support-file))
(os-utils:open-resource-with-external-program support-file nil))
(progn
(write-sequence buffer file-stream)
(%fill-buffer)))))))
@ -432,7 +450,8 @@
(lambda (status code-description meta response socket iri parsed-iri)
(declare (ignore iri))
(labels ((starting-status (meta)
(if (gemini-client:gemini-file-stream-p meta)
(if (or (gemini-client:gemini-file-stream-p meta)
(gemini-client:text-file-stream-p meta))
(if enqueue
:streaming
:rendering)
@ -443,66 +462,74 @@
(gemini-client:displace-iri parsed-iri)
(declare (ignore actual-iri))
(gemini-client:debug-gemini "response is a stream")
(if (gemini-client:gemini-file-stream-p meta)
(let* ((starting-status (starting-status meta))
(gemini-stream (make-instance 'gemini-file-stream
:host host
:port port
:path path
:query query
:fragment fragment
:meta meta
:status-code status
:status-code-description
code-description
:stream-status starting-status
:download-stream response
:download-socket socket))
(favicon (fetch-favicon parsed-iri))
(thread-fn (request-stream-gemini-document-thread gemini-stream
host
port
path
query
fragment
favicon))
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
:payload gemini-stream)))
(gemini-client:debug-gemini "response is a gemini file stream")
(program-events:push-event enqueue-event)
(downloading-start-thread gemini-stream
thread-fn
host
port
path
query
fragment))
(let* ((starting-status (starting-status meta))
(gemini-stream (make-instance 'gemini-others-data-stream
:stream-status starting-status
:download-stream response
:download-socket socket))
(thread-fn (request-stream-other-document-thread gemini-stream
socket
host
port
path
query
fragment
status
code-description
meta))
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
:payload gemini-stream)))
(gemini-client:debug-gemini "response is *not* a gemini file stream")
(program-events:push-event enqueue-event)
(downloading-start-thread gemini-stream
thread-fn
host
port
path
query
fragment)))))))
(labels ((make-text-based-stream (gemini-format-p)
(let* ((starting-status (starting-status meta))
(gemini-stream (make-instance 'gemini-file-stream
:host host
:port port
:path path
:query query
:fragment fragment
:meta meta
:status-code status
:status-code-description
code-description
:stream-status starting-status
:download-stream response
:download-socket socket))
(favicon (fetch-favicon parsed-iri))
(thread-fn (request-stream-gemini-document-thread gemini-stream
host
port
path
query
fragment
favicon
gemini-format-p))
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
:payload gemini-stream)))
(program-events:push-event enqueue-event)
(downloading-start-thread gemini-stream
thread-fn
host
port
path
query
fragment))))
(cond
((gemini-client:gemini-file-stream-p meta)
(gemini-client:debug-gemini "response is a gemini document stream")
(make-text-based-stream t))
((gemini-client:text-file-stream-p meta)
(gemini-client:debug-gemini "response is a text stream")
(make-text-based-stream nil))
(t
(let* ((starting-status (starting-status meta))
(gemini-stream (make-instance 'gemini-others-data-stream
:stream-status starting-status
:download-stream response
:download-socket socket))
(thread-fn (request-stream-other-document-thread gemini-stream
socket
host
port
path
query
fragment
status
code-description
meta))
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
:payload gemini-stream)))
(gemini-client:debug-gemini "response is *not* a gemini file stream")
(program-events:push-event enqueue-event)
(downloading-start-thread gemini-stream
thread-fn
host
port
path
query
fragment)))))))))
(defun request (url &key
(enqueue nil)

8
src/gemini/client.lisp
View File

@ -96,6 +96,9 @@
(defun mime-gemini-p (header-meta)
(string-starts-with-p "text/gemini" header-meta))
(defun mime-text-p (header-meta)
(string-starts-with-p "text/" header-meta))
(defun header-code= (header code-class)
(code= (status-code header)
code-class))
@ -451,7 +454,10 @@
,@body)))
(defun gemini-file-stream-p (meta)
(gemini-client:mime-gemini-p meta))
(mime-gemini-p meta))
(defun text-file-stream-p (meta)
(mime-text-p meta))
(defun fetch-cached-certificate (url)
(let ((certificate nil)

6
src/gemini/gemini-parser.lisp
View File

@ -49,6 +49,12 @@
(gen-geminize-line link +link-prefix+)
(defun geminize-preformatted (text)
(format nil "~a~%~a~a~%"
+preformatted-prefix+
text
+preformatted-prefix+))
(defun make-gemini-link (url title)
(format nil "~a ~a"
(geminize-link url)

4
src/gemini/package.lisp
View File

@ -37,12 +37,14 @@
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:+gemini-scheme+
:+preformatted-prefix+
:geminize-h1
:geminize-h2
:geminize-h3
:geminize-list
:geminize-quote
:geminize-link
:geminize-preformatted
:make-gemini-link
:gemini-link
:target
@ -88,6 +90,7 @@
:find-code-description
:find-code-class
:mime-gemini-p
:mime-text-stream
:gemini-protocol-error
:error-code
:error-description
@ -119,6 +122,7 @@
:debug-gemini
:request
:gemini-file-stream-p
:text-file-stream-p
:request-dispatch
:with-request-dispatch-table
:fetch-cached-certificate