From 7c6d47adef147b3a30c021a382e6aff3f6d6fded Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 31 Dec 1998 04:25:04 +0000 Subject: [PATCH] Add ability to specify a proxy for a NNTP server. --- v7/src/edwin/edwin.pkg | 3 ++- v7/src/edwin/nntp.scm | 9 +++++--- v7/src/edwin/snr.scm | 51 ++++++++++++++++++++++++++++-------------- 3 files changed, 42 insertions(+), 21 deletions(-) diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg index 4e8b7f017..f8f0c1e47 100644 --- a/v7/src/edwin/edwin.pkg +++ b/v7/src/edwin/edwin.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: edwin.pkg,v 1.229 1998/12/29 04:09:50 cph Exp $ +$Id: edwin.pkg,v 1.230 1998/12/31 04:25:04 cph Exp $ Copyright (c) 1989-98 Massachusetts Institute of Technology @@ -1759,6 +1759,7 @@ MIT in each case. |# edwin-variable$news-server-mode-hook edwin-variable$news-server-name-appearance edwin-variable$news-server-offline-timeout + edwin-variable$news-server-proxy-alist edwin-variable$news-show-nonexistent-groups edwin-variable$news-show-unsubscribed-groups edwin-variable$news-sort-groups diff --git a/v7/src/edwin/nntp.scm b/v7/src/edwin/nntp.scm index 70a0c85f6..adf83965c 100644 --- a/v7/src/edwin/nntp.scm +++ b/v7/src/edwin/nntp.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: nntp.scm,v 1.20 1998/12/29 04:07:48 cph Exp $ +;;; $Id: nntp.scm,v 1.21 1998/12/31 04:24:50 cph Exp $ ;;; ;;; Copyright (c) 1995-98 Massachusetts Institute of Technology ;;; @@ -62,8 +62,10 @@ (define-structure (nntp-connection (conc-name nntp-connection:) - (constructor make-nntp-connection (server change-hook))) + (constructor make-nntp-connection + (server proxy change-hook))) (server #f read-only #t) + (proxy #f read-only #t) (change-hook #f read-only #t) (port #f) (banner #f) @@ -78,7 +80,8 @@ "... "))) (message msg) (let ((port - (open-tcp-stream-socket (nntp-connection:server connection) + (open-tcp-stream-socket (or (nntp-connection:proxy connection) + (nntp-connection:server connection)) "nntp" nntp-socket-buffer-size))) (set-nntp-connection:port! connection port) diff --git a/v7/src/edwin/snr.scm b/v7/src/edwin/snr.scm index 97526c37b..42f7c28e0 100644 --- a/v7/src/edwin/snr.scm +++ b/v7/src/edwin/snr.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: snr.scm,v 1.47 1998/12/29 04:08:26 cph Exp $ +;;; $Id: snr.scm,v 1.48 1998/12/31 04:24:56 cph Exp $ ;;; ;;; Copyright (c) 1995-98 Massachusetts Institute of Technology ;;; @@ -67,6 +67,19 @@ This has three possible values: 'NONE (lambda (object) (memq object '(NONE FULL HOST-ONLY)))) +(define-variable news-server-proxy-alist + "Alist mapping news servers to associated proxies. +Each entry in the list is a pair of strings: + the car of the entry is the FQDN of a news server; + the cdr of the entry is the FQDN of a proxy for that server." + '() + (lambda (object) + (list-of-type? object + (lambda (entry) + (and (pair? entry) + (string? (car entry)) + (string? (cdr entry))))))) + (define-variable news-server-initial-refresh "Switch controlling whether News groups are refreshed when reader starts. If false (the default), groups are initially listed with the estimates @@ -263,11 +276,10 @@ The default value of this variable is (SUBSCRIBED (HEADERS BODIES))." (eq? 'ALL (car object)) (list-of-strings? (car object))) (pair? (cdr object)) - (and (list? (cadr object)) - (for-all? (cadr object) - (lambda (element) - (or (eq? 'HEADERS element) - (eq? 'BODIES element))))) + (list-of-type? (cadr object) + (lambda (element) + (or (eq? 'HEADERS element) + (eq? 'BODIES element)))) (null? (cddr object))))) (define-command rnews @@ -364,12 +376,12 @@ Only one News reader may be open per server; if a previous News reader (define (news-buffer-name server prefix) (case (ref-variable news-server-name-appearance #f) ((HOST-ONLY) - (string-append prefix - ":" - (let ((dot (string-find-next-char server #\.))) - (if dot - (string-head server dot) - server)))) + (string-append prefix + ":" + (let ((dot (string-find-next-char server #\.))) + (if dot + (string-head server dot) + server)))) ((FULL) (string-append prefix ":" server)) (else prefix))) @@ -387,8 +399,7 @@ Only one News reader may be open per server; if a previous News reader (lambda (buffer) (add-kill-buffer-hook buffer news-server-buffer:kill) (buffer-put! buffer 'NNTP-CONNECTION - (make-nntp-connection server - update-nntp-connection-modeline!)) + (make-nntp-connection-1 server buffer)) (let ((sort? (ref-variable news-sort-groups buffer))) (let ((groups (let ((groups @@ -451,6 +462,14 @@ Only one News reader may be open per server; if a previous News reader (define (news-server-buffer:close-connection buffer) (nntp-connection:close (news-server-buffer:connection buffer))) +(define (make-nntp-connection-1 server buffer) + (make-nntp-connection + server + (let ((entry (assoc server (ref-variable news-server-proxy-alist buffer)))) + (and entry + (cdr entry))) + update-nntp-connection-modeline!)) + (define (news-server-buffer:save-groups buffer) (write-groups-init-file buffer) (for-each-vector-element (news-server-buffer:groups buffer) @@ -2981,9 +3000,7 @@ C-c C-q mail-fill-yanked-message (fill what was yanked)." (let ((server-buffer (find-news-server-buffer server))) (if server-buffer (do-it (news-server-buffer:connection server-buffer)) - (let ((connection - (make-nntp-connection server - update-nntp-connection-modeline!))) + (let ((connection (make-nntp-connection-1 server lookup-buffer))) (let ((result (do-it connection))) (nntp-connection:close connection) result))))))) -- 2.25.1