Display unknown types. Replace tab with spaces - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
(DIR) commit 25487c3c561873fda304042df02ed8c68575ce20
(DIR) parent 165bb9a2db7f522d83e612c35b24a19d5b673517
(HTM) Author: Solene Rapenne <solene@perso.pw>
Date: Thu, 28 Dec 2017 11:45:34 +0100
Display unknown types. Replace tab with spaces
Diffstat:
M clic.lisp | 314 ++++++++++++++++---------------
1 file changed, 160 insertions(+), 154 deletions(-)
---
(DIR) diff --git a/clic.lisp b/clic.lisp
@@ -62,7 +62,7 @@
;;; List of allowed item types
(defparameter *allowed-selectors*
(list "0" "1" "2" "3" "4" "5" "6" "i"
- "h" "7" "8" "9" "+" "T" "g" "I"))
+ "h" "7" "8" "9" "+" "T" "g" "I"))
;;;; BEGIN CUSTOMIZABLE
;;; keep files visited on disk when t
@@ -78,7 +78,7 @@
(defun add-color(name type hue)
"Storing a ANSI color string into *colors*"
(setf (gethash name *colors*)
- (format nil "~a[~a;~am" #\Escape type hue)))
+ (format nil "~a[~a;~am" #\Escape type hue)))
(defun get-color(name) (gethash name *colors*))
(add-color 'red 1 31)
@@ -112,118 +112,124 @@
"this function split a string with separator and return a list"
(let ((text (concatenate 'string text (string separator))))
(loop for char across text
- counting char into count
- when (char= char separator)
- collect
- ;; we look at the position of the left separator from right to left
- (let ((left-separator-position (position separator text :from-end t :end (- count 1))))
- (subseq text
- ;; if we can't find a separator at the left of the current, then it's the start of
- ;; the string
- (if left-separator-position (+ 1 left-separator-position) 0)
- (- count 1))))))
+ counting char into count
+ when (char= char separator)
+ collect
+ ;; we look at the position of the left separator from right to left
+ (let ((left-separator-position (position separator text :from-end t :end (- count 1))))
+ (subseq text
+ ;; if we can't find a separator at the left of the current, then it's the start of
+ ;; the string
+ (if left-separator-position (+ 1 left-separator-position) 0)
+ (- count 1))))))
(defun formatted-output(line)
"Used to display gopher response with color one line at a time"
(let ((line-type (subseq line 0 1))
- (infos (split (subseq line 1) #\Tab)))
+ (infos (split (subseq line 1) #\Tab)))
- ;; see RFC 1436
- ;; section 3.8
- (when (and
- (= (length infos) 4)
- (member line-type *allowed-selectors* :test #'equal))
+ ;; if split worked
+ (when (= (length infos) 4)
(let ((line-number (+ 1 (hash-table-count *links*)))
- (text (car infos))
- (uri (cadr infos))
- (host (caddr infos))
- (port (parse-integer (cadddr infos))))
-
- ;; RFC, page 4
- (check "i"
- (print-with-color text))
-
- ;; 0 text file
- (check "0"
- (setf (gethash line-number *links*)
- (make-location :host host :port port :uri uri :type line-type ))
- (print-with-color text 'file line-number))
-
- ;; 1 directory
- (check "1"
- (setf (gethash line-number *links*)
- (make-location :host host :port port :uri uri :type line-type ))
- (print-with-color text 'folder line-number))
-
- ;; 2 CSO phone-book
- ;; WE SKIP
- (check "2")
-
- ;; 3 Error
- (check "3"
- (print-with-color "error" 'red line-number))
-
- ;; 4 BinHexed Mac file
- (check "4"
- (print-with-color text))
-
- ;; 5 DOS Binary archive
- (check "5"
- (print-with-color "selector 5 not implemented" 'red))
-
- ;; 6 Unix uuencoded file
- (check "6"
- (print-with-color "selector 6 not implemented" 'red))
-
- ;; 7 Index search server
- (check "7"
- (print-with-color "selector 7 not implemented" 'red))
-
- ;; 8 Telnet session
- (check "8"
- (print-with-color "selector 8 not implemented" 'red))
-
- ;; 9 Binary
- (check "9"
- (print-with-color "selector 9 not implemented" 'red))
-
- ;; + redundant server
- (check "+"
- (print-with-color "selector + not implemented" 'red))
-
- ;; T text based tn3270 session
- (check "T"
- (print-with-color "selector T not implemented" 'red))
-
- ;; g GIF file
- (check "g"
- (print-with-color "selector g not implemented" 'red))
-
- ;; I image
- (check "I"
- (print-with-color "selector I not implemented" 'red))
-
- ;; h http link
- (check "h"
- (print-with-color (concatenate 'string
- text " " uri)
- 'http "url"))))))
+ (text (car infos))
+ (uri (cadr infos))
+ (host (caddr infos))
+ (port (parse-integer (cadddr infos))))
+
+ ;; see RFC 1436
+ ;; section 3.8
+ (if (member line-type *allowed-selectors* :test #'equal)
+ (progn
+
+ ;; RFC, page 4
+ (check "i"
+ (print-with-color text))
+
+ ;; 0 text file
+ (check "0"
+ (setf (gethash line-number *links*)
+ (make-location :host host :port port :uri uri :type line-type ))
+ (print-with-color text 'file line-number))
+
+ ;; 1 directory
+ (check "1"
+ (setf (gethash line-number *links*)
+ (make-location :host host :port port :uri uri :type line-type ))
+ (print-with-color text 'folder line-number))
+
+ ;; 2 CSO phone-book
+ ;; WE SKIP
+ (check "2")
+
+ ;; 3 Error
+ (check "3"
+ (print-with-color "error" 'red line-number))
+
+ ;; 4 BinHexed Mac file
+ (check "4"
+ (print-with-color text))
+
+ ;; 5 DOS Binary archive
+ (check "5"
+ (print-with-color "selector 5 not implemented" 'red))
+
+ ;; 6 Unix uuencoded file
+ (check "6"
+ (print-with-color "selector 6 not implemented" 'red))
+
+ ;; 7 Index search server
+ (check "7"
+ (print-with-color "selector 7 not implemented" 'red))
+
+ ;; 8 Telnet session
+ (check "8"
+ (print-with-color "selector 8 not implemented" 'red))
+
+ ;; 9 Binary
+ (check "9"
+ (print-with-color "selector 9 not implemented" 'red))
+
+ ;; + redundant server
+ (check "+"
+ (print-with-color "selector + not implemented" 'red))
+
+ ;; T text based tn3270 session
+ (check "T"
+ (print-with-color "selector T not implemented" 'red))
+
+ ;; g GIF file
+ (check "g"
+ (print-with-color "selector g not implemented" 'red))
+
+ ;; I image
+ (check "I"
+ (print-with-color "selector I not implemented" 'red))
+
+ ;; h http link
+ (check "h"
+ (print-with-color (concatenate 'string
+ text " " uri)
+ 'http "url")))
+ ;; unknown type
+ (print-with-color (format nil
+ "invalid type ~a : ~a" line-type text)
+ 'red))))))
(defun getpage(host port uri)
"connect and display"
;; we reset the buffer
(setf *buffer*
- (make-array 200
- :fill-pointer 0
- :initial-element nil
- :adjustable t))
+ (make-array 200
+ :fill-pointer 0
+ :initial-element nil
+ :adjustable t))
;; we prepare informations about the connection
(let* ((address (sb-bsd-sockets:get-host-by-name host))
- (host (car (sb-bsd-sockets:host-ent-addresses address)))
- (socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)))
+ (host (car (sb-bsd-sockets:host-ent-addresses address)))
+ (socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)))
(sb-bsd-sockets:socket-connect socket host port)
@@ -237,9 +243,9 @@
;; for each line we receive we display it
(loop for line = (read-line stream nil nil)
- while line
- do
- (vector-push line *buffer*)))))
+ while line
+ do
+ (vector-push line *buffer*)))))
(defun g(key)
"browse to the N-th link"
@@ -263,14 +269,14 @@
"Restore the bookmark from file"
(when (probe-file *bookmark-file*)
(with-open-file (x *bookmark-file* :direction :input)
- (setf *bookmarks* (read x)))))
+ (setf *bookmarks* (read x)))))
(defun save-bookmark()
"Dump the bookmark to file"
(with-open-file (x *bookmark-file*
- :direction :output
- :if-does-not-exist :create
- :if-exists :supersede)
+ :direction :output
+ :if-does-not-exist :create
+ :if-exists :supersede)
(print *bookmarks* x)))
(defun add-bookmark()
@@ -289,13 +295,13 @@
while bookmark
do
(progn
- (setf (gethash line-number *links*) bookmark)
- (print-with-color (concatenate 'string
- (location-host bookmark)
- " "
- (location-type bookmark)
- (location-uri bookmark))
- 'file line-number))))
+ (setf (gethash line-number *links*) bookmark)
+ (print-with-color (concatenate 'string
+ (location-host bookmark)
+ " "
+ (location-type bookmark)
+ (location-uri bookmark))
+ 'file line-number))))
(defun help-shell()
"show help for the shell"
(format t "number : go to link n~%")
@@ -310,13 +316,13 @@
(defun parse-url(url)
"parse a gopher url and return a location"
(let ((url (if (and
- ;; if it contains more chars than gopher://
- (<= (length "gopher://") (length url))
- ;; if it starts with gopher// with return without it
- (string= "gopher://" (subseq url 0 9)))
- ;; we keep the url as is
- (subseq url 9)
- url)))
+ ;; if it contains more chars than gopher://
+ (<= (length "gopher://") (length url))
+ ;; if it starts with gopher// with return without it
+ (string= "gopher://" (subseq url 0 9)))
+ ;; we keep the url as is
+ (subseq url 9)
+ url)))
;; splitting by / to get host:port and uri
(let ((infos (split url #\/)))
@@ -324,20 +330,20 @@
;; splitting host and port to get them
(let ((host-port (split (pop infos) #\:)))
- ;; create the location to visit
- (make-location :host (pop host-port)
+ ;; create the location to visit
+ (make-location :host (pop host-port)
- ;; default to port 70 if not supplied
- :port (if host-port
- (parse-integer (car host-port))
- 70)
+ ;; default to port 70 if not supplied
+ :port (if host-port
+ (parse-integer (car host-port))
+ 70)
- ;; if type is empty we use "1"
- :type (let ((type (pop infos)))
- (if (< 0 (length type)) type "1"))
+ ;; if type is empty we use "1"
+ :type (let ((type (pop infos)))
+ (if (< 0 (length type)) type "1"))
- ;; glue remaining args between them
- :uri (format nil "~{/~a~}" infos))))))
+ ;; glue remaining args between them
+ :uri (format nil "~{/~a~}" infos))))))
(defun get-argv()
@@ -450,8 +456,8 @@
"visit a location"
(getpage (location-host destination)
- (location-port destination)
- (location-uri destination))
+ (location-port destination)
+ (location-uri destination))
;; we reset the links table ONLY if we have a new folder
(when (string= "1" (location-type destination))
@@ -462,21 +468,21 @@
(when *offline*
(let ((path (concatenate 'string
- "history/" (location-host destination)
- "/" (location-uri destination) "/")))
+ "history/" (location-host destination)
+ "/" (location-uri destination) "/")))
(ensure-directories-exist path)
(with-open-file
- (save-offline (concatenate
- 'string path (location-type destination))
- :direction :output
- :if-does-not-exist :create
- :if-exists :supersede)
+ (save-offline (concatenate
+ 'string path (location-type destination))
+ :direction :output
+ :if-does-not-exist :create
+ :if-exists :supersede)
- (loop for line across *buffer*
- while line
- do
- (format save-offline "~a~%" line)))))
+ (loop for line across *buffer*
+ while line
+ do
+ (format save-offline "~a~%" line)))))
(display-buffer (location-type destination)))
@@ -489,24 +495,24 @@
;; we loop until X or Q is typed
(loop for input = (format nil "~a" (read-line nil nil))
while (not (or
- (string= "exit" input)
- (string= "x" input)
- (string= "q" input)))
+ (string= "exit" input)
+ (string= "x" input)
+ (string= "q" input)))
do
(when (eq 'end (user-input input))
- (loop-finish))
+ (loop-finish))
(format t "clic => ")
(force-output)))
(defun main()
"fetch argument, display page and go to shell if type is 1"
(let ((destination
- (let ((argv (get-argv)))
- (if argv
- ;; url as argument
- (parse-url argv)
- ;; default url
- (make-location :host "gopherproject.org" :port 70 :uri "/" :type "1")))))
+ (let ((argv (get-argv)))
+ (if argv
+ ;; url as argument
+ (parse-url argv)
+ ;; default url
+ (make-location :host "gopherproject.org" :port 70 :uri "/" :type "1")))))
;; if user want to drop from first page we need
;; to look it here
@@ -514,7 +520,7 @@
;; we continue to the shell if the type was 1 and we are in a terminal
(when (and (ttyp)
(string= "1" (location-type destination)))
- (shell)))))
+ (shell)))))
;; we allow ecl to use a new kind of argument
;; not sure how it works but that works