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

- [gemini] wrapped non gemini files download's thread. 

Also added a few of useful slotslike temporary file path and number of
  bytes downloaded so far.
This commit is contained in:
cage 2020-08-28 17:20:44 +02:00
parent 8ae83a2323
commit 0bb4406be7
2 changed files with 153 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

232
src/gemini-viewer.lisp
View File

@ -81,6 +81,14 @@
:initform nil :initform nil
:initarg :download-socket :initarg :download-socket
:accessor download-socket) :accessor download-socket)
(support-file
:initform (fs:temporary-file)
:initarg :support-file
:accessor support-file)
(octect-count
:initform 0
:initarg :octect-count
:accessor octect-count)
(thread (thread
:initform nil :initform nil
:initarg :thread :initarg :thread
@ -123,66 +131,117 @@
(defclass gemini-file-stream (gemini-stream) ()) (defclass gemini-file-stream (gemini-stream) ())
(defclass gemini-others-data-stream (gemini-stream) ())
(defmacro with-open-support-file ((stream file &optional (element-type '(unsigned-byte 8)))
&body body)
`(with-open-file (,stream ,file
:element-type ',element-type
:direction :output
:element-type 'character
:if-exists :supersede
:if-does-not-exist :create)
,@body))
(defgeneric increment-bytes-count (object data &key &allow-other-keys))
(defmethod increment-bytes-count ((object gemini-stream) data
&key (convert-to-octects nil))
(with-accessors ((octect-count octect-count)) object
(if convert-to-octects
(incf octect-count (babel:string-size-in-octets data
:errorp nil))
(incf octect-count (length data)))))
(defmethod increment-bytes-count ((object gemini-stream) (data number)
&key &allow-other-keys)
(with-accessors ((octect-count octect-count)) object
(incf octect-count data)))
(defun request-stream-gemini-document-thread (wrapper-object host (defun request-stream-gemini-document-thread (wrapper-object host
port path query port path query
status-code status-code-description meta) status-code status-code-description meta)
(with-accessors ((download-socket download-socket) (with-accessors ((download-socket download-socket)
(download-stream download-stream)) wrapper-object (download-stream download-stream)
(octect-count octect-count)
(support-file support-file)) wrapper-object
(lambda () (lambda ()
(let* ((url (gemini-parser:make-gemini-uri host path query port)) (with-open-support-file (file-stream support-file character)
(parsed-url (gemini-parser:parse-gemini-file (format nil "-> ~a~%" url))) (let* ((url (gemini-parser:make-gemini-uri host path query port))
(url-response (gemini-client:make-gemini-file-response nil (parsed-url (gemini-parser:parse-gemini-file (format nil "-> ~a~%" url)))
nil (url-response (gemini-client:make-gemini-file-response nil
nil nil
parsed-url nil
nil parsed-url
"" nil
nil)) ""
(url-event (make-instance 'program-events:gemini-got-line-event nil))
:wrapper-object wrapper-object (url-event (make-instance 'program-events:gemini-got-line-event
:payload url-response :wrapper-object wrapper-object
:append-text nil))) :payload url-response
(program-events:push-event url-event) :append-text nil)))
(loop (program-events:push-event url-event)
named download-loop (loop
for line-as-array = (read-line-into-array download-stream) named download-loop
while line-as-array do for line-as-array = (read-line-into-array download-stream)
(if (downloading-allowed-p wrapper-object) while line-as-array do
(let* ((line (babel:octets-to-string line-as-array :errorp nil)) (if (downloading-allowed-p wrapper-object)
(parsed (gemini-parser:parse-gemini-file line)) (let* ((line (babel:octets-to-string line-as-array :errorp nil))
(links (gemini-parser:sexp->links parsed host port path)) (parsed (gemini-parser:parse-gemini-file line))
(response (gemini-client:make-gemini-file-response status-code (links (gemini-parser:sexp->links parsed host port path))
status-code-description (response (gemini-client:make-gemini-file-response status-code
meta status-code-description
parsed meta
url parsed
line url
links)) line
(event (make-instance 'program-events:gemini-got-line-event links))
:wrapper-object wrapper-object (event (make-instance 'program-events:gemini-got-line-event
:payload response))) :wrapper-object wrapper-object
(program-events:push-event event)) :payload response)))
(progn (write-sequence line file-stream)
(return-from download-loop nil)))) (increment-bytes-count wrapper-object line :convert-to-octects t)
(if (not (downloading-allowed-p wrapper-object)) (program-events:push-event event))
(ui:notify (_ "Gemini document downloading aborted")) (progn
(ui:notify (_ "Gemini document downloading completed"))) (return-from download-loop nil))))
(allow-downloading wrapper-object) (if (not (downloading-allowed-p wrapper-object))
(gemini-client:close-ssl-socket download-socket))))) (ui:notify (_ "Gemini document downloading aborted"))
(ui:notify (_ "Gemini document downloading completed")))
(allow-downloading wrapper-object)
(gemini-client:close-ssl-socket download-socket)))
(fs:delete-file-if-exists support-file))))
(defun request-stream-other-document-thread (socket stream host (defun request-stream-other-document-thread (wrapper-object
port path query socket
host
port
path
query
status-code status-code-description meta) status-code status-code-description meta)
(declare (ignorable host (declare (ignorable host
port path query port path query
status-code status-code-description meta)) status-code status-code-description meta))
(lambda () (with-accessors ((download-socket download-socket)
(fs:with-anaphoric-temp-file (out-stream) (download-stream download-stream)
(let* ((buffer (misc:read-all stream))) (octect-count octect-count)
(gemini-client:close-ssl-socket socket) (support-file support-file)) wrapper-object
(write-sequence buffer out-stream)
(force-output out-stream) (lambda ()
(os-utils:xdg-open fs:temp-file))))) (with-open-support-file (file-stream support-file)
(labels ((%fill-buffer ()
(multiple-value-bind (buffer read-so-far)
(read-array download-stream 1024)
(increment-bytes-count wrapper-object read-so-far)
(if (< read-so-far (length buffer))
(progn
(write-sequence buffer file-stream :start 0 :end read-so-far)
(force-output file-stream)
(gemini-client:close-ssl-socket socket)
(os-utils:xdg-open support-file))
(progn
(write-sequence buffer file-stream)
(%fill-buffer))))))
(%fill-buffer))))))
(defun request (url) (defun request (url)
(let ((parsed-uri (quri:uri url))) (let ((parsed-uri (quri:uri url)))
@ -208,9 +267,9 @@
(ui:ask-string-input #'on-input-complete (ui:ask-string-input #'on-input-complete
:hide-input hide-input :hide-input hide-input
:prompt (format nil :prompt (format nil
(_ "Server ~s asks: ~s ") (_ "Server ~s asks: ~s ")
host host
prompt))))) prompt)))))
(multiple-value-bind (status code-description meta response socket) (multiple-value-bind (status code-description meta response socket)
(gemini-client:request host (gemini-client:request host
path path
@ -238,35 +297,44 @@
((gemini-client:response-sensitive-input-p status) ((gemini-client:response-sensitive-input-p status)
(get-user-input t host meta)) (get-user-input t host meta))
((streamp response) ((streamp response)
(let ((stream response)) (if (gemini-client:mime-gemini-p meta)
(if (gemini-client:mime-gemini-p meta) (let* ((gemini-stream (make-instance 'gemini-file-stream
(let* ((gemini-stream (make-instance 'gemini-file-stream :download-stream response
:download-stream response :download-socket socket))
:download-socket socket)) (thread-fn
(thread-fn (request-stream-gemini-document-thread gemini-stream
(request-stream-gemini-document-thread gemini-stream host
host port
port path
path query
query status
status code-description
code-description meta)))
meta))) (downloading-start-thread gemini-stream
(downloading-start-thread gemini-stream thread-fn
thread-fn host
host port
port path
path query))
query)) (let* ((gemini-stream (make-instance 'gemini-others-data-stream
(bt:make-thread (request-stream-other-document-thread socket :download-stream response
stream :download-socket socket))
host (thread-fn
port (request-stream-other-document-thread gemini-stream
path socket
query host
status port
code-description path
meta)))))))) query
status
code-description
meta)))
(downloading-start-thread gemini-stream
thread-fn
host
port
path
query)))))))
(gemini-client:gemini-tofu-error (e) (gemini-client:gemini-tofu-error (e)
(let ((host (gemini-client:host e))) (let ((host (gemini-client:host e)))
(flet ((on-input-complete (maybe-accepted) (flet ((on-input-complete (maybe-accepted)

6
src/misc-utils.lisp
View File

@ -453,9 +453,9 @@ Name from Emacs Lisp."
(defun read-array (stream size &key (offset nil)) (defun read-array (stream size &key (offset nil))
(when offset (when offset
(file-position stream offset)) (file-position stream offset))
(let* ((bytes (misc-utils:make-array-frame size 0 '(unsigned-byte 8) t))) (let* ((bytes (misc-utils:make-array-frame size 0 '(unsigned-byte 8) t))
(read-sequence bytes stream) (read-so-far (read-sequence bytes stream)))
bytes)) (values bytes read-so-far)))
(defun read-all (stream) (defun read-all (stream)
"Read all the octent from stream ad returns them as array" "Read all the octent from stream ad returns them as array"