Add ability to specify a proxy for a NNTP server.

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 4e8b7f01798cc703519f603a74f0b5cad60c8cfb..f8f0c1e47964d0c9a0dcb5d2d1241f2523e0a994 100644 (file)
--- 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 70a0c85f68815441ec7ea6944aec3a72bca8e650..adf83965c636116891d73bfad81bb7743d231f7f 100644 (file)
--- 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 97526c37b17ce0942462b9da3053b8c460817547..42f7c28e03749ba1e084cbc15c6af8829da093c6 100644 (file)
--- 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)))))
 \f
 (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)))
 \f
@@ -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)))
 \f
+(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)))))))