suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

probable fix to PR 7893

Browse Source 
svn: r2234
This commit is contained in:
Robby Findler 2006-02-15 18:33:43 +00:00
parent 151287518a
commit 2b52904d0e
7 changed files with 25 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/help/private/installed-components.ss
View File

@ -2,7 +2,8 @@
(require (lib "list.ss")
(lib "xml.ss" "xml")
(lib "getinfo.ss" "setup")
(lib "util.ss" "help" "servlets" "private"))
(lib "uri-codec.ss" "net")
(lib "util.ss" "help" "servlets" "private"))
(provide help-desk:installed-components)
@ -95,7 +96,7 @@
" See "
`(A ((HREF ,(format
"/servlets/doc-anchor.ss?file=~a&caption=Documentation for the ~a collection&name=~a"
(hexify-string (path->string fname))
(uri-encode (path->string fname))
collection
collection)))
"the documentation")

3
collects/help/private/manuals.ss
View File

@ -6,6 +6,7 @@
(lib "xml.ss" "xml")
(lib "contract.ss")
(lib "getinfo.ss" "setup")
(lib "uri-codec.ss" "net")
"colldocs.ss"
"docpos.ss"
"path.ss"
@ -272,7 +273,7 @@
(lambda (collection-doc-file name)
(format "<LI> <A HREF=\"/servlets/doc-anchor.ss?file=~a&name=~a&caption=Documentation for the ~a collection\">~a collection</A>"
; escape colons and other junk
(hexify-string
(uri-encode
(path->string
(build-path (car collection-doc-file)
(cadr collection-doc-file))))

11
collects/help/private/standard-urls.ss
View File

@ -2,6 +2,7 @@
(require "../servlets/private/util.ss"
"internal-hp.ss"
(lib "uri-codec.ss" "net")
(lib "contract.ss"))
(provide home-page-url)
@ -66,8 +67,8 @@
internal-host
internal-port
coll
(hexify-string name)
(hexify-string link)))
(uri-encode name)
(uri-encode link)))
(define (make-relative-results-url search-string search-type match-type lucky? manuals doc.txt? lang-name)
(string-append
@ -88,14 +89,14 @@
"lucky=~a&"
"manuals=~a&"
"doctxt=~a")
(hexify-string search-string)
(uri-encode search-string)
search-type
match-type
(if lucky? "true" "false")
(hexify-string (format "~s" (map path->bytes manuals)))
(uri-encode (format "~s" (map path->bytes manuals)))
(if doc.txt? "true" "false"))])
(if language-name
(string-append start (format "&langname=~a" (hexify-string language-name)))
(string-append start (format "&langname=~a" (uri-encode language-name)))
start)))
; sym, string assoc list

18
collects/help/servlets/private/util.ss
View File

@ -2,11 +2,11 @@
(require (lib "file.ss")
(lib "list.ss")
(lib "xml.ss" "xml")
(lib "uri-codec.ss" "net")
(lib "string-constant.ss" "string-constants")
(lib "contract.ss"))
(provide/contract
[hexify-string (string? . -> . string?)]
[fold-into-web-path ((listof string?) . -> . string?)])
(provide get-pref/default
@ -76,20 +76,6 @@
(with-handlers ([exn:fail:filesystem? (lambda (x) #f)])
(collection-path "repos-time-stamp"))))))
(define hexifiable '(#\: #\; #\? #\& #\% #\# #\< #\> #\+))
;; hexify-string : string -> string
;; exploits good properties of utf-8 encoding
;; that if can-keep? returns true that the byte is
;; the character index
(define (hexify-string s)
(apply string-append
(map (λ (b)
(cond
[(can-keep? b) (string (integer->char b))]
[else (format "%~X" b)]))
(bytes->list (string->bytes/utf-8 s)))))
;; can-keep? : byte -> boolean
;; source rfc 2396
(define (can-keep? i)
@ -107,7 +93,7 @@
`(A ((HREF
,(format
"/servlets/doc-anchor.ss?file=~a&name=~a&caption=Documentation for the ~a collection"
(hexify-string (path->string coll-file))
(uri-encode (path->string coll-file))
coll
coll)))
,txt)

7
collects/help/servlets/release/license.ss
View File

@ -1,6 +1,7 @@
(module license mzscheme
(require "../private/util.ss")
(require "../private/headelts.ss")
(require "../private/util.ss"
"../private/headelts.ss"
(lib "uri-codec.ss" "net"))
(require (lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
@ -36,7 +37,7 @@
"under the terms of the LGPL, which in particular means that you must "
"release the source code for the modified software. See "
(A ((HREF ,(format "/servlets/doc-anchor.ss?name=COPYING.LIB&caption=Copying PLT software&file=~a"
(hexify-string
(uri-encode
(path->string
(simplify-path
(build-path (collection-path "mzlib") 'up 'up "notes" "COPYING.LIB")))))))

11
collects/help/servlets/results.ss
View File

@ -12,6 +12,7 @@ is stored in a module top-level and that's namespace-specific.
(lib "list.ss")
(lib "string.ss")
(lib "servlet.ss" "web-server")
(lib "uri-codec.ss" "net")
"../private/internal-hp.ss"
"../private/path.ss"
"../private/docpos.ss"
@ -149,8 +150,8 @@ is stored in a module top-level and that's namespace-specific.
(let ([maybe-coll (maybe-extract-coll last-header)])
(format
no-anchor-format
(hexify-string anchored-path)
(hexify-string (make-caption maybe-coll))
(uri-encode anchored-path)
(uri-encode (make-caption maybe-coll))
maybe-coll))]
[else ; manual, so have absolute path
(get-help-url path page-label)])))
@ -177,10 +178,10 @@ is stored in a module top-level and that's namespace-specific.
; path is absolute pathname
(define (make-text-href page-label path)
(let* ([maybe-coll (maybe-extract-coll last-header)]
[hex-path (hexify-string (path->string (normalize-path path)))]
[hex-path (uri-encode (path->string (normalize-path path)))]
[hex-caption (if (eq? maybe-coll last-header)
hex-path
(hexify-string (make-caption maybe-coll)))]
(uri-encode (make-caption maybe-coll)))]
[offset (or (and (number? page-label)
page-label)
0)])
@ -188,7 +189,7 @@ is stored in a module top-level and that's namespace-specific.
with-anchor-format
hex-path
hex-caption
(hexify-string maybe-coll)
(uri-encode maybe-coll)
offset)))
(define (html-entry? path)

3
collects/help/servlets/scheme/how.ss
View File

@ -4,6 +4,7 @@
"../../private/manuals.ss"
"../private/headelts.ss"
"../../private/installed-components.ss"
(lib "uri-codec.ss" "net")
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
@ -95,7 +96,7 @@
(A ((NAME "setup") (VALUE "Setup PLT program")))
(A ((NAME "setup2") (VALUE "setup-plt program")))
(A ((HREF ,(format "/servlets/doc-anchor.ss?file=~a&name=~a&caption=~a"
(hexify-string
(uri-encode
(path->string
(simplify-path
(build-path (collection-path "mzlib") 'up "setup" "doc.txt"))))