clic.lisp - 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
---
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 color) text (get-color 'reset)))
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-output function"
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 left
173 (let ((left-separator-position (position separator text :from-end t :end (- count 1))))
174 (subseq text
175 ;; if we can't find a separator at the left of the current, then it's the start of
176 ;; the string
177 (if left-separator-position (+ 1 left-separator-position) 0)
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 uri :type line-type :text text))
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 uri :type line-type :text text))
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" 'red))
234
235 ;; 6 Unix uuencoded file
236 (check "6"
237 (print-with-color "selector 6 not implemented" 'red))
238
239 ;; 7 Index search server
240 (check "7"
241 (setf (gethash line-number *links*)
242 (make-location :host host :port port :uri uri :type line-type :text text))
243 (print-with-color text 'red line-number))
244
245 ;; 8 Telnet session
246 (check "8"
247 (print-with-color "selector 8 not implemented" 'red))
248
249 ;; 9 Binary
250 (check "9"
251 (setf (gethash line-number *links*)
252 (make-location :host host :port port :uri uri :type line-type :text text))
253 (print-with-color text 'red line-number))
254
255 ;; + redundant server
256 (check "+"
257 (print-with-color "selector + not implemented" 'red))
258
259 ;; T text based tn3270 session
260 (check "T"
261 (print-with-color "selector T not implemented" 'red))
262
263 ;; g GIF file
264 (check "g"
265 (setf (gethash line-number *links*)
266 (make-location :host host :port port :uri uri :type line-type :text text))
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 uri :type line-type :text text))
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))) ;;;; end of known types
279
280 ;; unknown type
281 (print-with-color (format nil
282 "invalid type ~a : ~a" line-type text)
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-length output))))))
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 file if binary)"
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 #'char-equal)
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 given
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 (h)istory : "
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" :port 70 :uri "/" :type "1" :text "gopherproject")))
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.0))))
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)))