forked from slope-lang/slope
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
Plaintext
217 lines
7.0 KiB
Plaintext
#! /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 '())
|
|
|
|
;;;
|
|
;;; USER IO
|
|
;;;
|
|
(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))
|
|
(cond
|
|
((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)))
|
|
(begin
|
|
(print-error "The way is blocked by void")
|
|
#f)))
|
|
((equal? in "back")
|
|
(if (> (length history) 1)
|
|
(begin0
|
|
(car (cdr history))
|
|
(set! forward (cons (car history) forward))
|
|
(set! history (cdr (cdr history))))
|
|
(begin
|
|
(print-error "The way is blocked by void")
|
|
#f)))
|
|
((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))
|
|
#f)))))
|
|
|
|
(define query-user (lambda (prompt)
|
|
(display prompt)
|
|
(read-line)))
|
|
|
|
(define print-error (lambda (err)
|
|
(display "\033[1;31m" err "\033[0m\n")
|
|
#f))
|
|
|
|
|
|
;;;
|
|
;;; REQUESTS
|
|
;;;
|
|
(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
|
|
(cond
|
|
((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)
|
|
(cond
|
|
;; 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)))
|
|
(begin
|
|
(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))))))
|
|
|
|
|
|
;;;
|
|
;;; URL PROCESSING
|
|
;;;
|
|
|
|
(define parse-url (lambda (u)
|
|
;; Make sure we have a scheme and host
|
|
(set! u (string-trim-space u))
|
|
(if
|
|
(or
|
|
(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" "/"))))
|
|
|
|
|
|
;;;
|
|
;;; LINE PROCESSING
|
|
;;;
|
|
(define parse-map-line (lambda (ln)
|
|
;; Create variables
|
|
(define type "i")
|
|
(define text "")
|
|
(define host "null.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
|
|
(begin
|
|
;; 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)
|
|
#f)))
|
|
|
|
(define get-line-text (lambda (line-split)
|
|
(if (and (list? line-split) (equal? (length line-split) 5))
|
|
(car (cdr line-split))
|
|
#f)))
|
|
|
|
(define get-line-host (lambda (line-split)
|
|
(if (and (list? line-split) (equal? (length line-split) 5))
|
|
(list-ref line-split 2)
|
|
#f)))
|
|
|
|
(define get-line-path (lambda (line-split)
|
|
(if (and (list? line-split) (equal? (length line-split) 5))
|
|
(list-ref line-split 3)
|
|
#f)))
|
|
|
|
(define get-line-port (lambda (line-split)
|
|
(if (and (list? line-split) (equal? (length line-split) 5))
|
|
(list-ref line-split 4)
|
|
#f)))
|
|
|
|
(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 ()
|
|
(display
|
|
"\n\033[1;32;4mCommands:\033[24m\n \033[32m'back', 'forward', 'exit',\n 'help', '?',\n a URL (ex. 'sdf.org'),\n a link number (ex. '3')\033[0m\n\n")
|
|
#f
|
|
))
|
|
|
|
(define main-loop (lambda ()
|
|
(define in (get-input))
|
|
(if in
|
|
(make-request in))
|
|
(main-loop)))
|
|
|
|
((lambda ()
|
|
(display "\033[36;1mslope gopher client v0." version "\033[0m\n")
|
|
(print-help)
|
|
(parse-flags)
|
|
(if (> (length sys-args) 1) (make-request (parse-url (list-ref sys-args (- (length sys-args) 1)))))
|
|
(main-loop)))
|