Compare commits

..

7 Commits

3 changed files with 31 additions and 11 deletions

View File

@@ -166,7 +166,8 @@
'get-document 'get-document
(string-append "unsupported scheme: ~a~n" (string-append "unsupported scheme: ~a~n"
" url: ~a~n") " url: ~a~n")
(url-scheme destination) destination)) (url-scheme destination)
(url->string destination)))
(define-values (status meta body-port) (define-values (status meta body-port)
(net:request destination)) (net:request destination))
@@ -190,12 +191,15 @@
[(and (>= status 10) (<= status 19)) [(and (>= status 10) (<= status 19))
(displayln "input requested") (displayln "input requested")
(display "? ") (display "? ")
(flush-output)
(get-document (get-document
(struct-copy (struct-copy
url url
destination destination
[query `((,(string->symbol (read-line)) . #f))]))] [query `((,(string->symbol
(read-line (current-input-port)
'any)) . #f))]))]
;; ;;
;; 20-29 SUCCESS ;; 20-29 SUCCESS
@@ -214,12 +218,13 @@
'get-document 'get-document
(string-append "unsupported mime ~a~n" (string-append "unsupported mime ~a~n"
" url: ~a~n") " url: ~a~n")
meta destination)]) meta (url->string destination))])
;; If the document failed to be fetched (parser error, ;; If the document failed to be fetched (parser error,
;; unsupported mime, so on and so forth) this would not ;; unsupported mime, so on and so forth) this would not
;; ever be reached. ;; ever be reached.
(set! history (cons destination history))] (set! history (cons destination history))
(next-cmd)]
;; ;;
;; 30-39 REDIRECT ;; 30-39 REDIRECT
@@ -243,7 +248,7 @@
" url: ~a~n" " url: ~a~n"
" explanation: ~a~n") " explanation: ~a~n")
status status
(string->url destination) (url->string destination)
(dict-ref temporary-failures (dict-ref temporary-failures
status status
"temporary failure"))] "temporary failure"))]
@@ -258,7 +263,7 @@
" url: ~a~n" " url: ~a~n"
" explanation: ~a~n") " explanation: ~a~n")
status status
(string->url destination) (url->string destination)
(dict-ref permanent-failures (dict-ref permanent-failures
status status
"temporary failure"))] "temporary failure"))]
@@ -271,6 +276,4 @@
'get-document 'get-document
(string-append "resource requires a client certificate, " (string-append "resource requires a client certificate, "
"which this client does not yet support~a~n" "which this client does not yet support~a~n"
" url: ~a~n"))]) " url: ~a~n"))]))))
(next-cmd)))

19
gem300.rkt Normal file → Executable file
View File

@@ -1,3 +1,4 @@
#! /usr/bin/env /usr/local/bin/racket
#lang racket #lang racket
(require (prefix-in net: "net.rkt") (require (prefix-in net: "net.rkt")
@@ -8,6 +9,8 @@
(define (repl) (define (repl)
(display "G-300 > ") (display "G-300 > ")
(flush-output)
(with-handlers (with-handlers
([(or/c exn:fail:user? ([(or/c exn:fail:user?
;; todo: catch these errors separately and reformat them ;; todo: catch these errors separately and reformat them
@@ -17,7 +20,8 @@
(λ (exn) (λ (exn)
(displayln (exn-message exn)))]) (displayln (exn-message exn)))])
(match (regexp-match #px"(\\w+)\\s*(.*)" (read-line)) (match (regexp-match #px"(\\w+)\\s*(.*)"
(read-line (current-input-port) 'any))
[(or (list _ "go" url) [(or (list _ "go" url)
(list _ "g" url)) (list _ "g" url))
(send client go-cmd url)] (send client go-cmd url)]
@@ -45,7 +49,20 @@
(list _ "b" _)) (list _ "b" _))
(send client back-cmd)] (send client back-cmd)]
[(or (list _ "quit" _)
(list _ "q" _ ))
(exit)]
[else [else
(displayln "no such command")])) (displayln "no such command")]))
(repl)) (repl))
(displayln
(string-append "welcome to gem300, a gemini client.\n"
"to learn more, type:\n"
"'go w6vvn.flounder.online/gem300/tutorial.gmi'"))
(flush-output)
(repl)

View File

@@ -110,7 +110,7 @@
(define (inner-iter acc rst) (define (inner-iter acc rst)
(let ([line (string-join acc)]) (let ([line (string-join acc)])
(if (or (empty? rst) (if (or (empty? rst)
(> (string-length line) 80)) (> (string-length line) 40))
(values acc rst) (values acc rst)
(inner-iter (append acc (list (car rst))) (inner-iter (append acc (list (car rst)))
(cdr rst))))) (cdr rst)))))