clic.lisp - clic - Clic is an command line interactive client for gopher writte… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
clic.lisp (26994B) | |
--- | |
1 (in-package :cl-user) | |
2 | |
3 ;;;; C binding to get terminal informations | |
4 #+ecl | |
5 (progn | |
6 (ffi:clines " | |
7 #include <sys/ioctl.h> | |
8 #include <limits.h> | |
9 #include <unistd.h> | |
10 | |
11 #ifdef __OpenBSD__ | |
12 void gotoPledge() { | |
13 pledge(\"dns inet stdio rpath tty wpath cpath proc exec\",NULL); | |
14 } | |
15 | |
16 void kioskPledge() { | |
17 pledge(\"dns inet stdio tty rpath\",NULL); | |
18 } | |
19 #endif | |
20 | |
21 int ttyPredicate() { | |
22 return isatty(fileno(stdout)); } | |
23 unsigned int getTerminalHeight() { | |
24 struct winsize w; | |
25 return ioctl(1,TIOCGWINSZ,&w)<0?UINT_MAX:w.ws_row;}") | |
26 #+openbsd | |
27 (progn | |
28 (ffi:def-function | |
29 ("kioskPledge" c-kiosk-pledge) | |
30 () :returning :void) | |
31 (ffi:def-function | |
32 ("gotoPledge" c-pledge) | |
33 () :returning :void)) | |
34 (ffi:def-function | |
35 ("getTerminalHeight" c-termsize) | |
36 () :returning :unsigned-int) | |
37 (ffi:def-function | |
38 ("ttyPredicate" c-ttyp) | |
39 () :returning :int)) | |
40 ;;;; END C binding | |
41 | |
42 ;; structure to store links | |
43 (defstruct location host port type uri tls text | |
44 :predicate) | |
45 | |
46 ;;;; kiosk mode | |
47 (defparameter *kiosk-mode* nil) | |
48 | |
49 ;;;; no split mode | |
50 (defparameter *no-split* nil) | |
51 | |
52 (defmacro kiosk-mode(&body code) | |
53 "prevent code if kiosk mode is enabled" | |
54 `(progn | |
55 (when (not *kiosk-mode*) | |
56 ,@code))) | |
57 | |
58 ;;;; BEGIN GLOBAL VARIABLES | |
59 | |
60 ;;; array of lines in buffer | |
61 (defparameter *buffer* nil) | |
62 ;;; array of lines of last menu | |
63 (defparameter *previous-buffer* nil) | |
64 | |
65 ;;; bandwidth usage counter | |
66 (defparameter *total-bandwidth-in* 0) | |
67 (defparameter *last-bandwidth-in* 0) | |
68 | |
69 ;;; a list containing the last viewed pages | |
70 (defparameter *history* '()) | |
71 | |
72 ;;; contain duration of the last request | |
73 (defparameter *duration* 0) | |
74 | |
75 ;;; when clic loads a type 1 page, we store location structures here | |
76 (defparameter *links* (make-hash-table)) | |
77 | |
78 ;;; Colors for use in the code | |
79 (defparameter *colors* (make-hash-table)) | |
80 | |
81 ;;; List of allowed item types | |
82 (defparameter *allowed-selectors* | |
83 (list "0" "1" "2" "3" "4" "5" "6" "i" | |
84 "h" "7" "8" "9" "+" "T" "g" "I")) | |
85 | |
86 ;;;; END GLOBAL VARIABLES | |
87 | |
88 ;;;; BEGIN ANSI colors | |
89 (defun add-color(name type hue) | |
90 "Storing a ANSI color string into *colors*" | |
91 (setf (gethash name *colors*) | |
92 (format nil "~a[~a;~am" #\Escape type hue))) | |
93 | |
94 (defun get-color(name) (gethash name *colors*)) | |
95 (add-color 'red 1 31) | |
96 (add-color 'reset 0 70) | |
97 (add-color 'bg-black 0 40) | |
98 (add-color 'folder 4 34) | |
99 (add-color 'green 1 32) | |
100 (add-color 'file 0 35) | |
101 (add-color 'cyan 0 46) | |
102 (add-color 'http 0 33) | |
103 ;;;; END ANSI colors | |
104 | |
105 (defun clear() | |
106 "Clear the screen" | |
107 (format t "~A[H~@*~A[J" #\escape)) | |
108 | |
109 ;;;; is the output interactive or a pipe ? | |
110 (defun ttyp() | |
111 "return t if the output is a terminal" | |
112 ;; we use this variable in case we don't want to be interactive | |
113 ;; like when we use a cmd arg to get an image | |
114 #+ecl | |
115 (if (= 1 (c-ttyp)) | |
116 t | |
117 nil)) | |
118 | |
119 (defun copy-array(from) | |
120 "return a new array containing the same elements as the parameter" | |
121 (let ((dest (make-array (length from) | |
122 :fill-pointer 0 | |
123 :initial-element nil | |
124 :adjustable t))) | |
125 (loop for element across from | |
126 do | |
127 (vector-push element dest)) | |
128 dest)) | |
129 | |
130 (defun print-with-color(text &optional (color 'reset) (line-number nil)) | |
131 "Used to display a line with a color" | |
132 (format t "~3A| ~a~a~a~%" (if line-number line-number "") (get-color c… | |
133 | |
134 (defmacro foreach-buffer(&body code) | |
135 `(progn | |
136 (loop for line across *buffer* do ,@code))) | |
137 | |
138 (defmacro easy-socket(&body code) | |
139 "avoid duplicated code used for sockets" | |
140 `(progn | |
141 | |
142 ;; try tls connection | |
143 (usocket:with-client-socket (socket sock host port) | |
144 (handler-case | |
145 (let ((stream | |
146 (cl+ssl:make-ssl-client-stream | |
147 sock | |
148 :external-format '(:utf-8 :eol-style :lf) | |
149 :unwrap-stream-p t | |
150 ;;:verify nil | |
151 :hostname host))) | |
152 ;; store in metadata that we are using TLS | |
153 (setf (location-tls (car *history*)) t) | |
154 ,@code) | |
155 | |
156 ;; fallback to regular plaintext connection if tls fails | |
157 (t (c) | |
158 (usocket:with-client-socket (socket stream host port) | |
159 ,@code)))))) | |
160 | |
161 (defmacro check(identifier &body code) | |
162 "Macro to define a new syntax to make 'when' easier for formatted-outp… | |
163 `(progn (when (string= ,identifier line-type) ,@code))) | |
164 | |
165 (defun split(text separator) | |
166 "this function split a string with separator and return a list" | |
167 (let ((text (concatenate 'string text (string separator)))) | |
168 (loop for char across text | |
169 counting char into count | |
170 when (char= char separator) | |
171 collect | |
172 ;; we look at the position of the left separator from right to le… | |
173 (let ((left-separator-position (position separator text :from-e… | |
174 (subseq text | |
175 ;; if we can't find a separator at the left of the cu… | |
176 ;; the string | |
177 (if left-separator-position (+ 1 left-separator-posit… | |
178 (- count 1)))))) | |
179 | |
180 (defun formatted-output(line) | |
181 "Used to display gopher response with color one line at a time" | |
182 | |
183 ;; we check that the line is longer than 1 char and that it has tabs | |
184 (when (and | |
185 (< 1 (length line)) | |
186 (position #\Tab line)) | |
187 (let ((line-type (subseq line 0 1)) | |
188 (field (split (subseq line 1) #\Tab))) | |
189 | |
190 ;; if split worked | |
191 (when (>= (length field) 4) | |
192 (let ((line-number (+ 1 (hash-table-count *links*))) | |
193 (text (car field)) | |
194 (uri (cadr field)) | |
195 (host (caddr field)) | |
196 (port (parse-integer (cadddr field)))) | |
197 | |
198 ;; see RFC 1436 | |
199 ;; section 3.8 | |
200 (if (member line-type *allowed-selectors* :test #'equal) | |
201 (progn | |
202 | |
203 ;; RFC, page 4 | |
204 (check "i" | |
205 (print-with-color text)) | |
206 | |
207 ;; 0 text file | |
208 (check "0" | |
209 (setf (gethash line-number *links*) | |
210 (make-location :host host :port port :uri u… | |
211 (print-with-color text 'file line-number)) | |
212 | |
213 ;; 1 directory | |
214 (check "1" | |
215 (setf (gethash line-number *links*) | |
216 (make-location :host host :port port :uri u… | |
217 (print-with-color text 'folder line-number)) | |
218 | |
219 ;; 2 CSO phone-book | |
220 ;; WE SKIP | |
221 (check "2") | |
222 | |
223 ;; 3 Error | |
224 (check "3" | |
225 (print-with-color "error" 'red line-number)) | |
226 | |
227 ;; 4 BinHexed Mac file | |
228 (check "4" | |
229 (print-with-color text)) | |
230 | |
231 ;; 5 DOS Binary archive | |
232 (check "5" | |
233 (print-with-color "selector 5 not implemented" 'r… | |
234 | |
235 ;; 6 Unix uuencoded file | |
236 (check "6" | |
237 (print-with-color "selector 6 not implemented" 'r… | |
238 | |
239 ;; 7 Index search server | |
240 (check "7" | |
241 (setf (gethash line-number *links*) | |
242 (make-location :host host :port port :uri u… | |
243 (print-with-color text 'red line-number)) | |
244 | |
245 ;; 8 Telnet session | |
246 (check "8" | |
247 (print-with-color "selector 8 not implemented" 'r… | |
248 | |
249 ;; 9 Binary | |
250 (check "9" | |
251 (setf (gethash line-number *links*) | |
252 (make-location :host host :port port :uri u… | |
253 (print-with-color text 'red line-number)) | |
254 | |
255 ;; + redundant server | |
256 (check "+" | |
257 (print-with-color "selector + not implemented" 'r… | |
258 | |
259 ;; T text based tn3270 session | |
260 (check "T" | |
261 (print-with-color "selector T not implemented" 'r… | |
262 | |
263 ;; g GIF file | |
264 (check "g" | |
265 (setf (gethash line-number *links*) | |
266 (make-location :host host :port port :uri u… | |
267 (print-with-color text 'red line-number)) | |
268 | |
269 ;; I image | |
270 (check "I" | |
271 (setf (gethash line-number *links*) | |
272 (make-location :host host :port port :uri u… | |
273 (print-with-color text 'red line-number)) | |
274 | |
275 ;; h http link | |
276 (check "h" | |
277 (setf (gethash line-number *links*) uri) | |
278 (print-with-color text 'http line-number))) ;;;; … | |
279 | |
280 ;; unknown type | |
281 (print-with-color (format nil | |
282 "invalid type ~a : ~a" line-type… | |
283 'red))))))) | |
284 | |
285 (defun download-binary(host port uri) | |
286 (easy-socket | |
287 ;; sending the request to the server | |
288 (format stream "~a~a~a" uri #\Return #\Newline) | |
289 (force-output stream) | |
290 | |
291 ;; save into a file in /tmp | |
292 (let* ((filename (subseq uri (1+ (position #\/ uri :from-end t)))) | |
293 (path (concatenate 'string "/tmp/" filename))) | |
294 (with-open-file (output path | |
295 :element-type '(unsigned-byte 8) | |
296 :direction :output :if-exists :supersede) | |
297 (let ((buf (make-array 4096 :element-type '(unsigned-byte 8)))) | |
298 (loop for pos = (read-sequence buf stream) | |
299 while (plusp pos) | |
300 do | |
301 (format t ".") | |
302 (force-output) | |
303 (write-sequence buf output :end pos))) | |
304 (format t "~%File downloaded into ~a (~a bytes)~%" path (file-len… | |
305 | |
306 | |
307 (defun getpage(host port uri &optional (search nil)) | |
308 "send a request and store the answer (in *buffer* if text or save a fi… | |
309 | |
310 ;; we reset the buffer | |
311 (setf *buffer* | |
312 (make-array 200 | |
313 :fill-pointer 0 | |
314 :initial-element nil | |
315 :adjustable t)) | |
316 (setf *last-bandwidth-in* 0) | |
317 | |
318 (let ((real-time (get-internal-real-time))) | |
319 ;; we prepare informations about the connection | |
320 (easy-socket | |
321 ;; sending the request to the server | |
322 (if search | |
323 (format stream "~a ~a~a~a" uri search #\Return #\Newline) | |
324 (format stream "~a~a~a" uri #\Return #\Newline)) | |
325 (force-output stream) | |
326 | |
327 ;; not binary | |
328 ;; for each line we receive we store it in *buffer* | |
329 (loop for line = (read-line stream nil nil) | |
330 count line into lines | |
331 while line | |
332 do | |
333 ;; count bandwidth usage | |
334 (incf *total-bandwidth-in* (length line)) | |
335 (incf *last-bandwidth-in* (length line)) | |
336 ;; increase array size if needed | |
337 (when (= lines (- (array-total-size *buffer*) 1)) | |
338 (adjust-array *buffer* (+ 200 (array-total-size *buffer*)))) | |
339 (vector-push line *buffer*))) | |
340 | |
341 | |
342 ;; we store the duration of the connection | |
343 (setf *duration* (float (/ (- (get-internal-real-time) real-time) | |
344 internal-time-units-per-second))))) | |
345 | |
346 (defun g(key) | |
347 "browse to the N-th link" | |
348 (let ((destination (gethash key *links*))) | |
349 (when destination | |
350 (cond | |
351 ;; visit a gopher link | |
352 ((location-p destination) | |
353 (visit destination)) | |
354 ;; visit http link | |
355 ((search "URL:" destination) | |
356 (kiosk-mode | |
357 (uiop:run-program (list "xdg-open" | |
358 (subseq destination 4))))))))) | |
359 | |
360 (defun filter-line(text) | |
361 "display only lines containg text" | |
362 (setf *previous-buffer* (copy-array *buffer*)) | |
363 (setf *buffer* (make-array 400 | |
364 :fill-pointer 0 | |
365 :initial-element nil | |
366 :adjustable t)) | |
367 ;; we create a new buffer from the current | |
368 ;; with only lines matching the string (no regex) | |
369 (loop for line across *previous-buffer* | |
370 do | |
371 (when (search text (car (split (subseq line 1) #\Tab)) :test #'ch… | |
372 (vector-push line *buffer*))) | |
373 (display-interactive-menu)) | |
374 | |
375 (defun load-file-menu(path) | |
376 "load a local file with a gophermap syntax and display it as a menu" | |
377 ;; we set the buffer | |
378 (setf *buffer* | |
379 (make-array 200 | |
380 :fill-pointer 0 | |
381 :initial-element nil | |
382 :adjustable t)) | |
383 | |
384 (with-open-file (stream path | |
385 :direction :input) | |
386 (loop for line = (read-line stream nil nil) | |
387 while line | |
388 do | |
389 (vector-push line *buffer*)))) | |
390 | |
391 (defun p() | |
392 "browse back to previous menu" | |
393 (when (<= 2 (length *history*)) | |
394 (pop *history*) | |
395 (visit (pop *history*)))) | |
396 | |
397 (defun r() | |
398 "reload the previous menu" | |
399 (when (<= 1 (length *history*)) | |
400 (visit (pop *history*)))) | |
401 | |
402 (defun s(number) | |
403 "show url for the link $NUMBER" | |
404 (let ((destination (gethash number *links*))) | |
405 (if (not destination) | |
406 (format t "No link ~a~%" number) | |
407 (format t "gopher://~a~a/~a~a~%" | |
408 (location-host destination) | |
409 (let ((port (location-port destination))) | |
410 (if (= 70 port) | |
411 "" | |
412 (format nil ":~a" port))) | |
413 (location-type destination) | |
414 (location-uri destination))))) | |
415 | |
416 (defun help-shell() | |
417 "show help for the shell" | |
418 (format t "number : go to link n~%") | |
419 (format t "p or / : go to previous page~%") | |
420 (format t "h : display history~%") | |
421 (format t "sNUMBER : show url for link $NUMBER~%") | |
422 (format t "r or * : reload the page~%") | |
423 (format t "help : show this help~%") | |
424 (format t "d : dump the raw reponse~%") | |
425 (format t "/ text : display online lines matching text~%") | |
426 (format t "^D or x or q or . : quit clic~%")) | |
427 | |
428 (defun parse-url(url) | |
429 "parse a gopher url and return a location" | |
430 (cond ((or | |
431 (string= "--help" url) | |
432 (string= "-h" url)) | |
433 (help-shell) | |
434 (quit)) | |
435 | |
436 ((string= "-k" url) | |
437 #+openbsd | |
438 (c-kiosk-pledge) | |
439 (setf *kiosk-mode* t)) | |
440 | |
441 ((string= "-t" url) | |
442 (setf *no-split* t)) | |
443 | |
444 ((= 0 (or (search "file://" url) 1)) | |
445 (load-file-menu (subseq url 7)) | |
446 (make-location :host 'local-file | |
447 :text url | |
448 :port nil | |
449 :type "1" | |
450 :uri url)) | |
451 | |
452 (t | |
453 (let ((url (if (search "gopher://" url) | |
454 (subseq url 9) | |
455 url))) | |
456 | |
457 ;; splitting with / to get host:port and uri | |
458 ;; splitting host and port to get them | |
459 (let* ((infos (split url #\/)) | |
460 (host-port (split (pop infos) #\:))) | |
461 | |
462 ;; create the location to visit | |
463 (make-location :host (pop host-port) | |
464 ;; default to port 70 if not supplied | |
465 :port (if host-port ;; <- empty if no port … | |
466 (parse-integer (car host-port)) | |
467 70) | |
468 | |
469 :text url | |
470 | |
471 ;; if type is empty we default to "1" | |
472 :type (let ((type (pop infos))) | |
473 (if (< 0 (length type)) type "1")) | |
474 | |
475 ;; glue remaining args between them | |
476 :uri (format nil "~{/~a~}" infos))))))) | |
477 | |
478 (defun get-argv() | |
479 "Parse argv and return it" | |
480 #+ecl | |
481 (cdr (si::command-args))) | |
482 | |
483 (defun user-input(input) | |
484 (cond | |
485 ;; show help | |
486 ((string= "help" input) | |
487 (help-shell)) | |
488 | |
489 ((search "s" input) | |
490 (s (parse-integer (subseq input 1)))) | |
491 | |
492 ((or | |
493 (string= "*" input) | |
494 (string= "ls" input) | |
495 (string= "r" input)) | |
496 (r)) | |
497 | |
498 ;; go to previous page | |
499 ((or | |
500 (string= "/" input) | |
501 (string= "cd .." input) | |
502 (string= "p" input)) | |
503 (p)) | |
504 | |
505 ;; search a pattern in a menu | |
506 ;; syntax /pattern | |
507 ((and | |
508 (search "/" input) | |
509 (> (length input) 1)) | |
510 (filter-line (subseq input 1))) | |
511 | |
512 ;; same as previously | |
513 ;; but with syntax / pattern | |
514 ((= 0 (or (search "/ " input) 1)) | |
515 (filter-line (subseq input 2))) | |
516 | |
517 ;; dump raw informations | |
518 ((string= "d" input) | |
519 (foreach-buffer | |
520 (format t "~a~%" line))) | |
521 | |
522 ;; exit | |
523 ((or | |
524 (eql nil input) | |
525 (string= "NIL" input) | |
526 (string= "." input) | |
527 (string= "exit" input) | |
528 (string= "x" input) | |
529 (string= "q" input)) | |
530 'end) | |
531 | |
532 ;; show history | |
533 ((string= "h" input) | |
534 (setf *links* (make-hash-table)) | |
535 (loop for element in *history* | |
536 do | |
537 (formatted-output | |
538 (format nil "~a~a ~a ~a ~a~%" | |
539 (location-type element) | |
540 (location-text element) | |
541 (location-uri element) | |
542 (location-host element) | |
543 (location-port element))))) | |
544 | |
545 | |
546 ;; follow a link | |
547 (t | |
548 ;; we ignore error in case of bad input | |
549 ;; just do nothing | |
550 (ignore-errors | |
551 (g (parse-integer input)))))) | |
552 | |
553 (defun display-interactive-binary-file() | |
554 "call xdg-open on the binary file" | |
555 (kiosk-mode | |
556 (let* ((location (car *history*)) | |
557 (filename (subseq ;; get the text after last / | |
558 (location-uri location) | |
559 (1+ (position #\/ | |
560 (location-uri location) | |
561 :from-end t)))) | |
562 (filepath (concatenate 'string "/tmp/" (or filename "index")))) | |
563 (uiop:run-program (list "xdg-open" filepath))))) | |
564 | |
565 (defun display-text-stdout() | |
566 "display the buffer to stdout" | |
567 (foreach-buffer | |
568 (format t "~a~%" line))) | |
569 | |
570 (defun display-with-pager() | |
571 "display the buffer using $PAGER" | |
572 (let* ((uri (location-uri (car *history*))) | |
573 (filename (subseq uri (1+ (position #\/ uri :from-end t)))) | |
574 (path (concatenate 'string "/tmp/" (or filename "index")))) | |
575 (with-open-file (output path | |
576 :direction :output | |
577 :if-does-not-exist :create | |
578 :if-exists :supersede) | |
579 (foreach-buffer | |
580 (format output "~a~%" line))) | |
581 (uiop:run-program (nconc | |
582 (if (uiop:getenv "PAGER") | |
583 (split (uiop:getenv "PAGER") #\Space) | |
584 (list "less")) | |
585 (list path)) | |
586 :input :interactive | |
587 :output :interactive))) | |
588 | |
589 ;; display a text file using the pager by piping | |
590 ;; the data to out, no temp file | |
591 (defun display-with-pager-kiosk() | |
592 "display the buffer to stdout, we don't use system() in kiosk mode" | |
593 (loop for line across *buffer* | |
594 do | |
595 (format t "~a~%" line))) | |
596 | |
597 (defun display-interactive-menu() | |
598 "display a menu" | |
599 ;; we store the user input outside of the loop | |
600 ;; so if the user doesn't want to scroll | |
601 ;; we break the loop and then execute the command | |
602 (let ((input nil)) | |
603 (let ((rows (if *no-split* | |
604 -1 | |
605 (* (- (c-termsize) 1))))) ; -1 for command bar | |
606 | |
607 (loop for line across *buffer* | |
608 counting line into row | |
609 do | |
610 (formatted-output line) | |
611 | |
612 | |
613 ;; split and ask to scroll or to type a command | |
614 (when (= row rows) | |
615 (setf row 0) | |
616 (format t "~a press enter or a shell command: " | |
617 (if *kiosk-mode* "KIOSK" "")) | |
618 (force-output) | |
619 (let ((first-input (read-char *standard-input* nil nil t))) | |
620 (cond | |
621 ((not first-input) | |
622 (format t "~%") ;; display a newline | |
623 (setf input "x") ;; we exit | |
624 (loop-finish)) | |
625 ((char= #\NewLine first-input) | |
626 ;; we hide previous line (prompt) | |
627 (format t "'~C[A~C[K~C" #\Escape #\Escape #\return)) | |
628 (t | |
629 (unread-char first-input) | |
630 (let ((input-text (format nil "~a" (read-line nil nil)… | |
631 (setf input input-text) | |
632 (loop-finish))))))) | |
633 | |
634 ;; in case of shell command, do it | |
635 (if input | |
636 (user-input input) | |
637 (when (< (length *buffer*) rows) | |
638 (dotimes (i (- rows (length *buffer*))) | |
639 (format t "~%"))))))) | |
640 | |
641 (defun pipe-text(host port uri) | |
642 "pipe text to stdout, with stdout not a TTY output" | |
643 (getpage host port uri) | |
644 (foreach-buffer | |
645 (format t "~a~%" line))) | |
646 | |
647 (defun pipe-binary(host port uri) | |
648 "pipe data to stdout, with stdout not a TTY output" | |
649 (easy-socket | |
650 (format stream "~a~a~a" uri #\Return #\Newline) | |
651 (force-output stream) | |
652 | |
653 ;; write to the standard output | |
654 (let ((buf (make-array 4096 :element-type '(unsigned-byte 8)))) | |
655 (loop for pos = (read-sequence buf stream) | |
656 while (plusp pos) | |
657 do | |
658 (write-sequence buf *standard-output* :end pos))))) | |
659 | |
660 (defun pipe-to-stdout(destination) | |
661 "fetch data and output to stdout without storing anything" | |
662 | |
663 (if (or | |
664 (string= "0" (location-type destination)) | |
665 (string= "1" (location-type destination)) | |
666 (string= "7" (location-type destination))) | |
667 | |
668 (pipe-text (location-host destination) | |
669 (location-port destination) | |
670 (location-uri destination)) | |
671 | |
672 (pipe-binary (location-host destination) | |
673 (location-port destination) | |
674 (location-uri destination)))) | |
675 | |
676 (defun visit(destination) | |
677 "fetch and display content interactively" | |
678 | |
679 ;; add it to the history ! | |
680 (push destination *history*) | |
681 | |
682 (let ((type | |
683 (cond | |
684 | |
685 ;; fetch a menu | |
686 ((string= "1" (location-type destination)) | |
687 (if (eql 'local-file (location-host destination)) | |
688 'menu | |
689 (getpage (location-host destination) | |
690 (location-port destination) | |
691 (location-uri destination))) | |
692 'menu) | |
693 | |
694 ;; fetch a text file | |
695 ((string= "0" (location-type destination)) | |
696 (getpage (location-host destination) | |
697 (location-port destination) | |
698 (location-uri destination)) | |
699 'text) | |
700 | |
701 ;; fetch a menu after search | |
702 ((string= "7" (location-type destination)) | |
703 (format t "Input : ") | |
704 (let ((user-input (read-line nil nil))) | |
705 (getpage (location-host destination) | |
706 (location-port destination) | |
707 (location-uri destination) | |
708 user-input)) | |
709 'menu) | |
710 | |
711 ;; if not type 0 1 7 then it's binary | |
712 (t | |
713 (kiosk-mode | |
714 (download-binary (location-host destination) | |
715 (location-port destination) | |
716 (location-uri destination))) | |
717 'binary)))) | |
718 | |
719 ;; we reset the links table ONLY if we have a new menu | |
720 ;; we also keep the last menu buffer | |
721 (when (eql type 'menu) | |
722 (setf *previous-buffer* (copy-array *buffer*)) | |
723 (setf *links* (make-hash-table))) | |
724 | |
725 | |
726 (if (eql type 'menu) | |
727 (display-interactive-menu) | |
728 (progn | |
729 (if (eql type 'text) | |
730 (if *kiosk-mode* | |
731 (display-with-pager-kiosk) | |
732 (display-with-pager)) | |
733 (kiosk-mode (display-interactive-binary-file))) | |
734 ;; redraw last menu | |
735 ;; we need to get previous buffer and reset links numbering | |
736 (pop *history*) | |
737 (when (and | |
738 *previous-buffer* | |
739 (not *kiosk-mode*)) | |
740 (setf *buffer* (copy-array *previous-buffer*)) | |
741 (setf *links* (make-hash-table)) | |
742 (display-interactive-menu)))))) | |
743 | |
744 | |
745 (defun display-prompt() | |
746 "show the prompt and helper" | |
747 (let ((last-page (car *history*))) | |
748 (format t "~a~agopher://~a:~a/~a~a (~as, ~aKb) / (p)rev (r)edisplay … | |
749 (if *kiosk-mode* "KIOSK " "") | |
750 (if (location-tls last-page) "**TLS** " "UNSECURE ") | |
751 (location-host last-page) | |
752 (location-port last-page) | |
753 (location-type last-page) | |
754 (location-uri last-page) | |
755 *duration* | |
756 (floor (/ *last-bandwidth-in* 1024.0)))) | |
757 (force-output)) | |
758 | |
759 (defun shell() | |
760 "Shell for user interaction" | |
761 (display-prompt) | |
762 | |
763 ;; we loop until X or Q is typed | |
764 (loop for input = (format nil "~a" (read-line nil nil)) | |
765 while (not (or | |
766 (string= "NIL" input) ;; ^D | |
767 (string= "exit" input) | |
768 (string= "x" input) | |
769 (string= "q" input))) | |
770 do | |
771 (when (eq 'end (user-input input)) | |
772 (loop-finish)) | |
773 (display-prompt))) | |
774 | |
775 (defun main() | |
776 "entry function of clic, we need to determine if the usage is one of | |
777 the 3 following cases : interactive, not interactive or | |
778 piped. Interactive is the state where the user will browse clic for | |
779 multiple content. Not interactive is the case where clic is called | |
780 with a parameter not of type 1, so it will fetch the content, | |
781 display it and exit and finally, the redirected case where clic will | |
782 print to stdout and exit." | |
783 | |
784 ;; pledge support on OpenBSD | |
785 #+openbsd | |
786 (c-pledge) | |
787 | |
788 ;; re-enable SIGINT (Ctrl+C) disabled for loading clic | |
789 (ext:set-signal-handler ext:+sigint+ 'quit) | |
790 | |
791 (handler-case | |
792 (let ((destination (car (last | |
793 (loop for element in (get-argv) | |
794 collect (parse-url element)))))) | |
795 | |
796 ;; if we didn't passed a url as parameter, use a default | |
797 (if (not (location-p destination)) | |
798 (setf destination (make-location :host "gopherproject.org" :po… | |
799 | |
800 ;; is there an output redirection ? | |
801 (if (ttyp) | |
802 (progn | |
803 (clear) | |
804 ;; if we don't ask a menu, not going interactive | |
805 (if (not (string= "1" (location-type destination))) | |
806 ;; not interactive | |
807 (visit destination) | |
808 ;; if user want to drop from first page we need | |
809 ;; to look it here | |
810 (when (not (eq 'end (visit destination))) | |
811 ;; we continue to the shell if we are in a terminal | |
812 (shell))) | |
813 (format t "~a kB in.~%" (floor (/ *total-bandwidth-in* 1024.… | |
814 (pipe-to-stdout destination))) | |
815 (t (error) | |
816 (progn | |
817 (format t "Something went wrong~%") | |
818 (print error))))) | |
819 | |
820 ;; we allow ecl to use a new kind of argument | |
821 ;; not sure how it works but that works | |
822 #+ecl | |
823 (defconstant +uri-rules+ | |
824 '(("*DEFAULT*" 1 "" :stop))) |