From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 26 Aug 2008 04:21:54 +0000 (+0000)
Subject: Make sure that user-agent string is an HTTP token.
X-Git-Tag: 20090517-FFI~218
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3b87fb3a77c233783025c45033094fe2657e7449;p=mit-scheme.git

Make sure that user-agent string is an HTTP token.
---

diff --git a/v7/src/runtime/http-client.scm b/v7/src/runtime/http-client.scm
index 0ca77102f..7518ec8a8 100644
--- a/v7/src/runtime/http-client.scm
+++ b/v7/src/runtime/http-client.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: http-client.scm,v 14.5 2008/08/25 08:44:26 cph Exp $
+$Id: http-client.scm,v 14.6 2008/08/26 04:21:54 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -80,6 +80,18 @@ USA.
 
 (define (initialize-package!)
   (set! default-user-agent
-	(string-append "MIT-GNU-Scheme/"
-		       (get-subsystem-version-string "release")))
+	(call-with-output-string
+	  (lambda (output)
+	    (write-string "MIT-GNU-Scheme/" output)
+	    (let ((input
+		   (open-input-string
+		    (get-subsystem-version-string "release"))))
+	      (let loop ()
+		(let ((char (read-char input)))
+		  (if (not (eof-object? char))
+		      (begin
+			(if (char-set-member? char-set:http-token char)
+			    (write-char char output)
+			    (write-char #\_ output))
+			(loop)))))))))
   unspecific)
\ No newline at end of file