You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

217 lines
7.0 KiB

#! /usr/bin/env slope
;;; slope gopher client
;;; syntax:
;;; gopher.slo [[--strict|-s]] [[gopher-url]]
;;; The --strict or -s flag will use strict mode,
;;; which will ignore all type i lines and only
;;; display link lines, which is more in keeping
;;; with the original design of the gopher protocol
(define version 6)
(define default-port "70")
(define default-scheme "gopher://")
(define text-prompt "\033[1m$\033[0m ")
(define strict-mode #f)
(define current-page-links '())
(define history '())
(define forward '())
(define get-input (lambda ()
;; Will return either a url parse list or #f
(define in (string-trim-space (query-user text-prompt)))
(define link-num (string->number in))
((equal? in "exit") (exit))
((or (equal? in "help") (equal? in "?")) (print-help))
((equal? in "forward")
(if (not (null? forward))
(begin0 (car forward) (set! forward (cdr forward)))
(print-error "The way is blocked by void")
((equal? in "back")
(if (> (length history) 1)
(car (cdr history))
(set! forward (cons (car history) forward))
(set! history (cdr (cdr history))))
(print-error "The way is blocked by void")
((number? link-num)
(if (and (< link-num (length current-page-links)) (> link-num -1))
(begin (set! forward '()) (list-ref current-page-links link-num))
(begin (print-error (string-append "Invalid link ID: " link-num)) #f)))
(else (if (~bool in)
(begin (set! forward '()) (parse-url in))
(define query-user (lambda (prompt)
(display prompt)
(define print-error (lambda (err)
(display "\033[1;31m" err "\033[0m\n")
(define make-request (lambda (link-line)
;; For 0 type: prints file
;; For 1 type: prints text lines, and updates link lines list
;; Errors for all others
((equal? (car link-line) "0") (get-lines link-line))
((equal? (car link-line) "1") (get-lines link-line))
(else (print-error (string-format "Type \"%v\" requests are not currently supported" link-line))))))
(define get-lines (lambda (link-line)
(define conn (net-conn (get-line-host link-line) (get-line-port link-line) #f 10))
(define output #f)
(if (and (not (exception? conn)) conn)
;; If plain text, print it and add to history
;; Else, display error
((equal? (car link-line) "0") (begin
(set! output (read-all (write (string-append (get-line-path link-line) "\r\n") conn)))
(close conn)
(if (exception? output)
(print-error (string-format "Could not retrieve page data from %v" (get-line-path link-line)))
(begin (display output)(set! history (cons link-line history))))))
;; If map, print it and add it to history
;; also fill out the current links list
((equal? (car link-line) "1") (begin
(set! output (read-all (write (string-append (get-line-path link-line) "\r\n") conn)))
(close conn)
(if (exception? output)
(print-error (string-format "Could not retrieve page data from %v" (get-line-path link-line)))
(set! output (string->list output "\n"))
(set! current-page-links '())
(for-each (lambda (l)
(define ln (parse-map-line l))
(print-line ln)
(if (not (equal? (get-line-type ln) "i"))
(set! current-page-links (cons ln current-page-links)))) output)
(set! current-page-links (reverse current-page-links))
(set! history (cons link-line history)))))))
(print-error (string-append "Could not connect to " (get-line-host link-line) ":" (get-line-port link-line))))))
(define parse-url (lambda (u)
;; Make sure we have a scheme and host
(set! u (string-trim-space u))
(not (~bool (url-scheme u)))
(not (~bool (url-host u))))
(set! u (string-append default-scheme u)))
;; Split the type from the path
(define type-path (type-from-path u))
;; Return a link line
(list (car type-path) "" (url-host u) (car (cdr type-path)) (if (~bool (url-port u)) (url-port u) default-port))))
(define type-from-path (lambda (u)
(define p (url-path u))
(if (> (length p) 2)
(list (substring p 1 2) (substring p 2 (length p)))
(list "1" "/"))))
(define parse-map-line (lambda (ln)
;; Create variables
(define type "i")
(define text "")
(define host "")
(define path "false")
(define port default-port)
(define split (string->list ln "\t"))
(if (and (~bool split) (> (length split) 3))
;; Populate variables if everything has gone well
;; Set the type
(if (> (length (car split)) 0)
(set! type (string-ref (car split) 0)))
;; Set the text
(if (> (length (car split)) 1)
(set! text (substring (car split) 1 (length (car split)))))
;; Set the host
(set! host (list-ref split 2))
;; Set the path
(set! path (car (cdr split)))
;; Set the port
(set! port (string-trim-space (list-ref split 3)))
(if (not (string->number port))
(set! port default-port))))
(list type text host path port)))
(define get-line-type (lambda (line-split)
(if (and (list? line-split) (equal? (length line-split) 5))
(car line-split)
(define get-line-text (lambda (line-split)
(if (and (list? line-split) (equal? (length line-split) 5))
(car (cdr line-split))
(define get-line-host (lambda (line-split)
(if (and (list? line-split) (equal? (length line-split) 5))
(list-ref line-split 2)
(define get-line-path (lambda (line-split)
(if (and (list? line-split) (equal? (length line-split) 5))
(list-ref line-split 3)
(define get-line-port (lambda (line-split)
(if (and (list? line-split) (equal? (length line-split) 5))
(list-ref line-split 4)
(define print-line (lambda (line-split)
(define link-num (length current-page-links))
(if (equal? (get-line-type line-split) "i")
(if (not strict-mode) (display (string-format " %v\n" (get-line-text line-split))))
(display (string-format "[\033[1;36m%-3v\033[0m] %v\n" link-num (get-line-text line-split))))))
(define parse-flags (lambda ()
(for-each (lambda (arg)
(if (or (equal? arg "--strict") (equal? arg "-s")) (set! strict-mode #t))) sys-args)))
(define print-help (lambda ()
"\n\033[1;32;4mCommands:\033[24m\n \033[32m'back', 'forward', 'exit',\n 'help', '?',\n a URL (ex. ''),\n a link number (ex. '3')\033[0m\n\n")
(define main-loop (lambda ()
(define in (get-input))
(if in
(make-request in))
((lambda ()
(display "\033[36;1mslope gopher client v0." version "\033[0m\n")
(if (> (length sys-args) 1) (make-request (parse-url (list-ref sys-args (- (length sys-args) 1)))))