iinitial commit - holymoly - A tor enabled gopher client written in CHICKEN scheme Err vernunftzentrum.de 70 hgit clone git://vernunftzentrum.de/holymoly.git URL:git://vernunftzentrum.de/holymoly.git vernunftzentrum.de 70 1Log /ckeen/repos/holymoly/log.gph vernunftzentrum.de 70 1Files /ckeen/repos/holymoly/files.gph vernunftzentrum.de 70 1Refs /ckeen/repos/holymoly/refs.gph vernunftzentrum.de 70 1README /ckeen/repos/holymoly/file/README.gph vernunftzentrum.de 70 1LICENSE /ckeen/repos/holymoly/file/LICENSE.gph vernunftzentrum.de 70 i--- Err vernunftzentrum.de 70 1commit dd5457cc9ae51143e41ce812badf551c405c8661 /ckeen/repos/holymoly/commit/dd5457cc9ae51143e41ce812badf551c405c8661.gph vernunftzentrum.de 70 hAuthor: Christian Kellermann URL:mailto:ckeen@pestilenz.org vernunftzentrum.de 70 iDate: Sun, 4 Mar 2018 12:55:25 +0100 Err vernunftzentrum.de 70 i Err vernunftzentrum.de 70 iinitial commit Err vernunftzentrum.de 70 i Err vernunftzentrum.de 70 iDiffstat: Err vernunftzentrum.de 70 i build.sh | 10 ++++++++++ Err vernunftzentrum.de 70 i cursor.scm | 101 +++++++++++++++++++++++++++++++ Err vernunftzentrum.de 70 i holymoly.scm | 289 +++++++++++++++++++++++++++++++ Err vernunftzentrum.de 70 i ncurses-trunk.diff | 20 ++++++++++++++++++++ Err vernunftzentrum.de 70 i proxy.scm | 88 +++++++++++++++++++++++++++++++ Err vernunftzentrum.de 70 i Err vernunftzentrum.de 70 i5 files changed, 508 insertions(+), 0 deletions(-) Err vernunftzentrum.de 70 i--- Err vernunftzentrum.de 70 1diff --git a/build.sh b/build.sh /ckeen/repos/holymoly/file/build.sh.gph vernunftzentrum.de 70 i@@ -0,0 +1,10 @@ Err vernunftzentrum.de 70 i+#!/bin/ksh Err vernunftzentrum.de 70 i+set -e Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+chicken-install -r ncurses Err vernunftzentrum.de 70 i+cd ncurses Err vernunftzentrum.de 70 i+patch < ../ncurses-trunk.diff Err vernunftzentrum.de 70 i+chicken-install Err vernunftzentrum.de 70 i+cd - Err vernunftzentrum.de 70 i+csc holymoly Err vernunftzentrum.de 70 i+rm -r ncurses *.o Err vernunftzentrum.de 70 1diff --git a/cursor.scm b/cursor.scm /ckeen/repos/holymoly/file/cursor.scm.gph vernunftzentrum.de 70 i@@ -0,0 +1,101 @@ Err vernunftzentrum.de 70 i+(module cursor Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(cursor->list Err vernunftzentrum.de 70 i+ next-cursor! Err vernunftzentrum.de 70 i+ prev-cursor! Err vernunftzentrum.de 70 i+ empty-cursor? Err vernunftzentrum.de 70 i+ current-cursor Err vernunftzentrum.de 70 i+ list->cursor Err vernunftzentrum.de 70 i+ add-to-tail Err vernunftzentrum.de 70 i+ add-to-head) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(import chicken scheme) Err vernunftzentrum.de 70 i+(use extras srfi-1) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define-record cursor prev current next) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define-record-printer cursor Err vernunftzentrum.de 70 i+ (lambda (c p) Err vernunftzentrum.de 70 i+ (fprintf p Err vernunftzentrum.de 70 i+ "#~a<- ~a)>" Err vernunftzentrum.de 70 i+ (reverse (cursor-prev c)) Err vernunftzentrum.de 70 i+ (cursor-current c) Err vernunftzentrum.de 70 i+ (cursor-next c)))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define empty-element (gensym 'cursor)) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (next-cursor! c) Err vernunftzentrum.de 70 i+ (cond Err vernunftzentrum.de 70 i+ ((empty-cursor? c) Err vernunftzentrum.de 70 i+ (error "Cursor empty")) Err vernunftzentrum.de 70 i+ ((and (null? (cursor-next c)) Err vernunftzentrum.de 70 i+ (null? (cursor-prev c))) Err vernunftzentrum.de 70 i+ (cursor-current c)) Err vernunftzentrum.de 70 i+ ((null? (cursor-next c)) Err vernunftzentrum.de 70 i+ (let* ((old-cur (cursor-current c)) Err vernunftzentrum.de 70 i+ (new-next (reverse (cons old-cur (cursor-prev c))))) Err vernunftzentrum.de 70 i+ (cursor-current-set! c (car new-next)) Err vernunftzentrum.de 70 i+ (cursor-next-set! c (cdr new-next)) Err vernunftzentrum.de 70 i+ (cursor-prev-set! c '()))) Err vernunftzentrum.de 70 i+ (else Err vernunftzentrum.de 70 i+ (cursor-prev-set! c (cons (cursor-current c) (cursor-prev c))) Err vernunftzentrum.de 70 i+ (cursor-current-set! c (car (cursor-next c))) Err vernunftzentrum.de 70 i+ (cursor-next-set! c (cdr (cursor-next c))))) Err vernunftzentrum.de 70 i+ (cursor-current c)) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (prev-cursor! c) Err vernunftzentrum.de 70 i+ (cond Err vernunftzentrum.de 70 i+ ((empty-cursor? c) Err vernunftzentrum.de 70 i+ (error "Cursor empty")) Err vernunftzentrum.de 70 i+ ((and (null? (cursor-next c)) Err vernunftzentrum.de 70 i+ (null? (cursor-prev c))) Err vernunftzentrum.de 70 i+ (cursor-current c)) Err vernunftzentrum.de 70 i+ ((null? (cursor-prev c)) Err vernunftzentrum.de 70 i+ (let* ((old-cur (cursor-current c)) Err vernunftzentrum.de 70 i+ (new-prev (reverse (cons old-cur (cursor-next c))))) Err vernunftzentrum.de 70 i+ (cursor-current-set! c (car new-prev)) Err vernunftzentrum.de 70 i+ (cursor-prev-set! c (cdr new-prev)) Err vernunftzentrum.de 70 i+ (cursor-next-set! c '()))) Err vernunftzentrum.de 70 i+ (else Err vernunftzentrum.de 70 i+ (cursor-next-set! c (cons (cursor-current c) (cursor-next c))) Err vernunftzentrum.de 70 i+ (cursor-current-set! c (car (cursor-prev c))) Err vernunftzentrum.de 70 i+ (cursor-prev-set! c (cdr (cursor-prev c))))) Err vernunftzentrum.de 70 i+ (cursor-current c)) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (current-cursor c) Err vernunftzentrum.de 70 i+ (when (empty-cursor? c) Err vernunftzentrum.de 70 i+ (error "Cursor empty")) Err vernunftzentrum.de 70 i+ (cursor-current c)) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (list->cursor lst) Err vernunftzentrum.de 70 i+ (unless (list? lst) Err vernunftzentrum.de 70 i+ (error "not a list" lst)) Err vernunftzentrum.de 70 i+ (if (null? lst) Err vernunftzentrum.de 70 i+ (make-cursor '() empty-element '()) Err vernunftzentrum.de 70 i+ (make-cursor '() (car lst) (cdr lst)))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (cursor->list c) Err vernunftzentrum.de 70 i+ (append (reverse (cursor-prev c)) Err vernunftzentrum.de 70 i+ (list (cursor-current c)) Err vernunftzentrum.de 70 i+ (cursor-next c))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (empty-cursor? c) Err vernunftzentrum.de 70 i+ (and (null? (cursor-prev c)) Err vernunftzentrum.de 70 i+ (null? (cursor-next c)) Err vernunftzentrum.de 70 i+ (eq? empty-element (cursor-current c)))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (add-to-head c elem) Err vernunftzentrum.de 70 i+ (cond ((empty-cursor? c) Err vernunftzentrum.de 70 i+ (cursor-current-set! c elem)) Err vernunftzentrum.de 70 i+ (else Err vernunftzentrum.de 70 i+ (cursor-prev-set! c Err vernunftzentrum.de 70 i+ (append-reverse (cursor-prev c) (list elem)))))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (add-to-tail c elem) Err vernunftzentrum.de 70 i+ (cond ((empty-cursor? c) Err vernunftzentrum.de 70 i+ (cursor-current-set! c elem)) Err vernunftzentrum.de 70 i+ (else Err vernunftzentrum.de 70 i+ (cursor-next-set! c Err vernunftzentrum.de 70 i+ (append (cursor-next c) (list elem)))))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+) Err vernunftzentrum.de 70 1diff --git a/holymoly.scm b/holymoly.scm /ckeen/repos/holymoly/file/holymoly.scm.gph vernunftzentrum.de 70 i@@ -0,0 +1,289 @@ Err vernunftzentrum.de 70 i+(use tcp miscmacros srfi-13 srfi-4 posix ncurses matchable srfi-71) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(include "proxy.scm") Err vernunftzentrum.de 70 i+(include "cursor.scm") Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(import socksv5-proxy) Err vernunftzentrum.de 70 i+(import cursor) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define gopher-port 70) Err vernunftzentrum.de 70 i+(define index "") Err vernunftzentrum.de 70 i+(define tab (string #\tab)) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define proxy Err vernunftzentrum.de 70 i+ (let* ((conf Err vernunftzentrum.de 70 i+ (string-split Err vernunftzentrum.de 70 i+ (or Err vernunftzentrum.de 70 i+ (get-environment-variable "SOCKS_PROXY") Err vernunftzentrum.de 70 i+ "localhost:9050") Err vernunftzentrum.de 70 i+ ":")) Err vernunftzentrum.de 70 i+ (proxy-host (car conf)) Err vernunftzentrum.de 70 i+ (proxy-port (string->number (cadr conf)))) Err vernunftzentrum.de 70 i+ (make-parameter (cons proxy-host proxy-port)))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define main-win (make-parameter #f)) Err vernunftzentrum.de 70 i+(define status-win (make-parameter #f)) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (pager lines #!key win use-cursor selectables (renderer identity)) Err vernunftzentrum.de 70 i+ (when (and use-cursor (or (not selectables) (null? selectables))) Err vernunftzentrum.de 70 i+ (error "Usage of use-cursor without handing in selectables")) Err vernunftzentrum.de 70 i+ (unless win Err vernunftzentrum.de 70 i+ (error "Need window parameter")) Err vernunftzentrum.de 70 i+ (let ((pos 0) Err vernunftzentrum.de 70 i+ (nlines (length lines)) Err vernunftzentrum.de 70 i+ (cursor 0)) Err vernunftzentrum.de 70 i+ (when use-cursor Err vernunftzentrum.de 70 i+ (set! cursor (list->cursor selectables))) Err vernunftzentrum.de 70 i+ (call/cc Err vernunftzentrum.de 70 i+ (lambda (k) Err vernunftzentrum.de 70 i+ (let loop ((newp 0)) Err vernunftzentrum.de 70 i+ (let* ((rows cols (getmaxyx win)) Err vernunftzentrum.de 70 i+ (dlines (take (drop lines pos) (min (- nlines pos) rows)))) Err vernunftzentrum.de 70 i+ (wclear win) Err vernunftzentrum.de 70 i+ (let draw ((l dlines) Err vernunftzentrum.de 70 i+ (i 0)) Err vernunftzentrum.de 70 i+ (unless (or (>= i rows) (null? l)) Err vernunftzentrum.de 70 i+ (mvwprintw win i 0 "~a" (if (>= (string-length (renderer (car l))) cols) Err vernunftzentrum.de 70 i+ (string-take (renderer (car l)) (sub1 cols)) Err vernunftzentrum.de 70 i+ (renderer (car l)))) Err vernunftzentrum.de 70 i+ (when (and use-cursor (= (+ pos i) (current-cursor cursor))) Err vernunftzentrum.de 70 i+ (mvwchgat win i 0 -1 A_STANDOUT 0 #f)) Err vernunftzentrum.de 70 i+ (draw (cdr l) (add1 i)))) Err vernunftzentrum.de 70 i+ (wrefresh win) Err vernunftzentrum.de 70 i+ (loop (case (char->integer (getch)) Err vernunftzentrum.de 70 i+ ((16 #x103) ; arrow up Err vernunftzentrum.de 70 i+ (cond Err vernunftzentrum.de 70 i+ (use-cursor (prev-cursor! cursor) pos) Err vernunftzentrum.de 70 i+ (else (if (zero? pos) 0 (set! pos (sub1 pos)))))) Err vernunftzentrum.de 70 i+ ((14 #x102) ; arrow down Err vernunftzentrum.de 70 i+ (cond Err vernunftzentrum.de 70 i+ (use-cursor (next-cursor! cursor) pos) Err vernunftzentrum.de 70 i+ (else (if (= pos nlines) pos (set! pos (add1 pos)))))) Err vernunftzentrum.de 70 i+ ((#x106) (when use-cursor (set! cursor 0)) (set! pos 0)) ; HOME Err vernunftzentrum.de 70 i+ ((#x168) (when use-cursor (set! cursor (sub1 (length dlines)))) (set! pos (max pos (- nlines pos rows)))) ; end Err vernunftzentrum.de 70 i+ ((260) (if use-cursor (k (previous-page)) (k #f))) Err vernunftzentrum.de 70 i+ ((32) Err vernunftzentrum.de 70 i+ (set! pos (if (> (+ pos rows) nlines) pos (+ pos (sub1 rows)))) Err vernunftzentrum.de 70 i+ (when use-cursor Err vernunftzentrum.de 70 i+ (let adjust-cursor! () Err vernunftzentrum.de 70 i+ (cond ((> pos (current-cursor cursor)) Err vernunftzentrum.de 70 i+ (next-cursor! cursor) Err vernunftzentrum.de 70 i+ (adjust-cursor!)) Err vernunftzentrum.de 70 i+ ((< (+ pos (length dlines)) (current-cursor cursor)) Err vernunftzentrum.de 70 i+ (prev-cursor! cursor) Err vernunftzentrum.de 70 i+ (adjust-cursor!))))) Err vernunftzentrum.de 70 i+ pos) ; space Err vernunftzentrum.de 70 i+ ((10 261) (when use-cursor (k (list-ref lines (current-cursor cursor)))) pos) Err vernunftzentrum.de 70 i+ ((#x107) (set! pos (if (< (- pos rows) 0) 0 (- pos (sub1 rows)))) Err vernunftzentrum.de 70 i+ (when use-cursor Err vernunftzentrum.de 70 i+ (let adjust-cursor! () Err vernunftzentrum.de 70 i+ (cond ((> pos (current-cursor cursor)) Err vernunftzentrum.de 70 i+ (next-cursor! cursor) Err vernunftzentrum.de 70 i+ (adjust-cursor!)) Err vernunftzentrum.de 70 i+ ((< (+ pos (length dlines)) (current-cursor cursor)) Err vernunftzentrum.de 70 i+ (prev-cursor! cursor) Err vernunftzentrum.de 70 i+ (adjust-cursor!)))))) ; backspace Err vernunftzentrum.de 70 i+ ((113) (k #f)) ; q Err vernunftzentrum.de 70 i+ (else pos))))))))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (get-user-input) Err vernunftzentrum.de 70 i+ (let* ((l c (getmaxyx (stdscr))) Err vernunftzentrum.de 70 i+ (w (newwin 3 c (quotient l 2) 0)) Err vernunftzentrum.de 70 i+ (query "Enter query:")) Err vernunftzentrum.de 70 i+ (let input-loop ((r '())) Err vernunftzentrum.de 70 i+ (define (refresh r) Err vernunftzentrum.de 70 i+ (wclear w) Err vernunftzentrum.de 70 i+ (box w 0 0) Err vernunftzentrum.de 70 i+ (mvwprintw w 0 (- (quotient c 2) Err vernunftzentrum.de 70 i+ (quotient (string-length query) 2)) query) Err vernunftzentrum.de 70 i+ (mvwprintw w 1 2 "~a" (list->string (reverse r))) Err vernunftzentrum.de 70 i+ (mvwchgat w 1 (+ 2 (length r)) 1 A_BLINK 0 #f) Err vernunftzentrum.de 70 i+ (wrefresh w)) Err vernunftzentrum.de 70 i+ (refresh r) Err vernunftzentrum.de 70 i+ (let ((input (getch))) Err vernunftzentrum.de 70 i+ (case (char->integer input) Err vernunftzentrum.de 70 i+ ((10) (delwin w) (list->string (reverse r))) Err vernunftzentrum.de 70 i+ ((263) (let ((new (if (null? r) r (cdr r)))) Err vernunftzentrum.de 70 i+ (refresh new) Err vernunftzentrum.de 70 i+ (input-loop new))) Err vernunftzentrum.de 70 i+ ((27) '()) Err vernunftzentrum.de 70 i+ (else Err vernunftzentrum.de 70 i+ (refresh (cons input r)) Err vernunftzentrum.de 70 i+ (input-loop (cons input r)))))))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (new-status . msg) Err vernunftzentrum.de 70 i+ (let-values (((l c) (getmaxyx (status-win)))) Err vernunftzentrum.de 70 i+ (let ((m (apply sprintf msg))) Err vernunftzentrum.de 70 i+ (wclear (status-win)) Err vernunftzentrum.de 70 i+ (mvwprintw (status-win) 0 0 (if (> (string-length m) c) Err vernunftzentrum.de 70 i+ (string-take m c) Err vernunftzentrum.de 70 i+ m)) Err vernunftzentrum.de 70 i+ (mvwchgat (status-win) 0 0 -1 A_STANDOUT 0 #f) Err vernunftzentrum.de 70 i+ (wrefresh (status-win)) Err vernunftzentrum.de 70 i+ (doupdate)))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define-record entry type title selector host port rest) Err vernunftzentrum.de 70 i+(define-record-printer entry Err vernunftzentrum.de 70 i+ (lambda (e p) Err vernunftzentrum.de 70 i+ (fprintf p "#" (entry-type e) Err vernunftzentrum.de 70 i+ (if (> (string-length (entry-title e)) 6) Err vernunftzentrum.de 70 i+ (string-append (string-take (entry-title e) 6) "...") Err vernunftzentrum.de 70 i+ (entry-title e)) Err vernunftzentrum.de 70 i+ (entry-selector e)))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (read-until delim port) Err vernunftzentrum.de 70 i+ (let rl ((r '()) Err vernunftzentrum.de 70 i+ (l (read-line port))) Err vernunftzentrum.de 70 i+ (if (or (equal? delim l) (eof-object? l)) Err vernunftzentrum.de 70 i+ (reverse r) Err vernunftzentrum.de 70 i+ (rl (cons l r) (read-line port))))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (request-resource server #!optional (resource index) (port gopher-port) until-eof?) Err vernunftzentrum.de 70 i+ (new-status "Connecting to ~a ~a " server resource) Err vernunftzentrum.de 70 i+ (condition-case Err vernunftzentrum.de 70 i+ (let-values (((i o _) (connect/socksv5 (car (proxy)) (cdr (proxy)) server port))) Err vernunftzentrum.de 70 i+ (new-status "connected.") Err vernunftzentrum.de 70 i+ (display (string-append resource (string #\linefeed #\return)) o) Err vernunftzentrum.de 70 i+ (let ((response (read-until (if until-eof? #f ".") i))) Err vernunftzentrum.de 70 i+ (close-input-port i) Err vernunftzentrum.de 70 i+ (close-output-port o) Err vernunftzentrum.de 70 i+ response)) Err vernunftzentrum.de 70 i+ (e (exn i/o net) Err vernunftzentrum.de 70 i+ (endwin) Err vernunftzentrum.de 70 i+ (new-status "Network error: ~a" ((condition-property-accessor 'exn 'message) e)) Err vernunftzentrum.de 70 i+ (sleep 1) Err vernunftzentrum.de 70 i+ (beep) Err vernunftzentrum.de 70 i+ (select-entry (previous-page))) Err vernunftzentrum.de 70 i+ (e () Err vernunftzentrum.de 70 i+ (endwin) Err vernunftzentrum.de 70 i+ (pp (condition->list e)) Err vernunftzentrum.de 70 i+ (abort e)))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (string->type str) Err vernunftzentrum.de 70 i+ (let ((mapping-table Err vernunftzentrum.de 70 i+ '(("i" . info) Err vernunftzentrum.de 70 i+ ("0" . file) Err vernunftzentrum.de 70 i+ ("1" . directory) Err vernunftzentrum.de 70 i+ ("2" . cso-phone-book-server) Err vernunftzentrum.de 70 i+ ("3" . error) Err vernunftzentrum.de 70 i+ ("4" . binhex) Err vernunftzentrum.de 70 i+ ("5" . dos-archive) ;; must read to end of file Err vernunftzentrum.de 70 i+ ("6" . uuencoded-file) Err vernunftzentrum.de 70 i+ ("7" . index-search) Err vernunftzentrum.de 70 i+ ("8" . telnet) Err vernunftzentrum.de 70 i+ ("9" . binary) ;; must read to end of file Err vernunftzentrum.de 70 i+ ("+" . redundant-server) Err vernunftzentrum.de 70 i+ ("T" . tn3270-session) Err vernunftzentrum.de 70 i+ ("g" . gif) Err vernunftzentrum.de 70 i+ ("I" . image)))) Err vernunftzentrum.de 70 i+ (or (alist-ref str mapping-table equal?) 'unknown))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (string->entry str) Err vernunftzentrum.de 70 i+ (condition-case Err vernunftzentrum.de 70 i+ (let* ((s (string-split str tab #t)) Err vernunftzentrum.de 70 i+ (type (string->type (string-take (car s) 1))) Err vernunftzentrum.de 70 i+ (title (string-drop (car s) 1)) Err vernunftzentrum.de 70 i+ (selector (second s)) Err vernunftzentrum.de 70 i+ (host (third s)) Err vernunftzentrum.de 70 i+ (port (string->number (fourth s))) Err vernunftzentrum.de 70 i+ (rest (cdddr s))) Err vernunftzentrum.de 70 i+ (make-entry type title selector host port rest)) Err vernunftzentrum.de 70 i+ (e () (make-entry 'error "Malformed entry, please ignore" "" "" "" '())))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (render-entry e) Err vernunftzentrum.de 70 i+ (match (entry-type e) Err vernunftzentrum.de 70 i+ ('info Err vernunftzentrum.de 70 i+ (sprintf "~a" (entry-title e))) Err vernunftzentrum.de 70 i+ ('error Err vernunftzentrum.de 70 i+ (sprintf "[ERROR]:\t~a" (entry-title e))) Err vernunftzentrum.de 70 i+ (else Err vernunftzentrum.de 70 i+ (sprintf "\t~a" (entry-title e))))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (call prog r) Err vernunftzentrum.de 70 i+ (with-output-to-pipe prog (lambda () (display r)))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define history '()) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (current-page) Err vernunftzentrum.de 70 i+ (if (null? history) Err vernunftzentrum.de 70 i+ #f Err vernunftzentrum.de 70 i+ (car history))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (previous-page) Err vernunftzentrum.de 70 i+ (when (< 1 (length history)) Err vernunftzentrum.de 70 i+ (pop! history)) Err vernunftzentrum.de 70 i+ (current-page)) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (get-indices lst pred) Err vernunftzentrum.de 70 i+ (let loop ((l lst) Err vernunftzentrum.de 70 i+ (r '()) Err vernunftzentrum.de 70 i+ (i 0)) Err vernunftzentrum.de 70 i+ (if (not (pair? l)) (reverse r) Err vernunftzentrum.de 70 i+ (if (pred (car l)) Err vernunftzentrum.de 70 i+ (loop (cdr l) (cons i r) (add1 i)) Err vernunftzentrum.de 70 i+ (loop (cdr l) r (add1 i)))))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (render-directory strs) Err vernunftzentrum.de 70 i+ (let* ((p (map string->entry strs)) Err vernunftzentrum.de 70 i+ (links (get-indices p (lambda (e) (not (equal? (entry-type e) 'info)))))) Err vernunftzentrum.de 70 i+ (pager p win: (main-win) renderer: render-entry use-cursor: (not (null? links)) selectables: links))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define nop values) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define type-handlers Err vernunftzentrum.de 70 i+ `((file . ,(lambda (c) (pager c win: (main-win)) (previous-page))) Err vernunftzentrum.de 70 i+ (directory . ,render-directory) Err vernunftzentrum.de 70 i+ (index-search . ,render-directory))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (save-selector entry content) Err vernunftzentrum.de 70 i+ (let ((filename (string-append "/tmp/" (last (string-split (entry-selector entry) "/")) (if (equal? (entry-type entry) 'gif) ".gif" "")))) Err vernunftzentrum.de 70 i+ (with-output-to-file filename Err vernunftzentrum.de 70 i+ (lambda () (map display content))) Err vernunftzentrum.de 70 i+ (system (string-append "xdg-open file://" filename)))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (select-entry e) Err vernunftzentrum.de 70 i+ (when (and (equal? (entry-type e) 'index-search) Err vernunftzentrum.de 70 i+ (= 1) (length (string-split (entry-selector e) "?"))) Err vernunftzentrum.de 70 i+ (let* ((query (get-user-input)) Err vernunftzentrum.de 70 i+ (old-selector (entry-selector e))) Err vernunftzentrum.de 70 i+ (if (null? query) Err vernunftzentrum.de 70 i+ (select-entry (current-page)) Err vernunftzentrum.de 70 i+ (entry-selector-set! e (string-append (car (string-split old-selector "?")) "?" (string-intersperse (string-split query) "+")))))) Err vernunftzentrum.de 70 i+ (unless (equal? e (current-page)) Err vernunftzentrum.de 70 i+ (push! e history)) Err vernunftzentrum.de 70 i+ (let* ((res (request-resource (entry-host e) (entry-selector e) (entry-port e) (memq (entry-type e) '(dos-archive binary)))) Err vernunftzentrum.de 70 i+ (handler (or Err vernunftzentrum.de 70 i+ (alist-ref (entry-type e) type-handlers) Err vernunftzentrum.de 70 i+ (lambda (c) (save-selector e c)))) Err vernunftzentrum.de 70 i+ (next (begin Err vernunftzentrum.de 70 i+ (new-status "~a:~a~a" (entry-host e) (entry-port e) (entry-selector e)) Err vernunftzentrum.de 70 i+ (handler res)))) Err vernunftzentrum.de 70 i+ (new-status "~a" next) Err vernunftzentrum.de 70 i+ (if next Err vernunftzentrum.de 70 i+ (select-entry next) Err vernunftzentrum.de 70 i+ (unless (equal? 'directory (entry-type (current-page))) Err vernunftzentrum.de 70 i+ (select-entry (current-page)))))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (index-entry server #!optional (port gopher-port)) Err vernunftzentrum.de 70 i+ (make-entry 'directory "" index server port '())) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(define (main args) Err vernunftzentrum.de 70 i+ (initscr) Err vernunftzentrum.de 70 i+ (cbreak) Err vernunftzentrum.de 70 i+ (keypad (stdscr) #t) Err vernunftzentrum.de 70 i+ (curs_set 0) Err vernunftzentrum.de 70 i+ (clear) Err vernunftzentrum.de 70 i+ (refresh) Err vernunftzentrum.de 70 i+ (noecho) Err vernunftzentrum.de 70 i+ (set-signal-handler! signal/winch (lambda (sig) (refresh))) Err vernunftzentrum.de 70 i+ (let-values (((l c) (getmaxyx (stdscr)))) Err vernunftzentrum.de 70 i+ (main-win (newwin (sub1 l) c 0 0)) Err vernunftzentrum.de 70 i+ (status-win (newwin 1 c (sub1 l) 0)) Err vernunftzentrum.de 70 i+ (new-status "Starting up!") Err vernunftzentrum.de 70 i+ (select-entry (index-entry (car args))) Err vernunftzentrum.de 70 i+ (exit 0))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+(exit-handler (lambda code (endwin))) Err vernunftzentrum.de 70 i+(main (command-line-arguments)) Err vernunftzentrum.de 70 1diff --git a/ncurses-trunk.diff b/ncurses-trunk.diff /ckeen/repos/holymoly/file/ncurses-trunk.diff.gph vernunftzentrum.de 70 i@@ -0,0 +1,20 @@ Err vernunftzentrum.de 70 i+Index: ncurses.scm Err vernunftzentrum.de 70 i+=================================================================== Err vernunftzentrum.de 70 i+--- ncurses.scm (revision 34695) Err vernunftzentrum.de 70 i++++ ncurses.scm (working copy) Err vernunftzentrum.de 70 i+@@ -65,6 +65,7 @@ Err vernunftzentrum.de 70 i+ mvaddnstr Err vernunftzentrum.de 70 i+ mvwaddstr Err vernunftzentrum.de 70 i+ mvwaddnstr Err vernunftzentrum.de 70 i++ mvwchgat Err vernunftzentrum.de 70 i+ waddnstr Err vernunftzentrum.de 70 i+ waddstr Err vernunftzentrum.de 70 i+ clear Err vernunftzentrum.de 70 i+@@ -511,6 +512,7 @@ Err vernunftzentrum.de 70 i+ (def err mvaddnstr int int c-string int) Err vernunftzentrum.de 70 i+ (def err mvwaddstr win int int c-string) Err vernunftzentrum.de 70 i+ (def err mvwaddnstr win int int c-string int) Err vernunftzentrum.de 70 i++(def err mvwchgat win int int int int short c-pointer) Err vernunftzentrum.de 70 i+ (def err waddnstr win c-string int) Err vernunftzentrum.de 70 i+ (def err waddstr win c-string) Err vernunftzentrum.de 70 i+ (def err clear) Err vernunftzentrum.de 70 1diff --git a/proxy.scm b/proxy.scm /ckeen/repos/holymoly/file/proxy.scm.gph vernunftzentrum.de 70 i@@ -0,0 +1,88 @@ Err vernunftzentrum.de 70 i+(module socksv5-proxy Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+ (connect/socksv5) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+ (import chicken scheme foreign) Err vernunftzentrum.de 70 i+ (use tcp srfi-4 srfi-13 bitstring) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+ (define (raise-error loc subtype msg . args) Err vernunftzentrum.de 70 i+ (signal (make-composite-condition Err vernunftzentrum.de 70 i+ (make-property-condition 'exn 'message msg 'location loc 'arguments args) Err vernunftzentrum.de 70 i+ (make-property-condition 'i/o) Err vernunftzentrum.de 70 i+ (make-property-condition 'net) Err vernunftzentrum.de 70 i+ (make-property-condition 'socksv5-proxy 'type subtype)))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+ (define connect-response-strings Err vernunftzentrum.de 70 i+ '("Succeeded" Err vernunftzentrum.de 70 i+ "General SOCKS server failure" Err vernunftzentrum.de 70 i+ "Connection not allowed by ruleset" Err vernunftzentrum.de 70 i+ "Network unreachable" Err vernunftzentrum.de 70 i+ "Connection refused" Err vernunftzentrum.de 70 i+ "TTL Expired" Err vernunftzentrum.de 70 i+ "Command not supported" Err vernunftzentrum.de 70 i+ "Address type not supported")) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+ (define (connect-response->string response-type) Err vernunftzentrum.de 70 i+ (if (> (length connect-response-strings) response-type) Err vernunftzentrum.de 70 i+ (list-ref connect-response-strings response-type) Err vernunftzentrum.de 70 i+ "unassigned")) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 i+ (define (connect/socksv5 proxy proxy-port destination destination-port) Err vernunftzentrum.de 70 i+ (parameterize ((tcp-connect-timeout #f) Err vernunftzentrum.de 70 i+ (tcp-read-timeout #f)) Err vernunftzentrum.de 70 i+ (let-values (((i o) (tcp-connect proxy proxy-port))) Err vernunftzentrum.de 70 i+ (write-u8vector '#u8(5 1 0) o) Err vernunftzentrum.de 70 i+ (let ((r (read-u8vector 2 i))) Err vernunftzentrum.de 70 i+ (unless (equal? r '#u8(5 0)) Err vernunftzentrum.de 70 i+ (close-input-port i) Err vernunftzentrum.de 70 i+ (close-output-port o) Err vernunftzentrum.de 70 i+ (raise-error 'connect/socksv5 'auth "Unsupported authentication for proxy " r)) Err vernunftzentrum.de 70 i+ (write-u8vector Err vernunftzentrum.de 70 i+ (bitstring->u8vector Err vernunftzentrum.de 70 i+ (bitconstruct Err vernunftzentrum.de 70 i+ (5 8) ; Version Err vernunftzentrum.de 70 i+ (1 8) ; connect Err vernunftzentrum.de 70 i+ (0 8) ; reserved Err vernunftzentrum.de 70 i+ (3 8) ; FQDN, do the resolution for us Err vernunftzentrum.de 70 i+ ((string-length destination) 8) Err vernunftzentrum.de 70 i+ (destination bitstring) Err vernunftzentrum.de 70 i+ (destination-port 16 big))) Err vernunftzentrum.de 70 i+ o) Err vernunftzentrum.de 70 i+ (flush-output o) Err vernunftzentrum.de 70 i+ (let* ((resp (read-u8vector 10 i)) Err vernunftzentrum.de 70 i+ (response Err vernunftzentrum.de 70 i+ (bitmatch resp Err vernunftzentrum.de 70 i+ (((Version 8) Err vernunftzentrum.de 70 i+ (Reply-field 8) Err vernunftzentrum.de 70 i+ (Reserved 8) Err vernunftzentrum.de 70 i+ (Address-Type 8) Err vernunftzentrum.de 70 i+ (check (= Address-Type 1)) Err vernunftzentrum.de 70 i+ (bind-address 32 bitstring) Err vernunftzentrum.de 70 i+ (bind-port 16 big)) Err vernunftzentrum.de 70 i+ (list Version Reserved Reply-field Address-Type (bitstring->u8vector bind-address) bind-port)) Err vernunftzentrum.de 70 i+ (((Version 8) Err vernunftzentrum.de 70 i+ (Reply-field 8) Err vernunftzentrum.de 70 i+ (Reserved 8) Err vernunftzentrum.de 70 i+ (Address-Type 8) Err vernunftzentrum.de 70 i+ (check (= Address-Type 4)) Err vernunftzentrum.de 70 i+ (bind-address 64 bitsring) Err vernunftzentrum.de 70 i+ (bind-port 16 big)) Err vernunftzentrum.de 70 i+ (list Version Reserved Reply-field Address-Type (bitstring->u8vector bind-address) bind-port)) Err vernunftzentrum.de 70 i+ (((Version 8) Err vernunftzentrum.de 70 i+ (Reply-field 8) Err vernunftzentrum.de 70 i+ (Reserved 8) Err vernunftzentrum.de 70 i+ (Address-Type 8) Err vernunftzentrum.de 70 i+ (check (= Address-Type 3)) Err vernunftzentrum.de 70 i+ (bind-address-length 8) Err vernunftzentrum.de 70 i+ (bitmatch (read-u8vector (- (+ bind-address-length 2) 4) i) Err vernunftzentrum.de 70 i+ (((bind-address (* 8 bind-address-length) bitstring) Err vernunftzentrum.de 70 i+ (bind-port 16 big)) Err vernunftzentrum.de 70 i+ (list Version Reserved Reply-field Address-Type (bitstring->list bind-address) bind-port))))) Err vernunftzentrum.de 70 i+ (else (raise-error 'connect/socksv5 'connect "Parse error in socket response " resp))))) Err vernunftzentrum.de 70 i+ (if (zero? (cadr response)) ; if reply field is zero all is well Err vernunftzentrum.de 70 i+ (values i o response) Err vernunftzentrum.de 70 i+ (begin Err vernunftzentrum.de 70 i+ (close-input-port i) Err vernunftzentrum.de 70 i+ (close-output-port o) Err vernunftzentrum.de 70 i+ (raise-error 'connect/socksv5 'connect "Connect error" (connect-response->string (car response))))))))))) Err vernunftzentrum.de 70 i+ Err vernunftzentrum.de 70 .