use proper uris for displaying, accept them on the command line too - holymoly - A tor enabled gopher client written in CHICKEN scheme
(HTM) git clone git://vernunftzentrum.de/holymoly.git
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) README
(DIR) LICENSE
---
(DIR) commit d3c8303af27a1ee6ff56f42962fde1efe34e5721
(DIR) parent 69d7052e852a6a01b9c67e022590a466675c01ec
(HTM) Author: Christian Kellermann <ckeen@pestilenz.org>
Date: Fri, 20 Apr 2018 15:44:14 +0200
use proper uris for displaying, accept them on the command line too
Diffstat:
holymoly.scm | 95 +++++++++++++++++++------------
1 file changed, 59 insertions(+), 36 deletions(-)
---
(DIR) diff --git a/holymoly.scm b/holymoly.scm
@@ -8,7 +8,8 @@
ncurses
matchable
srfi-71
- srfi-4)
+ srfi-4
+ uri-common)
(include "proxy.scm")
(include "cursor.scm")
@@ -20,6 +21,17 @@
(define index "")
(define tab (string #\tab))
+(define-record entry type title selector host port rest)
+(define-record-printer entry
+ (lambda (e p)
+ (fprintf p "#<entry '~a ~s ~s ~s ~s>" (entry-type e)
+ (if (> (string-length (entry-title e)) 6)
+ (string-append (string-take (entry-title e) 6) "...")
+ (entry-title e))
+ (entry-selector e)
+ (entry-host e)
+ (entry-port e))))
+
(define proxy
(let* ((conf
(string-split
@@ -59,7 +71,7 @@
(renderer (car l))))
(when (and use-cursor (= (+ pos i) (current-cursor cursor)))
(let ((e (list-ref lines (+ pos i))))
- (new-status "gopher://~a:~a/~a~a" (entry-host e) (entry-port e) (type->string (entry-type e)) (entry-selector e)))
+ (new-status (uri->string (entry->uri e))))
(mvwchgat win i 0 -1 A_STANDOUT 0 #f))
(draw (cdr l) (add1 i))))
(wrefresh win)
@@ -98,6 +110,7 @@
(prev-cursor! cursor)
(adjust-cursor!)))))) ; backspace
((113) (k #f)) ; q
+ ((#x47) (get-user-input "New url:" "") pos) ; G
(else pos)))))))))
(define (get-user-input #!optional (prompt "Enter query:") (suggestion ""))
@@ -134,14 +147,6 @@
(wrefresh (status-win))
(doupdate))))
-(define-record entry type title selector host port rest)
-(define-record-printer entry
- (lambda (e p)
- (fprintf p "#<entry '~a ~s ~s>" (entry-type e)
- (if (> (string-length (entry-title e)) 6)
- (string-append (string-take (entry-title e) 6) "...")
- (entry-title e))
- (entry-selector e))))
(define (read-until delim port)
(let rl ((r '())
@@ -151,7 +156,7 @@
(rl (cons l r) (read-line port)))))
(define (request-resource server #!optional (resource index) (port gopher-port) until-eof?)
- (new-status "Connecting to ~a ~a " server resource)
+ (new-status "Connecting to ~a:~a ~a " server port resource)
(condition-case
(let-values (((i o _) (connect/socksv5 (car (proxy)) (cdr (proxy)) server port)))
(new-status "connected.")
@@ -174,29 +179,30 @@
(abort e))))
- (define mapping-table
- '(("i" . info)
- ("0" . file)
- ("1" . directory)
- ("2" . cso-phone-book-server)
- ("3" . error)
- ("4" . binhex)
- ("5" . dos-archive) ;; must read to end of file
- ("6" . uuencoded-file)
- ("7" . index-search)
- ("8" . telnet)
- ("9" . binary) ;; must read to end of file
- ("+" . redundant-server)
- ("T" . tn3270-session)
- ("g" . gif)
- ("I" . image)))
-
- (define (swap pair) (cons (cdr pair) (car pair)))
- (define (string->type str)
- (or (alist-ref str mapping-table equal?) 'unknown))
-
- (define (type->string type)
- (or (alist-ref type (map swap mapping-table) equal?) "3"))
+(define mapping-table
+ '(("i" . info)
+ ("0" . file)
+ ("1" . directory)
+ ("2" . cso-phone-book-server)
+ ("3" . error)
+ ("4" . binhex)
+ ("5" . dos-archive) ;; must read to end of file
+ ("6" . uuencoded-file)
+ ("7" . index-search)
+ ("8" . telnet)
+ ("9" . binary) ;; must read to end of file
+ ("+" . redundant-server)
+ ("T" . tn3270-session)
+ ("g" . gif)
+ ("I" . image)))
+
+(define (swap pair) (cons (cdr pair) (car pair)))
+
+(define (string->type str #!optional (default 'unknown))
+ (or (alist-ref str mapping-table equal?) default))
+
+(define (type->string type)
+ (or (alist-ref type (map swap mapping-table) equal?) "3"))
(define (string->entry str)
(condition-case
@@ -279,7 +285,7 @@
(alist-ref (entry-type e) type-handlers)
(lambda (c) (save-selector e c))))
(next (begin
- (new-status "~a:~a~a" (entry-host e) (entry-port e) (entry-selector e))
+ (new-status (uri->string (entry->uri e)))
(handler res))))
(new-status "~a" next)
(if next
@@ -291,6 +297,22 @@
(make-entry 'directory "" index server port '()))
+(define (uri->entry uri-string)
+ (let* ((u (uri-reference uri-string))
+ (server (or (uri-host u) (car (uri-path u))))
+ (port (or (uri-port u) 70))
+ (path (or (and (uri-host u) (uri-path u)) '("/" "1")))
+ (type (string->type (second path) 'directory))
+ (selector (string-intersperse (drop path 2) "/")))
+ (make-entry type "" (string-append "/" selector) server port '())))
+
+(define (entry->uri e)
+ (make-uri scheme: "gopher"
+ host: (entry-host e)
+ port: (entry-port e)
+ path: (append `(/ ,(type->string (entry-type e))
+ ,@(string-split (entry-selector e) "/")))))
+
(define (main args)
(initscr)
(cbreak)
@@ -300,11 +322,12 @@
(refresh)
(noecho)
(set-signal-handler! signal/winch (lambda (sig) (refresh)))
+
(let-values (((l c) (getmaxyx (stdscr))))
(main-win (newwin (sub1 l) c 0 0))
(status-win (newwin 1 c (sub1 l) 0))
(new-status "Starting up!")
- (select-entry (index-entry (car args)))
+ (select-entry (uri->entry (car args)))
(exit 0)))
(exit-handler (lambda code (endwin)))