commit 25487c3c561873fda304042df02ed8c68575ce20 Solene Rapenne <solene@perso.pw> 2017-12-28 11:45:34 +0100 Display unknown types. Replace tab with spaces
clic.lisp | 314 ++++++++++++++++++++++++++++++++------------------------------ 1 file changed, 160 insertions(+), 154 deletions(-)
diff --git a/clic.lisp b/clic.lisp index d09dadc..cfc276c 100644 --- 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