iSupport binary to stdout - clic - Clic is an command line interactive client for gopher written in Common LISP Err bitreich.org 70 hgit clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/ URL:git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/ bitreich.org 70 1Log /scm/clic/log.gph bitreich.org 70 1Files /scm/clic/files.gph bitreich.org 70 1Refs /scm/clic/refs.gph bitreich.org 70 1Tags /scm/clic/tag bitreich.org 70 1README /scm/clic/file/README.md.gph bitreich.org 70 1LICENSE /scm/clic/file/LICENSE.gph bitreich.org 70 i--- Err bitreich.org 70 1commit e929b6fefdd73d15839c62d579d04b6a15e7fb1f /scm/clic/commit/e929b6fefdd73d15839c62d579d04b6a15e7fb1f.gph bitreich.org 70 1parent f7e9f10ff74b617b12c066771b8637a9abfdc2be /scm/clic/commit/f7e9f10ff74b617b12c066771b8637a9abfdc2be.gph bitreich.org 70 hAuthor: Solene Rapenne URL:mailto:solene@perso.pw bitreich.org 70 iDate: Sun, 31 Dec 2017 16:13:16 +0100 Err bitreich.org 70 i Err bitreich.org 70 iSupport binary to stdout Err bitreich.org 70 i Err bitreich.org 70 iDiffstat: Err bitreich.org 70 i M clic.lisp | 159 +++++++++++++++++-------------- Err bitreich.org 70 i Err bitreich.org 70 i1 file changed, 87 insertions(+), 72 deletions(-) Err bitreich.org 70 i--- Err bitreich.org 70 1diff --git a/clic.lisp b/clic.lisp /scm/clic/file/clic.lisp.gph bitreich.org 70 i@@ -6,7 +6,6 @@ Err bitreich.org 70 i #+ecl Err bitreich.org 70 i (require 'sockets)) Err bitreich.org 70 i Err bitreich.org 70 i- Err bitreich.org 70 i ;;;; C binding to get terminal informations Err bitreich.org 70 i ;;;; SBCL only Err bitreich.org 70 i #+sbcl Err bitreich.org 70 i@@ -49,6 +48,9 @@ Err bitreich.org 70 i ;;; array of lines of last menu Err bitreich.org 70 i (defparameter *previous-buffer* nil) Err bitreich.org 70 i Err bitreich.org 70 i+;;; boolean if we are interactive or not Err bitreich.org 70 i+(defparameter *not-interactive* nil) Err bitreich.org 70 i+ Err bitreich.org 70 i ;;; a list containing the last viewed pages Err bitreich.org 70 i (defparameter *history* '()) Err bitreich.org 70 i Err bitreich.org 70 i@@ -98,14 +100,21 @@ Err bitreich.org 70 i ;;;; is the output interactive or a pipe ? Err bitreich.org 70 i Err bitreich.org 70 i (defun ttyp() Err bitreich.org 70 i- #+sbcl Err bitreich.org 70 i- (interactive-stream-p *standard-output*) Err bitreich.org 70 i- #+ecl Err bitreich.org 70 i- (if (= 1 (c-ttyp)) Err bitreich.org 70 i- t Err bitreich.org 70 i- nil)) Err bitreich.org 70 i+ "return t if the output is a terminal" Err bitreich.org 70 i+ ;; we use this variable in case we don't want to be interactive Err bitreich.org 70 i+ ;; like when we use a cmd arg to get an image Err bitreich.org 70 i+ (if *not-interactive* Err bitreich.org 70 i+ nil Err bitreich.org 70 i+ (progn Err bitreich.org 70 i+ #+sbcl Err bitreich.org 70 i+ (interactive-stream-p *standard-output*) Err bitreich.org 70 i+ #+ecl Err bitreich.org 70 i+ (if (= 1 (c-ttyp)) Err bitreich.org 70 i+ t Err bitreich.org 70 i+ nil)))) Err bitreich.org 70 i Err bitreich.org 70 i (defun copy-array(from) Err bitreich.org 70 i+ "return a new array containing the same elements as the parameter" Err bitreich.org 70 i (let ((dest (make-array 200 Err bitreich.org 70 i :fill-pointer 0 Err bitreich.org 70 i :initial-element nil Err bitreich.org 70 i@@ -141,16 +150,15 @@ Err bitreich.org 70 i (defun formatted-output(line) Err bitreich.org 70 i "Used to display gopher response with color one line at a time" Err bitreich.org 70 i (let ((line-type (subseq line 0 1)) Err bitreich.org 70 i- (infos (split (subseq line 1) #\Tab))) Err bitreich.org 70 i+ (field (split (subseq line 1) #\Tab))) Err bitreich.org 70 i Err bitreich.org 70 i ;; if split worked Err bitreich.org 70 i- (when (= (length infos) 4) Err bitreich.org 70 i- Err bitreich.org 70 i+ (when (= (length field) 4) Err bitreich.org 70 i (let ((line-number (+ 1 (hash-table-count *links*))) Err bitreich.org 70 i- (text (car infos)) Err bitreich.org 70 i- (uri (cadr infos)) Err bitreich.org 70 i- (host (caddr infos)) Err bitreich.org 70 i- (port (parse-integer (cadddr infos)))) Err bitreich.org 70 i+ (text (car field)) Err bitreich.org 70 i+ (uri (cadr field)) Err bitreich.org 70 i+ (host (caddr field)) Err bitreich.org 70 i+ (port (parse-integer (cadddr field)))) Err bitreich.org 70 i Err bitreich.org 70 i ;; see RFC 1436 Err bitreich.org 70 i ;; section 3.8 Err bitreich.org 70 i@@ -215,7 +223,9 @@ Err bitreich.org 70 i Err bitreich.org 70 i ;; g GIF file Err bitreich.org 70 i (check "g" Err bitreich.org 70 i- (print-with-color "selector g not implemented" 'red)) Err bitreich.org 70 i+ (setf (gethash line-number *links*) Err bitreich.org 70 i+ (make-location :host host :port port :uri uri :type line-type)) Err bitreich.org 70 i+ (print-with-color text 'red line-number)) Err bitreich.org 70 i Err bitreich.org 70 i ;; I image Err bitreich.org 70 i (check "I" Err bitreich.org 70 i@@ -226,7 +236,7 @@ Err bitreich.org 70 i ;; h http link Err bitreich.org 70 i (check "h" Err bitreich.org 70 i (setf (gethash line-number *links*) uri) Err bitreich.org 70 i- (print-with-color text 'http line-number))) Err bitreich.org 70 i+ (print-with-color text 'http line-number))) ;;;; end of known types Err bitreich.org 70 i Err bitreich.org 70 i ;; unknown type Err bitreich.org 70 i (print-with-color (format nil Err bitreich.org 70 i@@ -234,7 +244,7 @@ Err bitreich.org 70 i 'red)))))) Err bitreich.org 70 i Err bitreich.org 70 i (defun getpage(host port uri &optional (binary nil)) Err bitreich.org 70 i- "connect and display" Err bitreich.org 70 i+ "send a request and store the answer (in *buffer* if text or save a file if binary)" Err bitreich.org 70 i Err bitreich.org 70 i ;; we reset the buffer Err bitreich.org 70 i (setf *buffer* Err bitreich.org 70 i@@ -255,23 +265,33 @@ Err bitreich.org 70 i :input t Err bitreich.org 70 i :output t Err bitreich.org 70 i :element-type :default))) Err bitreich.org 70 i- Err bitreich.org 70 i ;; sending the request to the server Err bitreich.org 70 i (format stream "~a~%" uri) Err bitreich.org 70 i (force-output stream) Err bitreich.org 70 i Err bitreich.org 70 i (if binary Err bitreich.org 70 i ;; binary Err bitreich.org 70 i- ;; save into a file in $PWD Err bitreich.org 70 i- (with-open-file (output (subseq uri (1+ (position #\/ uri :from-end t))) Err bitreich.org 70 i- :element-type '(unsigned-byte 8) Err bitreich.org 70 i- :direction :output :if-exists :supersede) Err bitreich.org 70 i- (let ((buf (make-array 4096 :element-type '(unsigned-byte 8)))) Err bitreich.org 70 i- (loop for pos = (read-sequence buf stream) Err bitreich.org 70 i- while (plusp pos) Err bitreich.org 70 i- do Err bitreich.org 70 i- (write-sequence buf output :end pos)))) Err bitreich.org 70 i- Err bitreich.org 70 i+ Err bitreich.org 70 i+ ;; in terminal = save the file Err bitreich.org 70 i+ ;; not terminal = write to stdio Err bitreich.org 70 i+ (if (ttyp) Err bitreich.org 70 i+ ;; save into a file in /tmp Err bitreich.org 70 i+ (let ((filename (subseq uri (1+ (position #\/ uri :from-end t))))) Err bitreich.org 70 i+ (with-open-file (output (concatenate 'string "/tmp/" filename) Err bitreich.org 70 i+ :element-type '(unsigned-byte 8) Err bitreich.org 70 i+ :direction :output :if-exists :supersede) Err bitreich.org 70 i+ (let ((buf (make-array 4096 :element-type '(unsigned-byte 8)))) Err bitreich.org 70 i+ (loop for pos = (read-sequence buf stream) Err bitreich.org 70 i+ while (plusp pos) Err bitreich.org 70 i+ do Err bitreich.org 70 i+ (write-sequence buf output :end pos))))) Err bitreich.org 70 i+ Err bitreich.org 70 i+ ;; write to the standard output Err bitreich.org 70 i+ (let ((buf (make-array 4096 :element-type '(unsigned-byte 8)))) Err bitreich.org 70 i+ (loop for pos = (read-sequence buf stream) Err bitreich.org 70 i+ while (plusp pos) Err bitreich.org 70 i+ do Err bitreich.org 70 i+ (write-sequence buf *standard-output* :end pos)))) Err bitreich.org 70 i ;; not binary Err bitreich.org 70 i ;; for each line we receive we store it in *buffer* Err bitreich.org 70 i (loop for line = (read-line stream nil nil) Err bitreich.org 70 i@@ -283,13 +303,10 @@ Err bitreich.org 70 i "browse to the N-th link" Err bitreich.org 70 i (let ((destination (gethash key *links*))) Err bitreich.org 70 i (when destination Err bitreich.org 70 i- Err bitreich.org 70 i (cond Err bitreich.org 70 i- Err bitreich.org 70 i- ;; visit a gopher link (type 0 or 1) Err bitreich.org 70 i+ ;; visit a gopher link Err bitreich.org 70 i ((location-p destination) Err bitreich.org 70 i (visit destination)) Err bitreich.org 70 i- Err bitreich.org 70 i ;; visit http link Err bitreich.org 70 i ((search "URL:" destination) Err bitreich.org 70 i (uiop:run-program (list "xdg-open" Err bitreich.org 70 i@@ -306,7 +323,6 @@ Err bitreich.org 70 i (when (<= 1 (length *history*)) Err bitreich.org 70 i (visit (pop *history*)))) Err bitreich.org 70 i Err bitreich.org 70 i- Err bitreich.org 70 i (defun load-bookmark() Err bitreich.org 70 i "Restore the bookmark from file" Err bitreich.org 70 i (when (probe-file *bookmark-file*) Err bitreich.org 70 i@@ -344,6 +360,7 @@ Err bitreich.org 70 i (location-type bookmark) Err bitreich.org 70 i (location-uri bookmark)) Err bitreich.org 70 i 'file line-number)))) Err bitreich.org 70 i+ Err bitreich.org 70 i (defun help-shell() Err bitreich.org 70 i "show help for the shell" Err bitreich.org 70 i (format t "number : go to link n~%") Err bitreich.org 70 i@@ -357,36 +374,27 @@ Err bitreich.org 70 i Err bitreich.org 70 i (defun parse-url(url) Err bitreich.org 70 i "parse a gopher url and return a location" Err bitreich.org 70 i- (let ((url (if (and Err bitreich.org 70 i- ;; if it contains more chars than gopher:// Err bitreich.org 70 i- (<= (length "gopher://") (length url)) Err bitreich.org 70 i- ;; if it starts with gopher// with return without it Err bitreich.org 70 i- (string= "gopher://" (subseq url 0 9))) Err bitreich.org 70 i- ;; we keep the url as is Err bitreich.org 70 i- (subseq url 9) Err bitreich.org 70 i- url))) Err bitreich.org 70 i- Err bitreich.org 70 i- ;; splitting by / to get host:port and uri Err bitreich.org 70 i- (let ((infos (split url #\/))) Err bitreich.org 70 i- Err bitreich.org 70 i- ;; splitting host and port to get them Err bitreich.org 70 i- (let ((host-port (split (pop infos) #\:))) Err bitreich.org 70 i+ (let ((url (string-left-trim "gopher://" url))) Err bitreich.org 70 i Err bitreich.org 70 i- ;; create the location to visit Err bitreich.org 70 i- (make-location :host (pop host-port) Err bitreich.org 70 i+ ;; splitting with / to get host:port and uri Err bitreich.org 70 i+ ;; splitting host and port to get them Err bitreich.org 70 i+ (let* ((infos (split url #\/)) Err bitreich.org 70 i+ (host-port (split (pop infos) #\:))) Err bitreich.org 70 i Err bitreich.org 70 i- ;; default to port 70 if not supplied Err bitreich.org 70 i- :port (if host-port Err bitreich.org 70 i- (parse-integer (car host-port)) Err bitreich.org 70 i- 70) Err bitreich.org 70 i+ ;; create the location to visit Err bitreich.org 70 i+ (make-location :host (pop host-port) Err bitreich.org 70 i Err bitreich.org 70 i- ;; if type is empty we use "1" Err bitreich.org 70 i- :type (let ((type (pop infos))) Err bitreich.org 70 i- (if (< 0 (length type)) type "1")) Err bitreich.org 70 i+ ;; default to port 70 if not supplied Err bitreich.org 70 i+ :port (if host-port ;; <- empty if no port given Err bitreich.org 70 i+ (parse-integer (car host-port)) Err bitreich.org 70 i+ 70) Err bitreich.org 70 i Err bitreich.org 70 i- ;; glue remaining args between them Err bitreich.org 70 i- :uri (format nil "~{/~a~}" infos)))))) Err bitreich.org 70 i+ ;; if type is empty we default to "1" Err bitreich.org 70 i+ :type (let ((type (pop infos))) Err bitreich.org 70 i+ (if (< 0 (length type)) type "1")) Err bitreich.org 70 i Err bitreich.org 70 i+ ;; glue remaining args between them Err bitreich.org 70 i+ :uri (format nil "~{/~a~}" infos))))) Err bitreich.org 70 i Err bitreich.org 70 i (defun get-argv() Err bitreich.org 70 i "Parse argv and return it" Err bitreich.org 70 i@@ -476,11 +484,13 @@ Err bitreich.org 70 i ((string= "I" type) Err bitreich.org 70 i (let ((location (car *history*))) Err bitreich.org 70 i (uiop:run-program (list "xdg-open" Err bitreich.org 70 i- (subseq ;; get the text after last / Err bitreich.org 70 i- (location-uri location) Err bitreich.org 70 i- (1+ (position #\/ Err bitreich.org 70 i- (location-uri location) Err bitreich.org 70 i- :from-end t)))))) Err bitreich.org 70 i+ (print (concatenate 'string Err bitreich.org 70 i+ "/tmp/" Err bitreich.org 70 i+ (subseq ;; get the text after last / Err bitreich.org 70 i+ (location-uri location) Err bitreich.org 70 i+ (1+ (position #\/ Err bitreich.org 70 i+ (location-uri location) Err bitreich.org 70 i+ :from-end t)))))))) Err bitreich.org 70 i (pop *history*) Err bitreich.org 70 i (setf *buffer* (copy-array *previous-buffer*)) Err bitreich.org 70 i (setf *links* (make-hash-table)) Err bitreich.org 70 i@@ -523,7 +533,6 @@ Err bitreich.org 70 i (dotimes (i (- rows (length *buffer*))) Err bitreich.org 70 i (format t "~%")))))))) Err bitreich.org 70 i Err bitreich.org 70 i- ;; not interactive Err bitreich.org 70 i ;; display and quit Err bitreich.org 70 i (loop for line across *buffer* Err bitreich.org 70 i do Err bitreich.org 70 i@@ -582,7 +591,7 @@ Err bitreich.org 70 i Err bitreich.org 70 i (defun display-prompt() Err bitreich.org 70 i (let ((last-page (car *history*))) Err bitreich.org 70 i- (format t "gopher://~a:~a/~a~a : " Err bitreich.org 70 i+ (format t "gopher://~a:~a/~a~a / (P)rev (R)eload (B)ookmark (H)istory : " Err bitreich.org 70 i (location-host last-page) Err bitreich.org 70 i (location-port last-page) Err bitreich.org 70 i (location-type last-page) Err bitreich.org 70 i@@ -614,13 +623,19 @@ Err bitreich.org 70 i ;; default url Err bitreich.org 70 i (make-location :host "gopherproject.org" :port 70 :uri "/" :type "1"))))) Err bitreich.org 70 i Err bitreich.org 70 i- ;; if user want to drop from first page we need Err bitreich.org 70 i- ;; to look it here Err bitreich.org 70 i- (when (not (eq 'end (visit destination))) Err bitreich.org 70 i- ;; we continue to the shell if the type was 1 and we are in a terminal Err bitreich.org 70 i- (when (and (ttyp) Err bitreich.org 70 i- (string= "1" (location-type destination))) Err bitreich.org 70 i- (shell))))) Err bitreich.org 70 i+ ;; if we don't ask a menu, not going interactive Err bitreich.org 70 i+ (if (not (string= "1" (location-type destination))) Err bitreich.org 70 i+ ;; not interactive Err bitreich.org 70 i+ (progn Err bitreich.org 70 i+ (setf *not-interactive* t) Err bitreich.org 70 i+ (visit destination)) Err bitreich.org 70 i+ Err bitreich.org 70 i+ ;; if user want to drop from first page we need Err bitreich.org 70 i+ ;; to look it here Err bitreich.org 70 i+ (when (not (eq 'end (visit destination))) Err bitreich.org 70 i+ ;; we continue to the shell if we are in a terminal Err bitreich.org 70 i+ (when (ttyp) Err bitreich.org 70 i+ (shell)))))) Err bitreich.org 70 i Err bitreich.org 70 i ;; we allow ecl to use a new kind of argument Err bitreich.org 70 i ;; not sure how it works but that works Err bitreich.org 70 .