From: Taylor R. Campbell <net/mumble/campbell>
Date: Sat, 17 May 2008 02:18:27 +0000 (+0000)
Subject: Allow service numbers in news server proxy entries.
X-Git-Tag: 20090517-FFI~297
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2d9e47d1fcc508888150aa34e5a736190d9377d0;p=mit-scheme.git

Allow service numbers in news server proxy entries.
---

diff --git a/v7/src/edwin/nntp.scm b/v7/src/edwin/nntp.scm
index 69dfe9105..e33c06e5a 100644
--- a/v7/src/edwin/nntp.scm
+++ b/v7/src/edwin/nntp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: nntp.scm,v 1.37 2008/01/30 20:02:04 cph Exp $
+$Id: nntp.scm,v 1.38 2008/05/17 02:18:27 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -46,9 +46,10 @@ USA.
 (define-structure (nntp-connection
 		   (conc-name nntp-connection:)
 		   (constructor make-nntp-connection
-				(server proxy change-hook)))
+				(server proxy change-hook #!optional service)))
   (server #f read-only #t)
   (proxy #f read-only #t)
+  (service "nntp" read-only #t)
   (change-hook #f read-only #t)
   (port #f)
   (banner #f)
@@ -65,7 +66,7 @@ USA.
     (let ((port
 	   (open-tcp-stream-socket (or (nntp-connection:proxy connection)
 				       (nntp-connection:server connection))
-				   "nntp")))
+				   (nntp-connection:service connection))))
       (set-nntp-connection:port! connection port)
       (set-nntp-connection:banner! connection (input-port/read-line port)))
     (set-nntp-connection:current-group! connection #f)
diff --git a/v7/src/edwin/snr.scm b/v7/src/edwin/snr.scm
index 61e9c179b..6f7334b0b 100644
--- a/v7/src/edwin/snr.scm
+++ b/v7/src/edwin/snr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: snr.scm,v 1.70 2008/01/30 20:02:05 cph Exp $
+$Id: snr.scm,v 1.71 2008/05/17 02:18:26 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -54,7 +54,8 @@ This has three possible values:
   "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."
+ the cdr of the entry is the FQDN of a proxy for that server,
+ optionally followed by a colon and a service number."
   '()
   (lambda (object)
     (list-of-type? object
@@ -473,12 +474,25 @@ Only one News reader may be open per server; if a previous News reader
   (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!))
+  (let ((entry (assoc server (ref-variable news-server-proxy-alist buffer))))
+    (if entry
+	(receive (proxy service) (parse-proxy-name (cdr entry))
+	  (make-nntp-connection server
+				proxy
+				update-nntp-connection-modeline!
+				service))
+	(make-nntp-connection server #f update-nntp-connection-modeline!))))
+
+(define (parse-proxy-name string)
+  (let ((parts (burst-string string (char-set #\:) #f)))
+    (cond ((and (pair? parts) (null? (cdr parts)))
+	   (values (car parts) #!default))
+	  ((and (pair? parts) (pair? (cdr parts)) (null? (cddr parts)))
+	   (values (car parts)
+                   (or (string->number (cadr parts) #d10)
+                       (cadr parts))))
+	  (else
+	   (error "Malformed NNTP proxy name:" string)))))
 
 (define (news-server-buffer:save-groups buffer)
   (write-groups-init-file buffer)
@@ -501,7 +515,7 @@ Only one News reader may be open per server; if a previous News reader
 	    (insert-news-group-line group mark)
 	    (set-news-group:index! group #f))))
     (mark-temporary! mark)))
-
+
 (define (news-server-buffer:show-group? buffer group)
   (and (or (ref-variable news-show-unsubscribed-groups buffer)
 	   (news-group:subscribed? group))